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 IGPOLEG(PIFELD, KIWE, POFELD, KOWE, KPR, KERR) 12C 13C----> 14C**** *IGPOLEG* 15C 16C Purpose 17C ------- 18C 19C Calculate the values at the pole of a regular 20C latitude/longitude field when the input is a Gaussian field. 21C 22C This routine is used for any field except a wind field. 23C 24C Interface 25C --------- 26C 27C IERR = IGPOLEG(PIFELD, KIWE, POFELD, KOWE, KPR, KERR) 28C 29C Input parameters 30C ---------------- 31C 32C PIFELD - A "polar" row of the input field provided by the 33C calling routine. 34C 35C KIWE - The number of points in the West-East direction in 36C the input field. 37C 38C KOWE - The number of points in the West-East direction in 39C the output field. 40C 41C KPR - The debug print switch. 42C 0 , No debugging output. 43C 1 , Produce debugging output. 44C 45C KERR - The error control flag. 46C -ve, No error message. Return error code. 47C 0 , Hard failure with error message. 48C +ve, Print error message. Return error code. 49C 50C Output parameters 51C ----------------- 52C 53C POFELD - The corresponding "polar" row of the output field 54C returned to the calling routine. 55C 56C Return value 57C ------------ 58C 59C The error indicator (INTEGER). 60C 61C 62C Common block usage 63C ------------------ 64C 65C None 66C 67C Externals 68C --------- 69C 70C INTLOG(R) - Logs messages. 71C 72C Method 73C ------ 74C 75C A Gaussian field does not have a line of latitude at the pole 76C so this routine forces all the values on the polar line of 77C latitude to the average of the values at the nearest Gaussian 78C line in the input field. 79C 80C This method was originally implemented by 81C 82C K. RIDER * ECMWF * OCTOBER 1991. 83C 84C Reference 85C --------- 86C 87C None 88C 89C Comments 90C -------- 91C 92C Program contains sections 0 to 2 and 9 93C 94C Author 95C ------ 96C 97C K. Fielding *ECMWF* Oct 1993 98C 99C Modifications 100C ------------- 101C 102C Allow for missing data values 103C J.D.Chambers ECMWF August 2000 104C 105C----< 106C -----------------------------------------------------------------| 107C 108 IMPLICIT NONE 109C 110#include "parim.h" 111#include "nifld.common" 112C 113C Function arguments 114C 115 INTEGER KIWE, KOWE, KPR, KERR 116 REAL PIFELD(KIWE), POFELD(KOWE) 117C 118C Local variables 119C 120 INTEGER JILON, JOLON, COUNT 121 REAL ZSUM 122C 123C Statement function 124C 125 REAL A, B 126 LOGICAL NOTEQ 127 NOTEQ(A,B) = (ABS((A)-(B)).GT.(ABS(A)*1E-3)) 128C 129C -----------------------------------------------------------------| 130C* Section 1. Initialisation 131C -----------------------------------------------------------------| 132C 133 100 CONTINUE 134C 135 IF( KPR.GE.1 ) CALL INTLOG(JP_DEBUG,'IGPOLEG: Section 1.',JPQUIET) 136C 137 IGPOLEG = 0 138C 139 IF( KPR.GE.1 ) THEN 140 CALL INTLOG(JP_DEBUG,'IGPOLEG: No. of input fld longs. = ',KIWE) 141 CALL INTLOG(JP_DEBUG,'IGPOLEG: No.of output fld longs. = ',KOWE) 142 ENDIF 143C 144C -----------------------------------------------------------------| 145C* Section 2. Use average value for non-winds 146C -----------------------------------------------------------------| 147C 148 200 CONTINUE 149C 150 IF( KPR.GE.1 ) CALL INTLOG(JP_DEBUG,'IGPOLEG: Section 2.',JPQUIET) 151C 152 ZSUM = PPZERO 153 COUNT = 0 154C 155 IF( LIMISSV ) THEN 156 DO JILON = 1, KIWE 157 IF( NOTEQ(PIFELD(JILON),RMISSGV) ) THEN 158 ZSUM = ZSUM + PIFELD(JILON) 159 COUNT = COUNT + 1 160 ENDIF 161 ENDDO 162 ELSE 163 DO JILON = 1, KIWE 164 ZSUM = ZSUM + PIFELD(JILON) 165 COUNT = COUNT + 1 166 ENDDO 167 ENDIF 168C 169 IF( COUNT.GT.0 ) THEN 170 ZSUM = ZSUM / REAL(COUNT) 171 ELSE 172 ZSUM = RMISSGV 173 ENDIF 174C 175 DO JOLON = 1, KOWE 176 POFELD(JOLON) = ZSUM 177 ENDDO 178C 179C -----------------------------------------------------------------| 180C* Section 9. Return to calling routine. Format statements 181C -----------------------------------------------------------------| 182C 183 900 CONTINUE 184C 185 IF( KPR.GE.1 ) CALL INTLOG(JP_DEBUG,'IGPOLEG: Section 9.',JPQUIET) 186C 187C 188 RETURN 189 END 190