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 IRLSMB (OISTAND, HIFILE, KIREC, KIGRID, KILINE, 12 X OOSTAND, HOFILE, KOREC, KOGRID, KOLINE, KPR, KERR) 13C 14C----> 15C**** *IRLSMB* 16C 17C Purpose 18C ------- 19C 20C Calculate the effects of the land-sea masks on the unnormalised 21C interpolation weights for a quasi regular input field and a 22C regular output field. 23C 24C 25C Interface 26C --------- 27C 28C IERR = IRLSMB (OISTAND, HIFILE, KIREC, KIGRID, KILINE, 29C X OOSTAND, HOFILE, KOREC, KOGRID, KOLINE, KPR, KERR) 30C 31C 32C Input parameters 33C ---------------- 34C 35C OISTAND - Flag indicating whether the input land-sea mask 36C is a pre-stored "standard" field. 37C 38C HIFILE - The filename for the input land-sea mask. 39C 40C KIREC - The length of one latitude record in the input file. 41C 42C KIGRID - An array of length 2 giving the row and column 43C strides in a pre-stored land sea mask file for the 44C input grid. 45C 46C KILINE - An array of length 2 giving the offsets of the 47C Northern and Western starting points in a 48C pre-stored land sea mask file for the input grid. 49C 50C OOSTAND - Flag indicating whether the output land-sea mask 51C is a prestored "standard" field. 52C 53C HOFILE - The filename for the output land-sea mask. 54C 55C KOREC - The length of one latitude record in the output file. 56C 57C KOGRID - An array of length 2 giving the row and column 58C strides in a pre-stored land sea mask file for the 59C output grid. 60C 61C KOLINE - An array of length 2 giving the offsets of the 62C Northern and Western starting points in a 63C pre-stored land sea mask file for the output grid. 64C 65C KPR - The debug print switch. 66C 0 , No debugging output. 67C 1 , Produce debugging output. 68C 69C KERR - The error control flag. 70C -ve, No error message. Return error code. 71C 0 , Hard failure with error message. 72C +ve, Print error message. Return error code. 73C 74C 75C Output parameters 76C ----------------- 77C 78C The common variable WFACT is modified by this routine. 79C 80C An error indicator 81C 82C 23401 An error exit was returned from the I/O routine PBOPEN. 83C 23402 An error exit was returned from the I/O routine PBCLOSE. 84C 85C 86C Common block usage 87C ------------------ 88C 89C nifld.common - This file contains all the input field 90C definition variables. 91C 92C NINS - Number of grid points in NS direction for input 93C field (used in grspace.h). 94C NIWE - Number of grid points in WE direction for input 95C field (used in grspace.h). 96C 97C nofld.common - This file contains all the output field 98C definition variables. 99C 100C NONS - Number of grid points in NS direction for output 101C field is used. 102C NOWE - Number of grid points in WE direction for output 103C field is used. 104C 105C grspace.h - This file contains all the work space array 106C definitions for grid point to grid point 107C interpolation. 108C 109C MEXPAND - Array used to expand one latitude line of the 110C 10 minute land sea mask file to have one word 111C per bit for improved efficiency. 112C MILLEN - Array containing a quasi regular line length 113C definition. 114C MWORK - Array used to read one latitude line of a 115C standard land sea mask file. 116C 117C MILATG - The input field latitudes. 118C MILONG - The input field longitudes. 119C MILSM - Work array used in calculating the effects of 120C the land sea mask on interpolation. 121C MISTRT - The array offsets of the start of each latitude 122C line for a quasi regular Gaussian input field. 123C MNSIND - The latitude line numbers (array offset) of the 124C input field associated with each line of 125C latitude in the output field. 126C MOLATG - The output field latitudes. 127C MOLONG - The output field longitudes. 128C MOLSM - Work array used in calculating the effects of 129C the land sea mask on interpolation. 130C MWEIND - This array holds the longitude points (array 131C offset) from the input field associated with 132C each longitude point in the output field. 133C WFACT - The interpolation weights for each point in the 134C output field. 135C 136C 137C Externals 138C --------- 139C 140C IGLSM01 - Read and process one latitude row from the 10 141C minute land sea mask. 142C IGLSMR - Calculate the effects of the land-sea masks for 143C one line of latitude on the unnormalised 144C interpolation weights. 145C IGLSMST - Read and process one line of latitude from a 146C standard land sea mask file. 147C PBCLOSE - Close a land sea mask file after processing. 148C PBOPEN - Open a land sea mask file for processing. 149C INTLOG(R) - Log messages. 150C JINDEX - Returns length of character string 151C 152C 153C Method 154C ------ 155C 156C All the land sea mask data is in (0-1) form. If a point in the 157C input field has a different land sea mask value from the 158C corresponding point in the output field then its interpolating 159C weight is multiplied by a scaling factor. This scaling factor 160C is currently 0.2 so that the effect of such points in the final 161C interpolation is reduced. 162C 163C The land-sea mask files are kept open between calls to this 164C routine. 165C 166C 167C Reference 168C --------- 169C 170C None 171C 172C 173C Comments 174C -------- 175C 176C None 177C 178C 179C Author 180C ------ 181C K. Fielding *ECMWF* Nov 1993 182C 183C Modifications 184C ------------- 185C 186C J.D.Chambers ECMWF Oct 1996 187C Reduced number of parameters in call to IGLSMST and IGLSM01 188C 189C----< 190C -----------------------------------------------------------------| 191C* Section 0. Definition of variables. 192C -----------------------------------------------------------------| 193C 194 IMPLICIT NONE 195C 196#include "parim.h" 197#include "nifld.common" 198#include "nofld.common" 199#include "grspace.h" 200C 201C Function arguments 202C 203 LOGICAL OISTAND, OOSTAND 204 CHARACTER *(*) HIFILE, HOFILE 205 INTEGER KIREC, KOREC, KPR, KERR 206 INTEGER KIGRID (2), KILINE (2), KOGRID (2), KOLINE (2) 207C 208C Local variables 209C 210 INTEGER IIUNIT, IOUNIT, IIFILE, IOFILE 211 INTEGER ILATN, ILATS, ILINEN, ILINES, ISTRIDEN, ISTRIDES 212 INTEGER IOSTRIDE, INDEXN, INDEXS, IZERO, IOFF, IPR, IERR 213 INTEGER JLON, JOLAT 214 CHARACTER*256 XHIFILE, XHOFILE 215 CHARACTER*2 NEWFILE, MSKFILE 216 INTEGER XIIUNIT, XIOUNIT, II 217 DATA XIIUNIT/0/ 218 DATA XIOUNIT/0/ 219 SAVE XHIFILE, XHOFILE, XIIUNIT, XIOUNIT 220C 221 INTEGER JPROUTINE 222 PARAMETER (JPROUTINE = 23400) 223C 224C External functions 225C 226 INTEGER IGLSMR, IGLSMST, IGLSM01, JINDEX 227C 228C -----------------------------------------------------------------| 229C* Section 1. Initialisation 230C -----------------------------------------------------------------| 231C 232 100 CONTINUE 233C 234 IF( KPR.GE.1 ) CALL INTLOG(JP_DEBUG,'IRLSMB: Section 1.',JPQUIET) 235C 236 IRLSMB = 0 237C 238 IIFILE = JINDEX(HIFILE) 239 IOFILE = JINDEX(HOFILE) 240C 241 IF( KPR.GE.1 ) THEN 242 CALL INTLOG(JP_DEBUG,'IRLSMB: Input field parameters.',JPQUIET) 243 CALL INTLOG(JP_DEBUG,'IRLSMB: LSM filename is.',JPQUIET) 244 CALL INTLOG(JP_DEBUG, HIFILE(1:IIFILE), JPQUIET) 245 IF( OISTAND ) THEN 246 CALL INTLOG(JP_DEBUG,'IRLSMB: Standard fld: TRUE',JPQUIET) 247 ELSE 248 CALL INTLOG(JP_DEBUG,'IRLSMB: Standard fld: FALSE',JPQUIET) 249 ENDIF 250 CALL INTLOG(JP_DEBUG,'IRLSMB: LSM file rec len = ',KIREC) 251 CALL INTLOG(JP_DEBUG,'IRLSMB: Grid stride WE = ',KIGRID(1)) 252 CALL INTLOG(JP_DEBUG,'IRLSMB: Grid stride NS = ',KIGRID(2)) 253 CALL INTLOG(JP_DEBUG,'IRLSMB: Grid start N = ',KILINE(1)) 254 CALL INTLOG(JP_DEBUG,'IRLSMB: Grid start W = ',KILINE(2)) 255C 256 CALL INTLOG(JP_DEBUG,'IRLSMB: Output field parameters.',JPQUIET) 257 CALL INTLOG(JP_DEBUG, HOFILE(1:IOFILE),JPQUIET) 258 IF( OOSTAND ) THEN 259 CALL INTLOG(JP_DEBUG,'IRLSMB: Standard fld: TRUE',JPQUIET) 260 ELSE 261 CALL INTLOG(JP_DEBUG,'IRLSMB: Standard fld: FALSE',JPQUIET) 262 ENDIF 263 CALL INTLOG(JP_DEBUG,'IRLSMB: LSM file rec len = ',KOREC) 264 CALL INTLOG(JP_DEBUG,'IRLSMB: Grid stride WE = ',KOGRID(1)) 265 CALL INTLOG(JP_DEBUG,'IRLSMB: Grid stride NS = ',KOGRID(2)) 266 CALL INTLOG(JP_DEBUG,'IRLSMB: Grid start N = ',KOLINE(1)) 267 CALL INTLOG(JP_DEBUG,'IRLSMB: Grid start W = ',KOLINE(2)) 268 ENDIF 269C 270 IF( MOLONG(2).GE.MOLONG(1) ) THEN 271 IOSTRIDE = MOLONG(2) - MOLONG(1) 272 ELSE 273 IOSTRIDE = MOLONG(2) + JP360 - MOLONG(1) 274 ENDIF 275C 276C -----------------------------------------------------------------| 277C* Section 2. Open files for input and output land sea masks 278C -----------------------------------------------------------------| 279C 280 200 CONTINUE 281C 282 IF( KPR.GE.1 ) CALL INTLOG(JP_DEBUG,'IRLSMB: Section 2.',JPQUIET) 283C 284C See if first time through or input land sea mask filename has 285C changed since last access 286C 287 II = JINDEX(HIFILE) 288 IF( XHIFILE(1:II).NE.HIFILE(1:II) ) THEN 289C 290C Open input land sea mask file 291C 292 IF(XIIUNIT.NE.0) CALL PBCLOSE(XIIUNIT,IERR) 293 CALL PBOPEN(IIUNIT, HIFILE, 'r', IERR) 294 IF( IERR.NE.0 ) THEN 295 IRLSMB = JPROUTINE + 1 296C 297 IF( KERR.GE.0 ) THEN 298 CALL INTLOG(JP_ERROR,'IRLSMB: PBOPEN return code = ',IERR) 299 CALL INTLOG(JP_ERROR,'IRLSMB: trying to open file',JPQUIET) 300 CALL INTLOG(JP_ERROR, HIFILE(1:IIFILE),JPQUIET) 301 ENDIF 302C 303 IF( KERR.EQ.0 ) CALL INTLOG(JP_FATAL, 304 X 'IRLSMB: Interpolation failed.',JPQUIET) 305 GOTO 900 306 ENDIF 307 XIIUNIT = IIUNIT 308 XHIFILE(1:II) = HIFILE(1:II) 309 NEWFILE(1:1) = 'Y' 310C 311C Just rewind if same file still in use 312C 313 ELSE 314 IIUNIT = XIIUNIT 315 NEWFILE(1:1) = 'N' 316 ENDIF 317C 318C See if first time through or output land sea mask filename has 319C changed since last access 320C 321 II = JINDEX(HOFILE) 322 IF( XHOFILE(1:II).NE.HOFILE(1:II) ) THEN 323C 324C Open output land sea mask file 325C 326 IF(XIOUNIT.NE.0) CALL PBCLOSE(XIOUNIT,IERR) 327 CALL PBOPEN(IOUNIT, HOFILE, 'r', IERR) 328 IF( IERR.NE.0 ) THEN 329 IRLSMB = JPROUTINE + 1 330C 331 IF( KERR.GE.0 ) THEN 332 CALL INTLOG(JP_ERROR,'IRLSMB: PBOPEN return code = ',IERR) 333 CALL INTLOG(JP_ERROR,'IRLSMB: trying to open file',JPQUIET) 334 CALL INTLOG(JP_ERROR, HOFILE(1:IOFILE),JPQUIET) 335 ENDIF 336C 337 IF( KERR.EQ.0 ) CALL INTLOG(JP_FATAL, 338 X 'IRLSMB: Interpolation failed.',JPQUIET) 339 GOTO 900 340 ENDIF 341 XIOUNIT = IOUNIT 342 XHOFILE(1:II) = HOFILE(1:II) 343 NEWFILE(2:2) = 'Y' 344C 345C Just rewind if same file still in use 346C 347 ELSE 348 IOUNIT = XIOUNIT 349 NEWFILE(2:2) = 'N' 350 ENDIF 351C 352C -----------------------------------------------------------------| 353C* Section 3. Calculate arrays of weights 354C -----------------------------------------------------------------| 355C 356 300 CONTINUE 357C 358 IF( KPR.GE.1 ) CALL INTLOG(JP_DEBUG,'IRLSMB: Section 3.',JPQUIET) 359C 360 IPR = KPR 361C 362 DO JOLAT = 1, NONS 363C 364 INDEXN = ( (JOLAT - 1) * 2 + JP_I_N - 1) * NOWE + 1 365 INDEXS = ( (JOLAT - 1) * 2 + JP_I_S - 1) * NOWE + 1 366C 367C Get line for output array 368C 369 IF( OOSTAND ) THEN 370C 371 IOFF = (KOLINE(JPNORTH) + (JOLAT - 1) * KOGRID(JPNSSTEP) 372 X - 1) * KOREC 373C 374 MSKFILE(2:2) = 'O' 375 MSKFILE(1:1) = NEWFILE(2:2) 376 IERR = IGLSMST(IOUNIT, IOFF, NOWE, KOLINE(JPWEST), 377 X KOGRID(JPWESTEP), KOREC, MOLSM, MSKFILE) 378 NEWFILE(2:2) = 'N' 379C 380 ELSE 381 IERR = IGLSM01(IOUNIT, NOWE, MOLONG, MOLATG(JOLAT), 382 X MEXPAND, KOREC, MOLSM) 383 ENDIF 384C 385 IF( IERR.GT.0 ) THEN 386 IRLSMB = IERR 387 GOTO 900 388 ENDIF 389C 390 ILATN = MNSIND(JP_I_N, JOLAT) 391 ILATS = MNSIND(JP_I_S, JOLAT) 392C 393 ILINEN = MILLEN(ILATN) 394 ISTRIDEN = JP360 / ILINEN 395C 396 ILINES = MILLEN(ILATS) 397 ISTRIDES = JP360 / ILINES 398C 399 IZERO = 0 400C 401C Get lines for input array 402C 403 IF( OISTAND ) THEN 404C 405 MSKFILE(2:2) = 'I' 406 MSKFILE(1:1) = NEWFILE(1:1) 407 IERR = IGLSMST(IIUNIT, MISTRT(ILATN) - 1, ILINEN, 408 X KILINE(JPWEST), KIGRID(JPWESTEP), ILINEN, 409 X MILSM(1, JP_I_N), MSKFILE) 410 NEWFILE(1:1) = 'N' 411C 412 IF( IERR.GT.0 ) THEN 413 IRLSMB = IERR 414 GOTO 900 415 ENDIF 416C 417 MSKFILE(2:2) = 'I' 418 MSKFILE(1:1) = NEWFILE(1:1) 419 IERR = IGLSMST(IIUNIT, MISTRT(ILATS) - 1, ILINES, 420 X KILINE(JPWEST), KIGRID(JPWESTEP), ILINES, 421 X MILSM(1, JP_I_S), MSKFILE) 422 NEWFILE(1:1) = 'N' 423C 424 ELSE 425C 426 DO JLON = 0, ILINEN - 1 427 MILONG(JLON + 1) = ISTRIDEN * JLON 428 ENDDO 429C 430 IERR = IGLSM01(IIUNIT, ILINEN, MILONG, MILATG(ILATN), 431 X MEXPAND, KIREC, MILSM(1, JP_I_N)) 432C 433 IF( IERR.GT.0 ) THEN 434 IRLSMB = IERR 435 GOTO 900 436 ENDIF 437C 438 DO JLON = 0, ILINES - 1 439 MILONG(JLON + 1) = ISTRIDES * JLON 440 ENDDO 441C 442 IERR = IGLSM01(IIUNIT, ILINES, MILONG, MILATG(ILATS), 443 X MEXPAND, KIREC, MILSM(1, JP_I_S)) 444C 445 ENDIF 446C 447 IF( IERR.GT.0 ) THEN 448 IRLSMB = IERR 449 GOTO 900 450 ENDIF 451C 452C Now modify the unormalised weight for land-sea mask 453C 454 IERR = IGLSMR(MILSM(1, JP_I_N), MILSM(1, JP_I_S), 455 X MOLSM, MWEIND(1, INDEXN), MWEIND(1, INDEXS), NOWE, 456 X WFACT(1,(JOLAT - 1) * NOWE + 1), IPR, KERR) 457C 458 IF( IERR.GT.0 ) THEN 459 IRLSMB = IERR 460 GOTO 900 461 ENDIF 462C 463 IPR = KPR - 1 464C 465 ENDDO 466C 467C -----------------------------------------------------------------| 468C* Section 9. Return to calling routine. Format statements 469C -----------------------------------------------------------------| 470C 471 900 CONTINUE 472C 473 IF( KPR.GE.1 ) CALL INTLOG(JP_DEBUG,'IRLSMB: Section 9.',JPQUIET) 474C 475 RETURN 476 END 477