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