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 HSH2GG(NS,EW,KTRUNC,KNUM,HTYPE,KPTS,PLATS,KSIZE)
12C
13C---->
14C**** HSH2GG
15C
16C     Purpose
17C     -------
18C
19C     Finds a suitable Gaussian grid and/or spectral truncation for a
20C     given spectral truncation and/or lat/long increments. There are
21C     three modes (by order of precedence):
22C     - providing NS,EW sets KTRUNC (using AURESOL) and KNUM/HTYPE
23C     - providing KTRUNC sets KNUM/HTYPE
24C     - providing KNUM sets KTRUNC
25C     With KNUM/HTYPE set, the Gaussian grid definition is obtained with
26C     JGETGG.
27C     Parameters with value zero are assumed not provided.
28C     Historically, this merges the functionality of:
29C     - HSP2GG
30C     - HSP2GG2
31C     - HSP2GG3
32C
33C
34C     Interface
35C     ---------
36C
37C     IRET = HSH2GG(NS,EW,KTRUNC,KNUM,HTYPE,KPTS,PLATS,KSIZE)
38C
39C
40C     Input parameters
41C     ----------------
42C     NS     - North-South increment
43C     EW     - East-West increment
44C
45C
46C     Input/output parameters
47C     ----------------
48C     KTRUNC - The spectral truncation
49C     KNUM   - Gaussian grid number
50C     HTYPE  - Gaussian grid type
51C              = 'R' for reduced ("quasi-regular"),
52C              = 'O' for reduced/octahedral,
53C              = 'F' for full,
54C              = 'U' for a user-defined Gaussian grid
55C
56C
57C     Output parameters
58C     -----------------
59C     KPTS   - Array giving number of points along each line of latitude
60C              in the reduced Gaussian grid (both hemispheres)
61C     PLATS  - Array giving Gaussian latitudes (both hemispheres)
62C     KSIZE  - The number of points in the reduced Gaussian grid
63C
64C     Returns 0 if all OK, otherwise there is an error.
65C
66C
67C     Externals
68C     ---------
69C
70C     JGETGG  - Reads the definition of a Gaussian grid
71C     AURESOL - Returns the default truncation for a given
72C               latitude--longitude grid resolution
73C
74C
75C     Author
76C     ------
77C
78C     J.D.Chambers      ECMWF      February 2001
79C
80C
81C     Modifications
82C     -------------
83C
84C     S.Curic     ECMWF      March 2005
85C     Added checking for a automatic trancation T255, T399, T799, T2047
86C     and corresponding Gaussian grid.
87C
88C     S.Curic     ECMWF      April 2008
89C     Added checking for a automatic trancation T1279
90C     and corresponding Gaussian grid.
91C
92C     S.Curic     ECMWF      Semptember 2009
93C     Match T255 and T213 against N128 instead of N160
94C     upon Alan Geer request
95C
96C
97C----<
98C     -----------------------------------------------------------------|
99C*    Section 0. Definition of variables
100C     -----------------------------------------------------------------|
101
102      IMPLICIT NONE
103#include "parim.h"
104#include "jparams.h"
105
106C     Function arguments
107      INTEGER KTRUNC, KNUM, KPTS(*), KSIZE
108      REAL NS, EW, PLATS(*)
109      CHARACTER*1 HTYPE
110
111C     Local variables
112      INTEGER I, IRET
113      REAL STEP
114
115C     Externals
116      INTEGER AURESOL
117      EXTERNAL AURESOL
118
119C     -----------------------------------------------------------------|
120C     Section 1.  Initialise
121C     -----------------------------------------------------------------|
122
123      HSH2GG = 0
124
125C     -----------------------------------------------------------------|
126C     Section 2.  Set adequate truncation/grid number
127C     -----------------------------------------------------------------|
128
129
130C     if lat/long increments are provided, set automatic KTRUNC truncation
131      IF( (KTRUNC.EQ.0) .AND. (KNUM.EQ.0) ) KTRUNC = AURESOL(NS,EW)
132
133
134C     from a given truncation (KTRUNC) find a Gaussian number (KNUM)
135      IF (KTRUNC.NE.0) THEN
136        IF( KTRUNC.NE.  63 .AND. KTRUNC.NE.  64 .AND.
137     .      KTRUNC.NE.  95 .AND. KTRUNC.NE.  96 .AND.
138     .      KTRUNC.NE. 106 .AND. KTRUNC.NE. 107 .AND.
139     .      KTRUNC.NE. 159 .AND. KTRUNC.NE. 160 .AND.
140     .      KTRUNC.NE. 191 .AND. KTRUNC.NE. 192 .AND.
141     .      KTRUNC.NE. 213 .AND. KTRUNC.NE. 214 .AND.
142     .      KTRUNC.NE. 255 .AND. KTRUNC.NE. 256 .AND.
143     .      KTRUNC.NE. 319 .AND. KTRUNC.NE. 320 .AND.
144     .      KTRUNC.NE. 399 .AND. KTRUNC.NE. 400 .AND.
145     .      KTRUNC.NE. 511 .AND. KTRUNC.NE. 512 .AND.
146     .      KTRUNC.NE. 639 .AND. KTRUNC.NE. 640 .AND.
147     .      KTRUNC.NE. 799 .AND. KTRUNC.NE. 800 .AND.
148     .      KTRUNC.NE.1279 .AND. KTRUNC.NE.1280 .AND.
149     .      KTRUNC.NE.2047 .AND. KTRUNC.NE.2048 ) THEN
150          CALL INTLOG(JP_ERROR,'HSH2GG: truncation unsupported',KTRUNC)
151          HSH2GG = 2
152          GOTO 900
153        ENDIF
154        STEP = MIN(ABS(NS),ABS(EW))
155        IF(     (KTRUNC.EQ.  63).OR.(KTRUNC.EQ.  64).OR.
156     .          (KTRUNC.EQ.  95).OR.(KTRUNC.EQ.  96).OR.
157     .          (STEP.GE.2.5) ) THEN                         ! 2.5  <= step        -> T63
158          KNUM =   48
159        ELSEIF( (KTRUNC.EQ. 106).OR.(KTRUNC.EQ. 107).OR.
160     .          (KTRUNC.EQ. 159).OR.(KTRUNC.EQ. 160).OR.
161     .          (STEP.GE.1.5) ) THEN                         ! 1.5  <= step < 2.5  -> T106
162          KNUM =   80
163        ELSEIF( (KTRUNC.EQ. 191).OR.(KTRUNC.EQ. 192).OR.
164     .          (STEP.GE.0.4 .AND. .FALSE.) ) THEN           ! 1.5  <= step < 2.5  -> T191 (commented)
165          KNUM =   96
166        ELSEIF( (KTRUNC.EQ. 213).OR.(KTRUNC.EQ. 214).OR.
167     .          (KTRUNC.EQ. 255).OR.(KTRUNC.EQ. 256).OR.     ! Enfo 2004
168     .          (STEP.GE.0.6) ) THEN                         ! 0.6  <= step < 1.5  -> T213
169          KNUM =  128
170        ELSEIF( (KTRUNC.EQ. 319).OR.(KTRUNC.EQ. 320).OR.
171     .          (STEP.GE.0.4) ) THEN                         ! 0.4  <= step < 0.6  -> T319
172          KNUM =  160
173        ELSEIF( (KTRUNC.EQ. 399).OR.(KTRUNC.EQ. 400) ) THEN  ! Enfo 2005
174          KNUM =  200
175        ELSEIF( (KTRUNC.EQ. 511).OR.(KTRUNC.EQ. 512).OR.     ! Oper 2004
176     .          (STEP.GE.0.3) ) THEN                         ! 0.3  <= step < 0.4  -> T511
177          KNUM =  256
178        ELSEIF( (KTRUNC.EQ. 639).OR.(KTRUNC.EQ. 640) ) THEN
179          KNUM =  320
180        ELSEIF( (KTRUNC.EQ. 799).OR.(KTRUNC.EQ. 800).OR.     ! Oper 2005
181     .          (STEP.GE.0.15) ) THEN                        ! 0.15 <= step < 0.3  -> T799
182          KNUM =  400
183        ELSEIF( (KTRUNC.EQ.1279).OR.(KTRUNC.EQ.1280).OR.     ! Jan Haseler
184     .          (STEP.GE.0.09) ) THEN                        ! 0.09 <= step < 0.15 -> T1279
185          KNUM =  640
186        ELSEIF( (KTRUNC.EQ.2047).OR.(KTRUNC.EQ.2048).OR.     ! Mariano
187     .          (STEP.LT.0.09) ) THEN                        ! 0.09 <= step < 0.15 -> T1279
188          KNUM = 1024
189        ENDIF
190        HTYPE = 'R'
191
192
193C     from a given Gaussian number (KNUM) find a truncation (KTRUNC)
194      ELSEIF (KNUM.NE.0) THEN
195        IF( KNUM.NE.  48 .AND. KNUM.NE.  80 .AND. KNUM.NE.  96 .AND.
196     .      KNUM.NE. 128 .AND. KNUM.NE. 160 .AND. KNUM.NE. 200 .AND.
197     .      KNUM.NE. 256 .AND. KNUM.NE. 320 .AND. KNUM.NE. 400 .AND.
198     .      KNUM.NE. 640 .AND. KNUM.NE.1024 .AND. KNUM.NE.1280 ) THEN
199        CALL INTLOG(JP_ERROR,'HSH2GG: Gaussian number unsupported',KNUM)
200          HSH2GG = 2
201          GOTO 900
202        ENDIF
203        IF(     KNUM.EQ.  48 ) THEN
204C         KTRUNC =   63
205          KTRUNC =   95
206        ELSEIF( KNUM.EQ.  80 ) THEN
207          KTRUNC =  159
208        ELSEIF( KNUM.EQ.  96 ) THEN
209          KTRUNC =  191              ! Elias 2014
210        ELSEIF( KNUM.EQ. 128 ) THEN
211C         KTRUNC =  213
212          KTRUNC =  255              ! Enfo 2004
213        ELSEIF( KNUM.EQ. 160 ) THEN
214          KTRUNC =  319
215        ELSEIF( KNUM.EQ. 200 ) THEN
216          KTRUNC =  399              ! Enfo 2005
217        ELSEIF( KNUM.EQ. 256 ) THEN
218          KTRUNC =  511              ! Oper 2004
219        ELSEIF( KNUM.EQ. 320 ) THEN
220          KTRUNC =  639
221        ELSEIF( KNUM.EQ. 400 ) THEN
222          KTRUNC =  799              ! Oper 2005
223        ELSEIF( KNUM.EQ. 640 ) THEN
224          KTRUNC = 1279              ! Jan Haseler
225        ELSEIF( KNUM.EQ.1024 ) THEN
226          KTRUNC = 2047              ! Mariano
227        ELSEIF( KNUM.EQ.1280 ) THEN
228          KTRUNC = 1279              ! (cubic octahedral)
229        ENDIF
230
231      ENDIF
232
233C     -----------------------------------------------------------------|
234C     Section 3.  Get the reduced Gaussian grid and count points
235C     -----------------------------------------------------------------|
236
237      CALL INTLOG(JP_DEBUG,'HSH2GG: spectral truncation:',KTRUNC)
238      CALL INTLOG(JP_DEBUG,'HSH2GG: Gaussian grid: '//HTYPE,KNUM)
239      IF( HTYPE.NE.'R' .AND. HTYPE.NE.'O' .AND.
240     X    HTYPE.NE.'F' .AND. HTYPE.NE.'U' ) THEN
241        CALL INTLOG(JP_ERROR,
242     X    'HSH2GG: Gaussian type unsupported: '//HTYPE,JPQUIET)
243        HSH2GG = 3
244        GOTO 900
245      ENDIF
246      CALL JGETGG(KNUM,HTYPE,PLATS,KPTS,IRET)
247      IF( IRET.NE.0 ) THEN
248        CALL INTLOG(JP_ERROR, 'HSH2GG: JGETGG failed',JPQUIET)
249        HSH2GG = 3
250      ELSE
251        KSIZE = 0
252        DO I = 1, KNUM*2
253          KSIZE = KSIZE + KPTS(I)
254        ENDDO
255      ENDIF
256
257C     -----------------------------------------------------------------|
258C     Section 9.  Return
259C     -----------------------------------------------------------------|
260
261  900 CONTINUE
262      RETURN
263
264      END
265