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 ISCRSZ() 12C----> 13C**** ISCRSZ 14C 15C Purpose 16C ------- 17C 18C Calculate size of scratch space required for output field of 19C interpolation. 20C 21C 22C Interface 23C --------- 24C 25C ISIZE = ISCRSZ() 26C 27C 28C Input 29C ----- 30C 31C Values in common blocks "nofld.common". 32C 33C 34C Output 35C ------ 36C 37C Size as number of values (words). 38C Returns 0 if output type not recognised. 39C 40C 41C Method 42C ------ 43C 44C Depends on output grid type. 45C 46C 47C Externals 48C --------- 49C 50C INTLOG - Log error message 51C JNORSGG - Calculate gaussian latitude 52C NUMPTWE - Calculate number of grid pts in range from west to east 53C 54C 55C Author 56C ------ 57C 58C J.D.Chambers ECMWF Feb 1995 59C 60C----< 61C 62 IMPLICIT NONE 63C 64#include "parim.h" 65#include "nofld.common" 66#include "grfixed.h" 67C 68C Local variables 69C 70 INTEGER LOOP 71 REAL PNORTH, PWEST, PSOUTH, PEAST, TEMP !, GRID 72C 73C Externals 74C 75 EXTERNAL JNORSGG, NUMPTWE 76 INTEGER JNORSGG, NUMPTWE 77C 78C Statement functions 79C 80 REAL X, Y 81 LOGICAL SOUTHOF 82 SOUTHOF(X,Y) = ((X) - (Y)).GT.-1E-4 83C 84C -----------------------------------------------------------------| 85C Section 1. Initialise. 86C -----------------------------------------------------------------| 87C 88 100 CONTINUE 89C 90 ISCRSZ = 0 91C 92C -----------------------------------------------------------------| 93C* Section 2. Spherical harmonic field 94C -----------------------------------------------------------------| 95C 96 200 CONTINUE 97C 98 IF( (NOREPR.EQ.JPSPHERE).OR. 99 X (NOREPR.EQ.JPSTRSH).OR. 100 X (NOREPR.EQ.JPSPHROT) ) THEN 101cs ISCRSZ = (NORESO+1) * (NORESO+4) 102 ISCRSZ = (NORESO+1) * (NORESO+2) 103 CALL INTLOG(JP_DEBUG,'ISCRSZ: spherical harmonic',JPQUIET) 104 GOTO 900 105 ENDIF 106C 107C -----------------------------------------------------------------| 108C* Section 3. Regular lat/long field 109C -----------------------------------------------------------------| 110C 111 300 CONTINUE 112C 113 IF( (NOREPR.EQ.JPREGULAR).OR.(NOREPR.EQ.JPREGROT) ) THEN 114C 115 TEMP = ABS(FLOAT(NOAREA(1)) - FLOAT(NOAREA(3))) 116 NONS = NINT( TEMP / FLOAT(NOGRID(2)) ) + 1 117 TEMP = FLOAT(NOAREA(4)) - FLOAT(NOAREA(2)) 118 NOWE = NINT( TEMP / FLOAT(NOGRID(1)) ) + 1 119C 120 ISCRSZ = NONS * NOWE 121 CALL INTLOG(JP_DEBUG,'ISCRSZ: number of latitudes = ', NONS) 122 CALL INTLOG(JP_DEBUG,'ISCRSZ: number of longitudes = ', NOWE) 123 CALL INTLOG(JP_DEBUG,'ISCRSZ: Regular lat/long',JPQUIET) 124 GOTO 900 125 ENDIF 126C 127C -----------------------------------------------------------------| 128C* Section 4. Regular gaussian field 129C -----------------------------------------------------------------| 130C 131 400 CONTINUE 132C 133 IF( (NOREPR.EQ.JPGAUSSIAN).OR.(NOREPR.EQ.JPFGGROT) ) THEN 134C 135 PNORTH = FLOAT( NOAREA(1) ) / PPMULT 136 PSOUTH = FLOAT( NOAREA(3) ) / PPMULT 137 NO1NS = JNORSGG( PNORTH, ROGAUSS, NOGAUSS, 1) 138 NONS = JNORSGG( PSOUTH, ROGAUSS, NOGAUSS, 1) - NO1NS + 1 139 TEMP = FLOAT(NOAREA(4)) - FLOAT(NOAREA(2)) 140 TEMP = (TEMP * FLOAT(NOGAUSS) ) / FLOAT(JP90) 141CS added for grib2 142 LGLOBL = (NONS.EQ.NOGAUSS*2.AND.NOAREA(2).EQ.0) 143 NOWE = NINT(TEMP) + 1 144 IF( LGLOBL ) NOWE = 4*NOGAUSS 145C 146 ISCRSZ = NONS * NOWE 147 CALL INTLOG(JP_DEBUG,'ISCRSZ: number of latitudes = ', NONS) 148 CALL INTLOG(JP_DEBUG,'ISCRSZ: number of longitudes = ', NOWE) 149 CALL INTLOG(JP_DEBUG,'ISCRSZ: regular gaussian',JPQUIET) 150 GOTO 900 151 ENDIF 152C 153C -----------------------------------------------------------------| 154C* Section 5. Reduced (quasi-regular) gaussian field 155C -----------------------------------------------------------------| 156C 157 500 CONTINUE 158C 159 IF( (NOREPR.EQ.JPQUASI).OR.(NOREPR.EQ.JPQGGROT) ) THEN 160C 161 PNORTH = FLOAT( NOAREA(1) ) / PPMULT 162 PWEST = FLOAT( NOAREA(2) ) / PPMULT 163 PSOUTH = FLOAT( NOAREA(3) ) / PPMULT 164 PEAST = FLOAT( NOAREA(4) ) / PPMULT 165 NO1NS = JNORSGG( PNORTH, ROGAUSS, NOGAUSS, 1) 166 NONS = JNORSGG( PSOUTH, ROGAUSS, NOGAUSS, 1) - NO1NS + 1 167CS added for grib2 168 LGLOBL = (NONS.EQ.NOGAUSS*2.AND.NOAREA(2).EQ.0) 169 NOWE = 0 170C 171 NOPCNT = 0 172 DO LOOP = 1, NOGAUSS*2 173 IF( SOUTHOF(PNORTH,ROGAUSS(LOOP)).AND. 174 X SOUTHOF(ROGAUSS(LOOP),PSOUTH) ) THEN 175C 176C EMOS-186: disregard area cropping east/west-wise, it seems 177C NUMPTWE assumptions don't hold for RGG/octahedral 178C GRID = 360.0 / REAL(NOLPTS(LOOP)) 179C NOPCNT = NOPCNT + NUMPTWE(PWEST,PEAST,GRID) 180 NOPCNT = NOPCNT + NOLPTS(LOOP) 181C 182 ENDIF 183 ENDDO 184C 185 ISCRSZ = NOPCNT 186 CALL INTLOG(JP_DEBUG,'ISCRSZ: number of latitudes = ', NONS) 187 CALL INTLOG(JP_DEBUG,'ISCRSZ: quasi-regular gaussian',JPQUIET) 188 GOTO 900 189 ENDIF 190C 191C -----------------------------------------------------------------| 192C* Section 9. Return 193C -----------------------------------------------------------------| 194C 195 900 CONTINUE 196C 197 CALL INTLOG(JP_DEBUG, 198 X 'ISCRSZ: number of points in output field = ',ISCRSZ) 199C 200 RETURN 201 END 202