1C Copyright 1981-2016 ECMWF. 2C 3C This software is licensed under the terms of the Apache Licence 4C Version 2.0 which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. 5C 6C In applying this licence, ECMWF does not waive the privileges and immunities 7C granted to it by virtue of its status as an intergovernmental organisation 8C nor does it submit to any jurisdiction. 9C 10 11 INTEGER FUNCTION IAGCNTL(PIFELD, KILEN, POFELD, KOLEN, KILN, 12 X OIWEGLOBE, OINPOLE, OISPOLE, KOLN, OOWEGLOBE, OONPOLE, 13 X OOSPOLE, KPR, KERR) 14C 15C----> 16C**** *IAGCNTL* 17C 18C PURPOSE 19C _______ 20C 21C The global controlling routine for interpolating between 22C regular Gaussian or latitude/longitude fields. 23C 24C INTERFACE 25C _________ 26C 27C IERR = IAGCNTL(PIFELD, KILEN, POFELD, KOLEN, KILN, OIWEGLOBE, 28C X OINPOLE, OISPOLE, KOLN, OOWEGLOBE, OONPOLE, OOSPOLE, KPR, 29C X KERR) 30C 31C Input parameters 32C ________________ 33C 34C PIFELD - The input field provided by the calling routine. 35C 36C KILEN - The length of the input field. 37C 38C KOLEN - The length of the output field. 39C 40C KILN - The Northern line number of the input field within 41C its Gaussian field. 42C 43C OIWEGLOBE - A flag indicating whether the input field is 44C global West to East. 45C 46C OINPOLE - A flag indicating whether the North pole is 47C included in the input field. 48C 49C OISPOLE - A flag indicating whether the South pole is 50C include in the input field. 51C 52C KOLN - The Northern line number of the output field 53C within its Gaussian field. 54C 55C OOWEGLOBE - A flag indicating whether the output field is 56C global West to East. 57C 58C OONPOLE - A flag indicating whether the North pole is 59C include in the output field. 60C 61C OOSPOLE - A flag indicating whether the South pole is 62C include in the output field. 63C 64C KPR - The debug print switch. 65C 0 , No debugging output. 66C 1 , Produce debugging output. 67C 68C KERR - The error control flag. 69C -ve, No error message. Return error code. 70C 0 , Hard failure with error message. 71C +ve, Print error message. Return error code. 72C 73C Output parameters 74C ________________ 75C 76C POFELD - The output field returned to the calling routine. 77C 78C Return value 79C ____________ 80C 81C The error indicator (INTEGER). 82C 83C Error and Warning Return Values 84C _______________________________ 85C 86C 21801 The input data representation was not valid when the 87C grid was generated. This should not happen as the data 88C representation has been previously validated. 89C 21802 The output data representation was not valid when the 90C grid was generated. This should not happen as the data 91C representation has been previously validated. 92C 21803 Attempt to produce global West-East field where the input 93C field was not global. 94C 21804 Attempt to produce global North-South field where the 95C input field was not global. 96C 97C Common block usage 98C __________________ 99C 100C grspace.h - The include file contains all the array space 101C for grid to grid interpolation. 102C 103C RIGAUSS - Real array of input field Gaussian latitudes is 104C used. 105C ROGAUSS - Real array of output field Gaussian latitudes is 106C used. 107C 108C MILATG - The input field latitudes. 109C MILONG - The input field longitudes. 110C MNSDIST - The distances to neighbouring latitude lines of 111C the input field from the associated line of 112C latitude in the output field. 113C MNSIND - The latitude line numbers (array offset) of the 114C input field associated with each line of 115C latitude in the output field. 116C MOLATG - The output field latitudes. 117C MOLONG - The output field longitudes. 118C MWEDIST - This array holds the distances to neighbouring 119C longitude points of the input field from the 120C associated longitude points in the output field. 121C MWEIND - This array holds the longitude points (array 122C offset) from the input field associated with 123C each longitude point in the output field. 124C RINPNT - Array used to aid vectorisation in processing 125C precipitation fields. 126C RMAX - Array used to aid vectorisation in normalising 127C interpolation weights and processing 128C precipitation fields. 129C WFACT - The array of interpolation weights for each 130C point in the output field. 131C 132C nifld.common - This file contains all the input field 133C definition variables. 134C 135C LCHANGE - Process change flag is used and set. 136C LSMCHNG - LSM change flag is used and set. 137C LSM - LSM usage flag is used. 138C LSMPAR - LSM parameter flag is used. 139C LPREC - Precipitation flag is used. 140C LWIND - Wind flag is used. 141C LSTAGGL - Staggered grid flag 142C 143C NIAREA - Input field area definition (N/W/S/E) is used. 144C NIGAUSS - Input field Gaussian truncation is used. 145C NIGRID - Input field grid definition (WE/NS) is used. 146C NINS - Number of grid points in NS direction for input 147C field is used. 148C NIREPR - Input field representation is used. 149C NIWE - Number of grid points in WE direction for input 150C field is used. 151C 152C nofld.common - This file contains all the output field 153C definition variables. 154C 155C NOAREA - Output field area definition (N/W/S/E) is used. 156C NOGAUSS - Output field Gaussian truncation is used. 157C NOGRID - Output field grid definition (WE/NS) is used. 158C NONS - Number of grid points in NS direction for output 159C field is used. 160C NOREPR - Output field representation is used. 161C NOWE - Number of grid points in WE direction for output 162C field is used. 163C 164C EXTERNALS 165C _________ 166C 167C IGDINS - Calculate the distances between points in an 168C output latitude array and its North and South 169C neighbours in the input latitude array. 170C IGDIWE - Calculate the distances between points in an 171C output longitude array and its West and East 172C neighbours in the input longitude array. 173C IGGMEM - This routine acquires heap space. 174C IGGRID - Generate the arrays of latitude and longitude 175C points for a Gaussian truncation and area. 176C IGINT - Calculate the basic unnormalised interpolation 177C weights. 178C IGLGRID - Generate the arrays of latitude and longitude 179C points for a regular latitude/longitude grid. 180C IGLSMB - Calculate the effects of the land-sea masks on 181C the unnormalised interpolation weights. 182C IGLSMD - Generate the land sea mask file information. 183C IGNORM - Normalise the array of interpolation weights. 184C IGPLSM - Force an interpolated land sea mask field back 185C to a real 0-1 field. 186C IGPOLEG - Calculates the values at the pole of a regular 187C latitude/longitude field when the input is a 188C Gaussian field. 189C IGPOLEW - Calculates the values at the pole of a regular 190C latitude/longitude wind field when the input is 191C a Gaussian field. 192C IGPREC - Perform additional interpolation for 193C precipitation fields. 194C ZPREC - Perform additional interpolation processes 195C for precipitation 196C IGTOG - Perform basic interpolation between regular input 197C and output fields. 198C INTLOG - Logs messages. 199C 200C METHOD 201C ______ 202C 203C This is purely a controlling routine with all the work being 204C performed in the external routines. 205C 206C REFERENCE 207C _________ 208C 209C None 210C 211C COMMENTS 212C ________ 213C 214C None 215C 216C AUTHOR 217C ______ 218C 219C K. Fielding *ECMWF* May 1994 220C 221C MODIFICATIONS 222C _____________ 223C 224C J.Chambers ECMWF Oct 1998 225C Allow field type for rotated grids. 226C 227C S.Curic ECMWF Oct 2005 228C Add zprec routine that Perform checking 229C of precipitation 230 231C----< 232C -----------------------------------------------------------------| 233C* Section 0. Definition of variables. 234C -----------------------------------------------------------------| 235C 236 IMPLICIT NONE 237C 238#include "parim.h" 239#include "nifld.common" 240#include "nofld.common" 241#include "grspace.h" 242C 243C Parameters 244C 245 INTEGER JPROUTINE 246 PARAMETER (JPROUTINE = 21800) 247C 248C Function arguments 249C 250 LOGICAL OIWEGLOBE, OINPOLE, OISPOLE, OOWEGLOBE, OONPOLE, OOSPOLE 251 INTEGER KILEN, KOLEN, KILN, KOLN, KPR, KERR 252 REAL PIFELD(KILEN), POFELD(KOLEN) 253C 254C Local variables 255C 256 LOGICAL LFAIL, LERROR, LDEBUG, LREGIN, LREGOUT 257 LOGICAL GINSPOLE, GIGLOBE, GISTAND, GONSPOLE, GOGLOBE, GOSTAND 258 LOGICAL GPREC,LSM_VALUES 259 CHARACTER*256 YIFILE, YOFILE 260 CHARACTER*12 YFLAG 261 INTEGER IIOFF, IIREC, IOOFF, IOREC, IERR 262C 263C Working copies of area and grid arrays that may be changed 264C 265 INTEGER IILGRID(2), IILLINE(2), IOLGRID(2), IOLLINE(2) 266C 267C External functions 268C 269 INTEGER IGDINS, IGDIWE, IGGMEM, IGGRID, IGINT, IGLGRID, 270 X IGLSMB, IGLSMD, IGNORM, IGPLSM, IGPOLEG, IGPOLEW, IGPREC, 271 X IGTOG, ZPREC 272C 273C -----------------------------------------------------------------| 274C* Section 1. Initialisation 275C -----------------------------------------------------------------| 276C 277 100 CONTINUE 278C 279 IAGCNTL = 0 280 IERR = 0 281C 282C Set all flag variables 283C 284 LDEBUG = (KPR.GE.1) 285 LFAIL = (KERR.EQ.0) 286 LERROR = (KERR.GE.0) 287 LREGIN = (NIREPR.EQ.JPREGULAR).OR.(NIREPR.EQ.JPREGROT) 288 LREGOUT = (NOREPR.EQ.JPREGULAR).OR.(NOREPR.EQ.JPREGROT) 289C 290 IF( LDEBUG ) THEN 291 CALL INTLOG(JP_DEBUG,'IAGCNTL: Section 1.',JPQUIET) 292 CALL INTLOG(JP_DEBUG, 293 X 'IAGCNTL: Input field definition parameters.',JPQUIET) 294 CALL INTLOG(JP_DEBUG,'IAGCNTL: Representation = ',NIREPR) 295 IF( NIWE.NE.0 ) CALL INTLOG(JP_DEBUG, 296 X 'IAGCNTL: Number W-E = ',NIWE) 297 IF( NINS.NE.0 ) CALL INTLOG(JP_DEBUG, 298 X 'IAGCNTL: Number N-S = ',NINS) 299 IF( (NIREPR.EQ.JPGAUSSIAN).OR.(NIREPR.EQ.JPQUASI) ) 300 X CALL INTLOG(JP_DEBUG,'IAGCNTL: Gaussian truncation= ',NIGAUSS) 301 IF( LREGIN.AND.(NIGRID(1).NE.0) ) THEN 302 CALL INTLOG(JP_DEBUG,'IAGCNTL: Grid WE = ',NIGRID(1)) 303 CALL INTLOG(JP_DEBUG,'IAGCNTL: Grid NS = ',NIGRID(2)) 304 ENDIF 305 IF( NIAREA(1).NE.0 ) THEN 306 CALL INTLOG(JP_DEBUG,'IAGCNTL: Area North = ',NIAREA(1)) 307 CALL INTLOG(JP_DEBUG,'IAGCNTL: Area West = ',NIAREA(2)) 308 CALL INTLOG(JP_DEBUG,'IAGCNTL: Area South = ',NIAREA(3)) 309 CALL INTLOG(JP_DEBUG,'IAGCNTL: Area East = ',NIAREA(4)) 310 ENDIF 311C 312 CALL INTLOG(JP_DEBUG, 313 X 'IAGCNTL: Output field definition parameters.',JPQUIET) 314 CALL INTLOG(JP_DEBUG,'IAGCNTL: Representation = ',NOREPR) 315 IF( NOWE.NE.0 ) CALL INTLOG(JP_DEBUG, 316 X 'IAGCNTL: Number W-E = ',NOWE) 317 IF( NONS.NE.0 ) CALL INTLOG(JP_DEBUG, 318 X 'IAGCNTL: Number N-S = ',NONS) 319 IF( (NOREPR.EQ.JPGAUSSIAN).OR.(NOREPR.EQ.JPQUASI) ) 320 X CALL INTLOG(JP_DEBUG,'IAGCNTL: Gaussian truncation= ',NOGAUSS) 321 IF( LREGOUT.AND.(NOGRID(1).NE.0) ) THEN 322 CALL INTLOG(JP_DEBUG,'IAGCNTL: Grid WE = ',NOGRID(1)) 323 CALL INTLOG(JP_DEBUG,'IAGCNTL: Grid NS = ',NOGRID(2)) 324 ENDIF 325 IF( NOAREA(1).NE.0 ) THEN 326 CALL INTLOG(JP_DEBUG,'IAGCNTL: Area North = ',NOAREA(1)) 327 CALL INTLOG(JP_DEBUG,'IAGCNTL: Area West = ',NOAREA(2)) 328 CALL INTLOG(JP_DEBUG,'IAGCNTL: Area South = ',NOAREA(3)) 329 CALL INTLOG(JP_DEBUG,'IAGCNTL: Area East = ',NOAREA(4)) 330 ENDIF 331C 332 CALL INTLOG(JP_DEBUG,'IAGCNTL: Control flag status:',JPQUIET) 333C 334 IF( LSMCHNG ) THEN 335 CALL INTLOG(JP_DEBUG,'IAGCNTL: LSM change TRUE',JPQUIET) 336 ELSE 337 CALL INTLOG(JP_DEBUG,'IAGCNTL: LSM change FALSE',JPQUIET) 338 ENDIF 339C 340 IF( LSM ) THEN 341 CALL INTLOG(JP_DEBUG,'IAGCNTL: LSM flag TRUE',JPQUIET) 342 ELSE 343 CALL INTLOG(JP_DEBUG,'IAGCNTL: LSM flag FALSE',JPQUIET) 344 ENDIF 345C 346 IF( LWIND ) THEN 347 CALL INTLOG(JP_DEBUG,'IAGCNTL: Wind flag TRUE',JPQUIET) 348 ELSE 349 CALL INTLOG(JP_DEBUG,'IAGCNTL: Wind flag FALSE',JPQUIET) 350 ENDIF 351C 352 IF( LPREC ) THEN 353 CALL INTLOG(JP_DEBUG,'IAGCNTL: Precipitn flag TRUE',JPQUIET) 354 ELSE 355 CALL INTLOG(JP_DEBUG,'IAGCNTL: Precipitn flag FALSE',JPQUIET) 356 ENDIF 357C 358 IF( LSMPAR ) THEN 359 CALL INTLOG(JP_DEBUG,'IAGCNTL: LSM param flag TRUE',JPQUIET) 360 ELSE 361 CALL INTLOG(JP_DEBUG,'IAGCNTL: LSM param flag FALSE',JPQUIET) 362 ENDIF 363 IF( LSTAGGL ) THEN 364 CALL INTLOG(JP_DEBUG,'IAGCNTL: Staggered flag TRUE',JPQUIET) 365 ELSE 366 CALL INTLOG(JP_DEBUG,'IAGCNTL: Staggered flag FALSE',JPQUIET) 367 ENDIF 368 ENDIF 369C 370C The change of definition option spans sections 2 to 3 371C 372 IF( LCHANGE ) THEN 373C 374C -----------------------------------------------------------------| 375C* Section 2. Calculate space requirement. 376C -----------------------------------------------------------------| 377C 378 200 CONTINUE 379C 380 IF( LDEBUG ) CALL INTLOG(JP_DEBUG,'IAGCNTL: Section 2.',JPQUIET) 381C 382C Get the required memory 383C 384 IAGCNTL = IGGMEM(KPR, KERR) 385 IF( IAGCNTL.GT.0 ) GOTO 900 386C 387C Input grid definition 388C 389 IF( NIREPR.EQ.JPGAUSSIAN ) THEN 390C 391 IAGCNTL = IGGRID(NIGAUSS, NIAREA, KILN, RIGAUSS, 392 X MILONG,NIWE,MILATG,NINS,OIWEGLOBE,KPR,KERR) 393 IF( IAGCNTL.GT.0 ) GOTO 900 394C 395 ELSEIF( LREGIN ) THEN 396C 397 IAGCNTL = IGLGRID(NIGRID, NIAREA, MILONG, NIWE, MILATG, 398 X NINS,OIWEGLOBE,KPR,KERR) 399 IF( IAGCNTL.GT.0 ) GOTO 900 400C 401 ELSE 402C 403 IAGCNTL = JPROUTINE + 1 404 IF( LERROR ) THEN 405 CALL INTLOG(JP_ERROR, 406 X 'IAGCNTL: Illegal input representation = ',NIREPR) 407 IF( LFAIL ) CALL INTLOG(JP_FATAL, 408 X 'IAGCNTL: Interpolation failing.',JPQUIET) 409 ENDIF 410 GOTO 900 411C 412 ENDIF 413C 414C Is the input field global 415C 416 GINSPOLE = OINPOLE.AND.OISPOLE 417 GIGLOBE = OIWEGLOBE.AND.GINSPOLE 418C 419C Output grid definition 420C 421C Is the output field global North South 422C 423 GONSPOLE = OONPOLE.AND.OOSPOLE 424 GOGLOBE = OOWEGLOBE.AND.GONSPOLE 425 LGLOBL = (GOGLOBE.AND.NOAREA(2).EQ.0) 426C 427 IF( NOREPR.EQ.JPGAUSSIAN ) THEN 428C 429 IAGCNTL = IGGRID(NOGAUSS, NOAREA, KOLN, ROGAUSS, 430 X MOLONG,NOWE,MOLATG,NONS,OOWEGLOBE,KPR,KERR) 431 IF( IAGCNTL.GT.0 ) GOTO 900 432C 433 ELSEIF( LREGOUT ) THEN 434C 435 IAGCNTL = IGLGRID(NOGRID, NOAREA, MOLONG, NOWE, MOLATG, 436 X NONS,OOWEGLOBE,KPR,KERR) 437 IF( IAGCNTL.GT.0 ) GOTO 900 438C 439 ELSE 440C 441 IAGCNTL = JPROUTINE + 2 442 IF( LERROR ) THEN 443 CALL INTLOG(JP_ERROR, 444 X 'IAGCNTL: Illegal output representation = ',NOREPR) 445 IF( LFAIL ) CALL INTLOG(JP_FATAL, 446 X 'IAGCNTL: Interpolation failing.',JPQUIET) 447 ENDIF 448 GOTO 900 449C 450 ENDIF 451C 452C -----------------------------------------------------------------| 453C* Section 3. Create output to input grid mapping and distance arrays 454C -----------------------------------------------------------------| 455C 456 300 CONTINUE 457C 458 IF( LDEBUG ) 459 X CALL INTLOG(JP_DEBUG,'IAGCNTL: Section 3.',JPQUIET) 460C 461C First check that the input and output fields are compatible. 462C 463 IF( .NOT.GIGLOBE ) THEN 464C 465 IF( .NOT.OIWEGLOBE ) THEN 466C 467C Cannot produce global output field if input not global 468C 469 IF( OOWEGLOBE ) THEN 470 IAGCNTL = JPROUTINE + 3 471 IF( LERROR ) THEN 472 CALL INTLOG(JP_ERROR, 473 X 'IAGCNTL: Cannot produce global output from',JPQUIET) 474 CALL INTLOG(JP_ERROR, 475 X 'IAGCNTL: non-global input. The W-E input',JPQUIET) 476 CALL INTLOG(JP_ERROR, 477 X 'IAGCNTL: direction was not global.',JPQUIET) 478 IF( LFAIL ) CALL INTLOG(JP_FATAL, 479 X 'IAGCNTL: Interpolation failing.',JPQUIET) 480 ENDIF 481 GOTO 900 482 ENDIF 483C 484 ENDIF 485C 486c Sinisa added NOT.LSTAGGL just for the sake of staggered grids 487C 488 IF( .NOT.GINSPOLE.AND.(.NOT.LSTAGGL) ) THEN 489C 490C Cannot produce global output field if input not global 491C 492 IF( GONSPOLE ) THEN 493 IAGCNTL = JPROUTINE + 4 494 IF( LERROR ) THEN 495 CALL INTLOG(JP_ERROR, 496 X 'IAGCNTL: Cannot produce global output from',JPQUIET) 497 CALL INTLOG(JP_ERROR, 498 X 'IAGCNTL: non-global input. The N-S input',JPQUIET) 499 CALL INTLOG(JP_ERROR, 500 X 'IAGCNTL: direction was not global.',JPQUIET) 501 IF( LFAIL ) CALL INTLOG(JP_FATAL, 502 X 'IAGCNTL: Interpolation failing.',JPQUIET) 503 ENDIF 504 GOTO 900 505 ENDIF 506C 507 ENDIF 508C 509 ENDIF 510C 511 IAGCNTL = IGDINS(MILATG, NINS, MOLATG, NONS, OINPOLE, OISPOLE, 512 X MNSIND, MNSDIST, KPR, KERR) 513 IF( IAGCNTL.GT.0 ) GOTO 900 514C 515 IAGCNTL = IGDIWE(NIWE, NOWE, MWEIND, MWEDIST, NIAREA, NOAREA, 516 X MILONG, MOLONG, OIWEGLOBE ) ! FIXME: remove 517 IF( IAGCNTL.GT.0 ) GOTO 900 518C 519C The end of primary initialisation 520C 521 ENDIF 522C 523C -----------------------------------------------------------------| 524C* Section 4. Create normalised weight arrays 525C -----------------------------------------------------------------| 526C 527 400 CONTINUE 528C 529 IF( LDEBUG ) CALL INTLOG(JP_DEBUG,'IAGCNTL: Section 4.',JPQUIET) 530C 531C The following code is affected by the Land Sea mask flag 532C 533 IF( LCHANGE.OR.LSMCHNG ) THEN 534C 535 IAGCNTL = IGINT(MWEDIST, NOWE, MNSDIST, NONS, WFACT, KPR, KERR) 536 IF( IAGCNTL.GT.0 ) GOTO 900 537C 538 IF( LSM ) THEN 539C 540 IAGCNTL = IGLSMD(NIDATE,NIREPR,NIGRID,NIGAUSS,NIAREA,KILN, 541 X YIFILE,GISTAND,IILGRID,IILLINE,IIREC,KPR,KERR) 542 IF( IAGCNTL.GT.0 ) GOTO 900 543C 544 IAGCNTL = IGLSMD(NODATE,NOREPR,NOGRID,NOGAUSS,NOAREA,KOLN, 545 X YOFILE,GOSTAND,IOLGRID,IOLLINE,IOREC,KPR,KERR) 546 IF( IAGCNTL.GT.0 ) GOTO 900 547C 548 IAGCNTL = IGLSMB(GISTAND, YIFILE, IIREC, IILGRID, IILLINE, 549 X GOSTAND,YOFILE,IOREC,IOLGRID,IOLLINE,KPR,KERR) 550 IF( IAGCNTL.GT.0 ) GOTO 900 551C 552 ENDIF 553C 554C Normalise the weights 555C 556 IAGCNTL = IGNORM(WFACT, RMAX, NOWE, NONS, KPR, KERR) 557 IF( IAGCNTL.GT.0 ) GOTO 900 558C 559C This marks the end of a change to the specification 560C Clear the Change flags LCHANGE and LSMCHNG 561C 562 LCHANGE = .FALSE. 563 LSMCHNG = .FALSE. 564C 565 ENDIF 566C 567C -----------------------------------------------------------------| 568C* Section 5. Basic interpolation from input to output field 569C -----------------------------------------------------------------| 570C 571 500 CONTINUE 572C 573 IF( LDEBUG ) CALL INTLOG(JP_DEBUG,'IAGCNTL: Section 5.',JPQUIET) 574C 575 IAGCNTL = IGTOG(PIFELD, NIWE, NINS, NOWE, NONS, MWEIND, MNSIND, 576 X WFACT, POFELD, KPR, KERR) 577 IF( IAGCNTL.GT.0 ) GOTO 900 578C 579C -----------------------------------------------------------------| 580C* Section 6. Additional interpolations from input to output field 581C -----------------------------------------------------------------| 582C 583 600 CONTINUE 584C 585 IF( LDEBUG ) CALL INTLOG(JP_DEBUG,'IAGCNTL: Section 6.',JPQUIET) 586C 587C Precipitation field 588C 589C Force processing without neighbour check 590 GPREC = .FALSE. 591 CALL GETENV('PRECIPITATION_NEIGHBOUR_CHECK', YFLAG) 592 IF( YFLAG(1:1).EQ.'0' ) GPREC = .TRUE. 593 594 IF( LPREC ) THEN 595C 596 IF( GPREC ) THEN 597 IAGCNTL = ZPREC(POFELD, NOWE, NONS, KPR, KERR) 598 ELSE 599 IAGCNTL = IGPREC(PIFELD, NIWE, NINS, POFELD, NOWE, NONS, 600 X MWEIND, MNSIND, WFACT, RMAX, RINPNT, KPR, KERR) 601 ENDIF 602C 603 IF( IAGCNTL.GT.0 ) GOTO 900 604 ENDIF 605C 606C Special code for poles if Gaussian input and regular output 607C 608C North pole 609C 610C Sinisa add pole point for staggerd lat-lon grids 611 IF( (NIREPR.EQ.JPREGULAR.AND.LSTAGGL).AND. 612 X LREGOUT .AND. 613 X OINPOLE .AND. 614 X OONPOLE ) THEN 615C 616 IIOFF = 1 617 IOOFF = 1 618C 619 IF( LWIND ) THEN 620 IAGCNTL = IGPOLEW(PIFELD(IIOFF), NIWE, POFELD(IOOFF), 621 X NOWE, MWEIND, MWEDIST, KPR, KERR) 622 ELSE 623 IAGCNTL = IGPOLEG(PIFELD(IIOFF), NIWE, POFELD(IOOFF), 624 X NOWE, KPR, KERR) 625 ENDIF 626 ENDIF 627 628 IF( (NIREPR.EQ.JPGAUSSIAN).AND. 629 X LREGOUT .AND. 630 X OINPOLE .AND. 631 X OONPOLE ) THEN 632C 633 IIOFF = 1 634 IOOFF = 1 635C 636 IF( LWIND ) THEN 637 IAGCNTL = IGPOLEW(PIFELD(IIOFF), NIWE, POFELD(IOOFF), 638 X NOWE, MWEIND, MWEDIST, KPR, KERR) 639 ELSE 640 IAGCNTL = IGPOLEG(PIFELD(IIOFF), NIWE, POFELD(IOOFF), 641 X NOWE, KPR, KERR) 642 ENDIF 643 IF( IAGCNTL.GT.0 ) GOTO 900 644C 645 ENDIF 646C 647C South pole 648C 649C Sinisa add south pole point for staggerd lat-lon grids 650 IF( (NIREPR.EQ.JPREGULAR.AND.LSTAGGL).AND. 651 X LREGOUT .AND. 652 X OISPOLE .AND. 653 X OOSPOLE ) THEN 654C 655 IIOFF = (NINS - 1) * NIWE + 1 656 IOOFF = (NONS - 1) * NOWE + 1 657C 658 IF( LWIND ) THEN 659 IAGCNTL = IGPOLEW(PIFELD(IIOFF), NIWE, POFELD(IOOFF), 660 X NOWE, MWEIND, MWEDIST, KPR, KERR) 661 ELSE 662 IAGCNTL = IGPOLEG(PIFELD(IIOFF), NIWE, POFELD(IOOFF), 663 X NOWE, KPR, KERR) 664C 665 ENDIF 666 ENDIF 667 IF( (NIREPR.EQ.JPGAUSSIAN).AND. 668 X LREGOUT .AND. 669 X OISPOLE .AND. 670 X OOSPOLE ) THEN 671C 672 IIOFF = (NINS - 1) * NIWE + 1 673 IOOFF = (NONS - 1) * NOWE + 1 674C 675 IF( LWIND ) THEN 676 IAGCNTL = IGPOLEW(PIFELD(IIOFF), NIWE, POFELD(IOOFF), 677 X NOWE, MWEIND, MWEDIST, KPR, KERR) 678 ELSE 679 IAGCNTL = IGPOLEG(PIFELD(IIOFF), NIWE, POFELD(IOOFF), 680 X NOWE, KPR, KERR) 681 ENDIF 682 IF( IAGCNTL.GT.0 ) GOTO 900 683C 684 ENDIF 685C 686C LSM field - must be 0 or 1 687C 688C Force processing real LSM 689 LSM_VALUES = .FALSE. 690 CALL GETENV('LSM_VALUES', YFLAG) 691 IF( YFLAG(1:1).EQ.'1' ) LSM_VALUES = .TRUE. 692 693 IF( .NOT.LSM_VALUES.AND.LSMPAR ) THEN 694 IAGCNTL = IGPLSM(POFELD, NOWE * NONS, KPR, KERR) 695 IF( IAGCNTL.GT.0 ) GOTO 900 696 ENDIF 697C 698C -----------------------------------------------------------------| 699C* Section 9. Return to calling routine. Format statements 700C -----------------------------------------------------------------| 701C 702 900 CONTINUE 703C 704 IF( LDEBUG ) CALL INTLOG(JP_DEBUG,'IAGCNTL: Section 9.',JPQUIET) 705C 706 RETURN 707 END 708