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 IGLSMR (KILSMN, KILSMS, KOLSM, KNINDEX, 12 1 KSINDEX, KOWE, PWFACT, KPR, KERR) 13C 14C----> 15C**** *IGLSMR* 16C 17C PURPOSE 18C ------- 19C 20C Calculate the effects of the land-sea masks for one line of 21C latitude on the unnormalised interpolation weights. 22C 23C INTERFACE 24C --------- 25C 26C IERR = IGLSMR (KILSMN, KILSMS, KOLSM, KNINDEX, KSINDEX, 27C 1 KOWE, PWFACT, KPR, KERR) 28C 29C Input parameters 30C ---------------- 31C 32C KILSMN - The land sea mask for the line of latitude of the 33C input field North of the output row. 34C 35C KILSMS - The land sea mask for the line of latitude of the 36C input field South of the output row. 37C 38C KOLSM - The land sea mask for the current line of latitude 39C of the output field. 40C 41C KNINDEX - This array contains the array offsets of the West 42C and East points in the input line of latitude North 43C of the current output field line of latitude. 44C 45C KSINDEX - This array contains the array offsets of the West 46C and East points in the input line of latitude South 47C of the current output field line of latitude. 48C 49C KOWE - The number of output field points in the West-East 50C direction for this line of latitude. 51C 52C PWFACT - The array of interpolating weights to the four 53C neighbouring points for every output point in this 54C line of latitude. 55C 56C KPR - The debug print switch. 57C 0 , No debugging output. 58C 1 , Produce debugging output. 59C 60C KERR - The error control flag. 61C -ve, No error message. Return error code. 62C 0 , Hard failure with error message. 63C +ve, Print error message. Return error code. 64C 65C Output parameters 66C ________________ 67C 68C PWFACT - The modified array of interpolating weights to the 69C four neighbouring points for every output point in 70C this line of latitude. 71C 72C Return value 73C ------------ 74C 75C The error indicator (INTEGER). 76C 77C Error and Warning Return Values 78C _______________________________ 79C 80C None 81C 82C Common block usage 83C __________________ 84C 85C None 86C 87C Externals 88C --------- 89C 90C INTLOG(R) - Logs messages. 91C 92C 93C Method 94C ------ 95C 96C Every time that a point in the input array has a land-sea mask 97C value (0-1) that does not match the corresponding output point 98C its interpolating value is multiplied by a scaling factor 99C (currently 0.2). This reduces the influence of such points on 100C the final interpolation. 101C 102C The parameter list is designed to allow for quasi regular input 103C fields with different grid spacing in the Northern and Southern 104C lines of latitude. 105C 106C 107C Reference 108C --------- 109C None 110C 111C 112C Comments 113C -------- 114C None 115C 116C 117C AUTHOR 118C ------ 119C K. Fielding *ECMWF* Oct 1993 120C 121C 122C Modifications 123C ------------- 124C 125C None 126C 127C----< 128C 129C -----------------------------------------------------------------| 130C* Section 0. Definition of variables. 131C -----------------------------------------------------------------| 132C 133C 134 IMPLICIT NONE 135C 136#include "parim.h" 137C 138C Dummy arguments 139 INTEGER KOWE, KPR, KERR 140 INTEGER KNINDEX (2, KOWE), KSINDEX (2, KOWE) 141 INTEGER KILSMN (*), KILSMS (*), KOLSM (KOWE) 142 REAL PWFACT (4, KOWE) 143C 144C Local variables 145 INTEGER JOLON 146C 147C Multiplication factor for unlike land-sea masks 148C 149 REAL PPLSM 150 PARAMETER (PPLSM = 0.2E0) 151C 152 INTEGER JPROUTINE 153 PARAMETER (JPROUTINE = 25300) 154C 155C -----------------------------------------------------------------| 156C* Section 1. Initialisation 157C -----------------------------------------------------------------| 158C 159 100 CONTINUE 160C 161 IF( KPR.GE.1 ) CALL INTLOG(JP_DEBUG,'IGLSMR: Section 1.',JPQUIET) 162C 163 IGLSMR = 0 164C 165 IF (KPR .GE. 1) 166 X CALL INTLOG(JP_DEBUG,'IGLSMR: No. of output longitudes = ',KOWE) 167C 168C -----------------------------------------------------------------| 169C* Section 2. Calculate arrays of weights 170C -----------------------------------------------------------------| 171C 172 200 CONTINUE 173C 174 IF (KPR.GE.1) CALL INTLOG(JP_DEBUG,'IGLSMR: Section 2.',JPQUIET) 175C 176C Now modify the unormalised weight for land-sea mask 177C 178 DO 210 JOLON = 1, KOWE 179C 180 IF (KILSMN (KNINDEX (JP_I_W, JOLON)) .NE. 181 1 KOLSM (JOLON) ) 182 2 PWFACT (JP_I_NW, JOLON) = 183 3 PWFACT (JP_I_NW, JOLON) * PPLSM 184C 185 IF (KILSMN (KNINDEX (JP_I_E, JOLON)) .NE. 186 1 KOLSM (JOLON) ) 187 2 PWFACT (JP_I_NE, JOLON) = 188 3 PWFACT (JP_I_NE, JOLON) * PPLSM 189C 190 IF (KILSMS (KSINDEX (JP_I_W, JOLON)) .NE. 191 1 KOLSM (JOLON) ) 192 2 PWFACT (JP_I_SW, JOLON) = 193 3 PWFACT (JP_I_SW, JOLON) * PPLSM 194C 195 IF (KILSMS (KSINDEX (JP_I_E, JOLON)) .NE. 196 1 KOLSM (JOLON) ) 197 2 PWFACT (JP_I_SE, JOLON) = 198 3 PWFACT (JP_I_SE, JOLON) * PPLSM 199C 200 210 CONTINUE 201C 202C -----------------------------------------------------------------| 203C* Section 9. Return to calling routine. Format statements 204C -----------------------------------------------------------------| 205C 206 900 CONTINUE 207C 208 IF( KPR.GE.1 ) CALL INTLOG(JP_DEBUG,'IGLSMR: Section 9.',JPQUIET) 209C 210 RETURN 211 END 212