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 IGDINS (KILATG, KINS, KOLATG, KONS, ONPOLE, 12 1 OSPOLE, KNSIND, KNSDIST, KPR, KERR) 13C 14C----> 15C**** *IGDINS* 16C 17C PURPOSE 18C _______ 19C 20C Calculate the distances between points in an output latitude 21C array and its North and South neighbours in the input latitude 22C array. 23C 24C INTERFACE 25C _________ 26C 27C IERR = IGDINS (KILATG, KINS, KOLATG, KONS, ONPOLE, OSPOLE, 28C 1 KNSIND, KNSDIST, KPR, KERR) 29C 30C Input parameters 31C ________________ 32C 33C KILATG - The array of input latitudes. 34C 35C KINS - The number of points in the North-South direction 36C in the input field. 37C 38C KOLATG - The array of output latitudes. 39C 40C KONS - The number of points in the North-South direction 41C in the output field. 42C 43C ONPOLE - This variable will be true if the input field 44C includes the most Northerly line of latitude for 45C the field type. This means latitude 90 North for 46C a regular field and the first line of a Gaussian 47C field. 48C 49C OSPOLE - This variable will be true if the input field 50C includes the most Southerly line of latitude for 51C the field type. This means latitude 90 South for 52C a regular field and the last line of a Gaussian 53C field. 54C 55C KPR - The debug print switch. 56C 0 , No debugging output. 57C 1 , Produce debugging output. 58C 59C KERR - The error control flag. 60C -ve, No error message. Return error code. 61C 0 , Hard failure with error message. 62C +ve, Print error message. Return error code. 63C 64C Output parameters 65C ________________ 66C 67C KNSIND - This array will contain the array offsets of the 68C North and South points in the input array required 69C for interpolation. 70C 71C KNSDIST - This array will contain the distances to lines 72C in input field from the associated lines of 73C latitude in the output field. 74C 75C Return value 76C ____________ 77C 78C The error indicator (INTEGER). 79C 80C Error and Warning Return Values 81C _______________________________ 82C 83C 24501 An output latitude was found that was outside the area 84C spanned by the input latitudes. 85C 86C Common block usage 87C __________________ 88C 89C None 90C 91C EXTERNALS 92C _________ 93C 94C INTLOG(R) - Logs messages. 95C 96C METHOD 97C ______ 98C 99C This routine will create the arrays of offsets and distance as 100C two arrays of length (2, Number of output latitudes). 101C 102C If an input Gaussian grid includes the "polar" line and the 103C output field includes a line of latitude between this "polar" 104C line and the pole then the position of this "polar" Gaussian 105C line is assumed to be at the pole for that line of latitude only. 106C 107C REFERENCE 108C _________ 109C 110C None 111C 112C COMMENTS 113C ________ 114C 115C Program contains sections 0 to 2 and 9 116C 117C AUTHOR 118C ______ 119C 120C K. Fielding *ECMWF* Oct 1993 121C 122C MODIFICATIONS 123C _____________ 124C 125C None 126C 127C----< 128C _______________________________________________________ 129C 130C 131C* Section 0. Definition of variables. 132C _______________________________________________________ 133C 134C* Prefix conventions for variable names 135C 136C Logical L (but not LP), global or common. 137C O, dummy argument 138C G, local variable 139C LP, parameter. 140C Character C, global or common. 141C H, dummy argument 142C Y (but not YP), local variable 143C YP, parameter. 144C Integer M and N, global or common. 145C K, dummy argument 146C I, local variable 147C J (but not JP), loop control 148C JP, parameter. 149C REAL A to F and Q to X, global or common. 150C P (but not PP), dummy argument 151C Z, local variable 152C PP, parameter. 153C 154C Implicit statement to force declarations 155C 156 IMPLICIT NONE 157C 158#include "parim.h" 159C 160C Dummy arguments 161 LOGICAL ONPOLE, OSPOLE 162 INTEGER KINS, KONS, KPR, KERR 163 INTEGER KILATG (KINS), KOLATG (KONS) 164 INTEGER KNSIND (2, KONS), KNSDIST (2, KONS) 165C 166C Local variables 167 INTEGER IBASE 168 INTEGER JOUT, JINP 169 INTEGER JPROUTINE 170 PARAMETER (JPROUTINE = 24500) 171C 172C _______________________________________________________ 173C 174C* Section 1. Initialisation 175C _______________________________________________________ 176C 177 100 CONTINUE 178C 179 IF (KPR.GE.1) CALL INTLOG(JP_DEBUG,'IGDINS: Section 1.',JPQUIET) 180C 181 IGDINS = 0 182C 183 IF (KPR .GE. 1) THEN 184 CALL INTLOG(JP_DEBUG,'IGDINS: Input parameters.',JPQUIET) 185 CALL INTLOG(JP_DEBUG,'IGDINS: No.input fld lines = ',KINS) 186 CALL INTLOG(JP_DEBUG,'IGDINS: No.output fld lines = ',KONS) 187 CALL INTLOG(JP_DEBUG,'IGDINS: Input fld spread from ',KILATG(1)) 188 CALL INTLOG(JP_DEBUG,'IGDINS: to ', KILATG(KINS)) 189 CALL INTLOG(JP_DEBUG,'IGDINS: Outpt fld spread from ',KOLATG(1)) 190 CALL INTLOG(JP_DEBUG,'IGDINS: to ', KOLATG(KONS)) 191C 192 IF ( ONPOLE ) THEN 193 CALL INTLOG(JP_DEBUG,'IGDINS: N. pole in inpt field.',JPQUIET) 194 ELSE 195 CALL INTLOG(JP_DEBUG,'IGDINS: N.pole NOT in inpt fld',JPQUIET) 196 ENDIF 197C 198 IF ( OSPOLE ) THEN 199 CALL INTLOG(JP_DEBUG,'IGDINS: S. pole in inpt field.',JPQUIET) 200 ELSE 201 CALL INTLOG(JP_DEBUG,'IGDINS: S.pole NOT in inpt fld',JPQUIET) 202 ENDIF 203 ENDIF 204C 205C _______________________________________________________ 206C 207C* Section 2. Select points along a line of meridian 208C _______________________________________________________ 209C 210 200 CONTINUE 211C 212 IF (KPR.GE.1) CALL INTLOG(JP_DEBUG,'IGDINS: Section 2.',JPQUIET) 213C 214C Last latitude found to be used as start of search 215C for next latitude 216C 217 IBASE = 1 218C 219 DO 220 JOUT = 1, KONS 220C 221C Allow special code for points beyond North limit of 222C Gaussian grid which has all points up to pole 223C 224C Sinisa remove check for pole - already exist in iagcntl 225 IF (IBASE .EQ. 1 .AND. KOLATG(JOUT).GT.KILATG (1) ) THEN 226C 227 KNSIND (JP_I_N, JOUT) = 1 228 KNSIND (JP_I_S, JOUT) = 2 229 IBASE = 1 230C 231 KNSDIST (JP_I_N, JOUT) = JP90 - KOLATG (JOUT) 232 KNSDIST (JP_I_S, JOUT) = KOLATG (JOUT) - KILATG (2) 233C 234 GO TO 220 235C 236 ENDIF 237C 238 DO 210 JINP = IBASE, KINS - 1 239C 240C This test allows the exact match at both ends to be treated 241C correctly. Although the point is checked for equality at 242C both ends the first test will be used except for the South 243C Gaussian limit. 244C 245 IF (KOLATG (JOUT) .LE. KILATG (JINP) .AND. 246 X KOLATG (JOUT) .GE. KILATG (JINP + 1) ) THEN 247C 248 KNSIND (JP_I_N, JOUT) = JINP 249 KNSIND (JP_I_S, JOUT) = JINP + 1 250 IBASE = JINP 251C 252 KNSDIST (JP_I_N, JOUT) = KILATG (JINP) - 253 X KOLATG (JOUT) 254 KNSDIST (JP_I_S, JOUT) = KOLATG (JOUT) - 255 X KILATG (JINP + 1) 256C 257 GO TO 220 258C 259 ENDIF 260C 261 210 CONTINUE 262C 263C Allow special code for points beyond South limit of 264C Gaussian grid which has all points up to pole 265C 266C Sinisa remove check for pole - already exist in iagcntl 267 IF (KOLATG (JOUT) .LT. KILATG (KINS) ) THEN 268C 269 KNSIND (JP_I_N, JOUT) = KINS - 1 270 KNSIND (JP_I_S, JOUT) = KINS 271 IBASE = KINS 272C 273 KNSDIST (JP_I_N, JOUT) = KILATG (KINS - 1) - 274 X KOLATG (JOUT) 275 KNSDIST (JP_I_S, JOUT) = KOLATG (JOUT) - JP90 276C 277 ELSE 278C 279 IGDINS = JPROUTINE + 1 280 IF (KERR .GE. 0) THEN 281 CALL INTLOGR(JP_ERROR, 282 X 'IGDINS: Output lat. value ',REAL(KOLATG(JOUT))/PPMULT) 283 CALL INTLOGR(JP_ERROR, 284 X 'IGDINS: outside input range = ',REAL(KILATG(1))/PPMULT) 285 CALL INTLOGR(JP_ERROR, 286 X 'IGDINS: to ',REAL(KILATG(KINS))/PPMULT) 287 ENDIF 288C 289 IF (KERR .EQ. 0) CALL INTLOGR(JP_FATAL, 290 X 'IGDINS: Interpolation failing.',IGDINS) 291C 292 GO TO 900 293C 294 ENDIF 295C 296 220 CONTINUE 297C 298C 299C _______________________________________________________ 300C 301C* Section 9. Return to calling routine. Format statements 302C _______________________________________________________ 303C 304 900 CONTINUE 305C 306 IF (KPR.GE.1) CALL INTLOG(JP_DEBUG,'IGDINS: Section 9.',JPQUIET) 307C 308 RETURN 309 END 310