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 IGPOLEW(PIFELD, KIWE, POFELD, KOWE, KWEIND, 12 1 KWEDIST, KPR, KERR) 13C 14C----> 15C**** *IGPOLEW* 16C 17C Purpose 18C ------- 19C 20C Calculates the values at the pole of a regular 21C latitude/longitude wind field when the input is a Gaussian field. 22C 23C This routine is only used for a wind field. 24C 25C Interface 26C --------- 27C 28C IERR = IGPOLEW(PIFELD, KIWE, POFELD, KOWE, KWEIND, KWEDIST, 29C 1 KPR, KERR) 30C 31C Input parameters 32C ---------------- 33C 34C PIFELD - A "polar" row of the input field provided by the 35C calling routine. 36C 37C KIWE - The number of points in the West-East direction in 38C the input field. 39C 40C KOWE - The number of points in the West-East direction in 41C the output field. 42C 43C KWEIND - This array contains the array offsets of the West 44C and East points in the input array required for 45C interpolation. 46C 47C KWEDIST - This array holds the distances to longitude values 48C in the input field from the associated longitude 49C values in the output field. 50C 51C KPR - The debug print switch. 52C 0 , No debugging output. 53C 1 , Produce debugging output. 54C 55C KERR - The error control flag. 56C -ve, No error message. Return error code. 57C 0 , Hard failure with error message. 58C +ve, Print error message. Return error code. 59C 60C Output parameters 61C ----------------- 62C 63C POFELD - The corresponding "polar" row of the output field 64C returned to the calling routine. 65C 66C Return value 67C ------------ 68C 69C The error indicator (INTEGER). 70C 71C Error and Warning Return Values 72C 73C None 74C 75C Common block usage 76C ------------------ 77C 78C None 79C 80C Externals 81C --------- 82C 83C INTLOG(R) - Logs messages. 84C 85C Method 86C ------ 87C 88C A Gaussian field does not have a line of latitude at the pole 89C so this routine performs a linear interpolation of points on the 90C nearest Gaussian line and then puts these values into the output 91C array. The intention is to provide U and V values at the pole 92C which have a "directional" value. 93C 94C This method was originally implemented by 95C 96C K. RIDER * ECMWF * OCTOBER 1991. 97C 98C Reference 99C --------- 100C 101C None 102C 103C Comments 104C -------- 105C 106C Program contains sections 0 to 2 and 9 107C 108C Author 109C ------ 110C 111C K. Fielding *ECMWF* Oct 1993 112C 113C Modifications 114C ------------- 115C 116C Allow for missing data values 117C J.D.Chambers ECMWF August 2000 118C 119C----< 120C -----------------------------------------------------------------| 121C* Section 0. Definition of variables. 122C -----------------------------------------------------------------| 123C 124 IMPLICIT NONE 125C 126#include "parim.h" 127#include "nifld.common" 128C 129C Function arguments 130C 131 INTEGER KIWE, KOWE, KPR, KERR 132 INTEGER KWEIND(2, KOWE), KWEDIST(2, KOWE) 133 REAL PIFELD(KIWE), POFELD(KOWE) 134C 135C Local variables 136C 137 INTEGER JOLON, COUNT 138 REAL ZLOW, ZHIGH 139C 140C Statement function 141C 142 REAL A, B 143 LOGICAL NOTEQ 144 NOTEQ(A,B) = (ABS((A)-(B)).GT.(ABS(A)*1E-3)) 145C 146C -----------------------------------------------------------------| 147C* Section 1. Initialisation 148C -----------------------------------------------------------------| 149C 150 100 CONTINUE 151C 152 IF( KPR.GE.1 ) CALL INTLOG(JP_DEBUG,'IGPOLEW: Section 1.',JPQUIET) 153C 154 IGPOLEW = 0 155C 156 IF( KPR.GE.1 ) THEN 157 CALL INTLOG(JP_DEBUG,'IGPOLEW: No.input fld longs = ',KIWE) 158 CALL INTLOG(JP_DEBUG,'IGPOLEW: No.output fld longs = ',KOWE) 159 ENDIF 160C 161C -----------------------------------------------------------------| 162C* Section 2. Interpolation code for winds 163C -----------------------------------------------------------------| 164C 165 200 CONTINUE 166C 167 IF( KPR.GE.1 ) CALL INTLOG(JP_DEBUG,'IGPOLEW: Section 2.',JPQUIET) 168C 169 DO JOLON = 1, KOWE 170C 171C Compute weigths for west and east neighbours 172C 173 ZLOW = REAL(KWEDIST(JP_I_E,JOLON)) / 174 X REAL(KWEDIST(JP_I_E,JOLON) + KWEDIST(JP_I_W,JOLON) ) 175C 176 ZHIGH = PPONE - ZLOW 177C 178C Count non-missing data values 179C 180 IF( LIMISSV ) THEN 181 COUNT = 0 182 IF( NOTEQ(PIFELD(KWEIND(JP_I_W,JOLON)),RMISSGV) ) 183 X COUNT = COUNT + 1 184 IF( NOTEQ(PIFELD(KWEIND(JP_I_E,JOLON)),RMISSGV) ) 185 X COUNT = COUNT + 1 186 ELSE 187 COUNT = 2 188 ENDIF 189C 190C Interpolate using both neighbours if neither is missing 191C 192 IF( COUNT.EQ.2 ) THEN 193 POFELD(JOLON) = ZLOW * PIFELD(KWEIND(JP_I_W,JOLON)) + 194 X ZHIGH * PIFELD(KWEIND(JP_I_E,JOLON)) 195C 196C Set missing if all neighbours are missing 197C 198 ELSE IF( COUNT.EQ.0 ) THEN 199 POFELD(JOLON) = RMISSGV 200C 201C Otherwise, use the nearest neighbour 202C 203 ELSE IF( ZLOW.GT.ZHIGH ) THEN 204 POFELD(JOLON) = PIFELD(KWEIND(JP_I_W,JOLON)) 205 ELSE 206 POFELD(JOLON) = PIFELD(KWEIND(JP_I_E,JOLON)) 207 ENDIF 208C 209 ENDDO 210C 211C -----------------------------------------------------------------| 212C* Section 9. Return to calling routine. Format statements 213C -----------------------------------------------------------------| 214C 215 900 CONTINUE 216C 217 IF( KPR.GE.1 ) CALL INTLOG(JP_DEBUG,'IGPOLEW: Section 9.',JPQUIET) 218C 219 RETURN 220 END 221