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 GASETUP(KSEC1,KSEC2,KSEC3,KSEC4,RSEC2,ZASEC3)
12C
13C---->
14C**** GASETUP
15C
16C     Purpose
17C     -------
18C
19C     Setup GRIB sections 1, 2, 3 & 4 for the new interpolation product.
20C     For grib_api.
21C
22C     Interface
23C     ---------
24C
25C     IRET GASETUP(KSEC1,KSEC2,KSEC3,KSEC4,RSEC2,ZASEC3)
26C
27C     Input
28C     -----
29C
30C     KSEC1   - Section 1 values
31C     KSEC2   - Section 2 values
32C     KSEC3   - Section 3 values
33C     KSEC4   - Section 4 values
34C     RSEC2   - Section 2 values, auxiliary (for floating numbers requiring sub-millidegree representations)
35C     ZASEC3  - ?
36C
37C     Output
38C     ------
39C
40C     KSEC1   - Section 1 values (modified)
41C     KSEC2   - Section 2 values (modified)
42C     KSEC3   - Section 3 values (modified)
43C     KSEC4   - Section 4 values (modified)
44C     RSEC2   - Section 2 values, auxiliary (for floating numbers requiring sub-millidegree representations)
45C     ZASEC3  - ?
46C
47C     Method
48C     ------
49C
50C     Use common block values and existing values from the original GRIB
51C     product used for interpolation.
52C
53C
54C     Externals
55C     ---------
56C
57C     INTLOG   - Logs messages.
58C
59C
60C     Author
61C     ------
62C
63C     J.D.Chambers     ECMWF     Aug 1994
64C
65C----<
66C
67      IMPLICIT NONE
68C
69#include "parim.h"
70#include "nifld.common"
71#include "nofld.common"
72#include "intf.h"
73#include "grfixed.h"
74C
75C     Parameter(s)
76C
77      INTEGER JPROUTINE
78      PARAMETER ( JPROUTINE = 19100 )
79C
80C     Function arguments
81C
82      INTEGER KSEC1(*), KSEC2(*), KSEC3(*), KSEC4(*)
83      REAL RSEC2(JPGRIB_ISEC2), ZASEC3(*)
84C
85C     Local variables
86C
87      LOGICAL LIROTAT, LOROTAT
88      INTEGER ITEMP
89      REAL RTEMP
90C
91C***********************************************************************
92C     Section 1.   Startup.
93C***********************************************************************
94C
95 100  CONTINUE
96C
97      GASETUP = 0
98C
99C     Check a recognized data representation type is being processed
100C
101      IF ( (NOREPR .NE.JPREGULAR  ) .AND.
102     X     (NOREPR .NE.JPREGROT   ) .AND.
103     X     (NOREPR .NE.JPGAUSSIAN ) .AND.
104     X     (NOREPR .NE.JPFGGROT   ) .AND.
105     X     (NOREPR .NE.JPQUASI    ) .AND.
106     X     (NOREPR .NE.JPQGGROT   ) .AND.
107     X     (NOREPR .NE.JPSPHROT   ) .AND.
108     X     (NOREPR .NE.JPREDLL    ) .AND.
109     X     (NOREPR .NE.JPSPHERE   ) ) GOTO 910
110C
111C     Set flags if input is rotated or if a rotation angle has been given
112C
113      LIROTAT = (NIREPR.EQ.JPSPHROT).OR.
114     X          (NIREPR.EQ.JPREGROT).OR.
115     X          (NIREPR.EQ.JPFGGROT).OR.
116     X          (NIREPR.EQ.JPQGGROT)
117C
118      LOROTAT = ((NOROTA(1).NE.-9000000).AND.(NOROTA(1).NE.0)).OR.
119     X          (NOROTA(2).NE.0)
120     X          .OR. (NOREPR.EQ.JPSPHROT .OR.
121     X                NOREPR.EQ.JPREGROT .OR.
122     X                NOREPR.EQ.JPFGGROT .OR.
123     X                NOREPR.EQ.JPQGGROT)
124C
125C***********************************************************************
126C     Section 2.   Setup output product section 2.
127C***********************************************************************
128C
129 300  CONTINUE
130C
131C     Data representation type
132C
133C     Adjust output representation type if field is rotated
134C
135      IF( LIROTAT.OR.LOROTAT ) THEN
136        KSEC2(1) = NOREPR
137        IF(NOREPR.EQ.JPREGULAR )  KSEC2(1) = JPREGROT
138        IF(NOREPR.EQ.JPSPHERE )   KSEC2(1) = JPSPHROT
139        IF(NOREPR.EQ.JPQUASI )    KSEC2(1) = JPFGGROT
140        IF(NOREPR.EQ.JPQGGROT )   KSEC2(1) = JPFGGROT
141        IF(NOREPR.EQ.JPGAUSSIAN ) KSEC2(1) = JPFGGROT
142C
143      ELSE
144C
145        IF( (NOREPR.EQ.JPQUASI).OR.(NOREPR.EQ.JPQGGROT) ) THEN
146          KSEC2(1) = JPGAUSSIAN
147        ELSE
148          KSEC2(1) = NOREPR
149        ENDIF
150      ENDIF
151C
152C***********************************************************************
153C     Section 3.1. Setup section 2 for lat/long, equidistant
154C                  cylindrical or plate carre grids.
155C***********************************************************************
156C
157 310  CONTINUE
158C
159      IF ( (NOREPR.EQ.JPREGULAR).OR.(NOREPR.EQ.JPREGROT) ) THEN
160C
161C       For south to north grids, only global area allowed (eg KWBC SST)
162C
163cs        IF( KSEC2(4).LT.KSEC2(7) ) THEN
164cs          IF((NOAAPI(1).NE.(-NOAAPI(3))).AND.(NOAAPI(3).NE.JP90)) THEN
165cs            CALL INTLOG(JP_ERROR,
166cs     X        'GASETUP: Subareas not allowed interpolating',JPQUIET)
167cs            CALL INTLOG(JP_ERROR,
168cs     X        'GASETUP: grids running from south to north',JPQUIET)
169cs            GASETUP = JPROUTINE + 2
170cs            GOTO 900
171cs          ENDIF
172cs        ENDIF
173C
174C       Number of points along a parallel
175C
176        KSEC2(2) = NOWE
177C
178C       Number of points along a meridian
179C
180        KSEC2(3) = NONS
181C
182C       Resolution flag, increments are given
183C
184        KSEC2(6) = 128
185C
186C       Latitude and longitude of first/last grid point
187C       La1/Lo1 - NOAAPI(1): north, NOAAPI(2): west
188C       La2/Lo2 - NOAAPI(3): south, NOAAPI(4): east
189C       EMOS-214: store REAL values in parallel data structure (real precision), for values that requiring sub-millidegree precision
190C
191        IF( NOAAPI(1).GE.0 ) THEN
192          KSEC2(4) = (NOAAPI(1)+(JPMICRO/2)) / JPMICRO
193        ELSE
194          KSEC2(4) = (NOAAPI(1)-(JPMICRO/2)) / JPMICRO
195        ENDIF
196        IF( NOAAPI(2).GE.0 ) THEN
197          KSEC2(5) = (NOAAPI(2)+(JPMICRO/2)) / JPMICRO
198        ELSE
199          KSEC2(5) = (NOAAPI(2)-(JPMICRO/2)) / JPMICRO
200        ENDIF
201        IF( NOAAPI(3).GE.0 ) THEN
202          KSEC2(7) = (NOAAPI(3)+(JPMICRO/2)) / JPMICRO
203        ELSE
204          KSEC2(7) = (NOAAPI(3)-(JPMICRO/2)) / JPMICRO
205        ENDIF
206        IF( NOAAPI(4).GE.0 ) THEN
207          KSEC2(8) = (NOAAPI(4)+(JPMICRO/2)) / JPMICRO
208        ELSE
209          KSEC2(8) = (NOAAPI(4)-(JPMICRO/2)) / JPMICRO
210        ENDIF
211        RSEC2(4:5) = FLOAT(NOAAPI(1:2))/JPMULT
212        RSEC2(7:8) = FLOAT(NOAAPI(3:4))/JPMULT
213C
214C       Flip latitudes if they run from south to north
215C       Set scanning mode flags
216C
217        IF( NOAAPI(1).LT.NOAAPI(3) ) THEN
218          IF( LNOGRID ) THEN
219            ITEMP = KSEC2(7)
220            KSEC2(7) = KSEC2(4)
221            KSEC2(4) = ITEMP
222            RTEMP = RSEC2(7)
223            RSEC2(7) = RSEC2(4)
224            RSEC2(4) = RTEMP
225            KSEC2(11) = 0
226          ELSE
227            KSEC2(11) = 64
228          ENDIF
229        ELSE
230          KSEC2(11) = NOSCNM
231        ENDIF
232C
233C       i and j  direction increments
234C       EMOS-214: store REAL values in parallel data structure (real precision), for values that requiring sub-millidegree precision
235C
236        KSEC2( 9) = (NOGRID(1) + (JPMICRO/2)) / JPMICRO
237        KSEC2(10) = (NOGRID(2) + (JPMICRO/2)) / JPMICRO
238        RSEC2( 9) = FLOAT(NOGRID(1))/JPMULT
239        RSEC2(10) = FLOAT(NOGRID(2))/JPMULT
240C
241C       Following left same as for input product
242C       - no.of vertical coordinate parameters,
243C       - lat/long of southern pole of rotation
244C       - lat/long of pole of stretching
245C
246C       If rotated, put in new lat/long of southern pole of rotation
247C       EMOS-214: store REAL values in parallel data structure (real precision), for values that requiring sub-millidegree precision
248C
249        IF( LIROTAT.OR.LOROTAT ) THEN
250          IF( NOROTA(1).GE.0 ) THEN
251            KSEC2(13) = (NOROTA(1) + (JPMICRO/2)) / JPMICRO
252          ELSE
253            KSEC2(13) = (NOROTA(1) - (JPMICRO/2)) / JPMICRO
254          ENDIF
255          IF( NOROTA(2).GE.0 ) THEN
256            KSEC2(14) = (NOROTA(2) + (JPMICRO/2)) / JPMICRO
257          ELSE
258            KSEC2(14) = (NOROTA(2) - (JPMICRO/2)) / JPMICRO
259          ENDIF
260          RSEC2(13:14) = FLOAT(NOROTA(1:2))/JPMULT
261        ENDIF
262C
263C       Regular grid flag
264C
265        KSEC2(17) = 0
266C
267C       Following left same as for input product
268C       - earth flag
269C       - components flag
270C     Set the components flag for rotated U and V coefficients
271C
272        IF(LUVCOMP) THEN
273          KSEC2(19) = 8
274        ENDIF
275
276C       - reserved fields
277C
278C     OCEAN
279        IF(LOCEAN) THEN
280c there is always bitmap for ocean
281          ZASEC3(2) = RMISSGV
282          KSEC3(2)  = int(RMISSGV)
283          KSEC1(5)  = 192
284c-------------------
285          KSEC1(37) = 4
286          KSEC1(60) = NIOCO3
287          KSEC1(61) = NIOCO4
288          KSEC1(62) = NOOCO4F
289          KSEC1(63) = NOOCO3F
290          KSEC1(64) = NOOCO4L
291          KSEC1(65) = NOOCO3L
292          KSEC1(66) = NOOIINC
293          KSEC1(67) = NOOJINC
294          KSEC1(68) = NOOIRGR
295          KSEC1(69) = NOONOST
296          KSEC1(71) = 0
297          KSEC1(72) = 0
298          KSEC1(73) = 0
299          KSEC1(74) = 0
300        ENDIF
301      ENDIF
302C
303C***********************************************************************
304C     Section 3.2. Setup section 2 for gaussian grids.
305C***********************************************************************
306C
307 320  CONTINUE
308C
309      IF ( NOREPR.EQ.JPQUASI    .OR. NOREPR.EQ.JPQGGROT .OR.
310     X     NOREPR.EQ.JPGAUSSIAN .OR. NOREPR.EQ.JPFGGROT ) THEN
311C
312C       Number of points along a parallel
313C
314C       For a regular gaussian grid only
315        IF( (NOREPR.EQ.JPGAUSSIAN).OR.(NOREPR.EQ.JPFGGROT) ) THEN
316          KSEC2(2) = NOWE
317        ELSE
318          KSEC2(2) = 0
319        ENDIF
320C
321C       Number of points along a meridian
322C
323        KSEC2(3) = NONS
324C
325C       Resolution flag
326C       For a regular gaussian grid only, increments are given
327C
328        IF( (NOREPR.EQ.JPGAUSSIAN).OR.(NOREPR.EQ.JPFGGROT) ) THEN
329          KSEC2(6) = 128
330        ELSE
331          KSEC2(6) = 0
332        ENDIF
333C
334C       Latitude and longitude of first/last grid point
335C       La1/Lo1 - NOAAPI(1): north, NOAAPI(2): west
336C       La2/Lo2 - NOAAPI(3): south, NOAAPI(4): east
337C       EMOS-214: store REAL values in parallel data structure (real precision), for values that requiring sub-millidegree precision
338C
339        IF( NOAAPI(1).GE.0 ) THEN
340          KSEC2(4) = (NOAAPI(1)+(JPMICRO/2)) / JPMICRO
341        ELSE
342          KSEC2(4) = (NOAAPI(1)-(JPMICRO/2)) / JPMICRO
343        ENDIF
344        IF( NOAAPI(2).GE.0 ) THEN
345          KSEC2(5) = (NOAAPI(2)+(JPMICRO/2)) / JPMICRO
346        ELSE
347          KSEC2(5) = (NOAAPI(2)-(JPMICRO/2)) / JPMICRO
348        ENDIF
349        IF( NOAAPI(3).GE.0 ) THEN
350          KSEC2(7) = (NOAAPI(3)+(JPMICRO/2)) / JPMICRO
351        ELSE
352          KSEC2(7) = (NOAAPI(3)-(JPMICRO/2)) / JPMICRO
353        ENDIF
354        IF( NOAAPI(4).GE.0 ) THEN
355          KSEC2(8) = (NOAAPI(4)+(JPMICRO/2)) / JPMICRO
356        ELSE
357          KSEC2(8) = (NOAAPI(4)-(JPMICRO/2)) / JPMICRO
358        ENDIF
359        RSEC2(4:5) = FLOAT(NOAAPI(1:2))/JPMULT
360        RSEC2(7:8) = FLOAT(NOAAPI(3:4))/JPMULT
361        IF( (.NOT. LNOAREA .AND. (
362     X      (NOREPR.EQ.JPQUASI    .OR. NOREPR.EQ.JPQGGROT))) .OR.
363     X      (LGLOBL .AND.
364     X      (NOREPR.EQ.JPGAUSSIAN .OR. NOREPR.EQ.JPFGGROT)) ) THEN
365          RSEC2(4) = ROGAUSS(1)
366          RSEC2(5) = 0
367          RSEC2(7) = ROGAUSS(NOGAUSS*2)
368          RSEC2(8) = 360. - 360./FLOAT(NOLPTS(NOGAUSS))
369        ENDIF
370C
371C       i direction increment
372C
373C       For a regular gaussian grid, only
374C
375        KSEC2(9) = 0
376        RSEC2(9) = 0.
377        IF( (NOREPR.EQ.JPGAUSSIAN).OR.(NOREPR.EQ.JPFGGROT) ) THEN
378          KSEC2(9) = (((JP90)/NOGAUSS)+(JPMICRO/2)) / JPMICRO
379          RSEC2(9) = (FLOAT(JP90)/FLOAT(NOGAUSS))/JPMULT
380        ENDIF
381C
382C       Number of parallels between a pole and the Equator
383C
384        KSEC2(10) = NOGAUSS
385C
386C       Scanning mode flags
387C
388        KSEC2(11) = NOSCNM
389C
390C       Following left same as for input product
391C       - no.of vertical coordinate parameters,
392C       - lat/long of southern pole of rotation
393C       - lat/long of pole of stretching
394C
395C       If rotated, put in new lat/long of southern pole of rotation
396C       EMOS-214: store REAL values in parallel data structure (real precision), for values that requiring sub-millidegree precision
397C
398        IF( LIROTAT.OR.LOROTAT ) THEN
399          IF( NOROTA(1).GE.0 ) THEN
400            KSEC2(13) = (NOROTA(1) + (JPMICRO/2)) / JPMICRO
401          ELSE
402            KSEC2(13) = (NOROTA(1) - (JPMICRO/2)) / JPMICRO
403          ENDIF
404          IF( NOROTA(2).GE.0 ) THEN
405            KSEC2(14) = (NOROTA(2) + (JPMICRO/2)) / JPMICRO
406          ELSE
407            KSEC2(14) = (NOROTA(2) - (JPMICRO/2)) / JPMICRO
408          ENDIF
409          RSEC2(13:14) = FLOAT(NOROTA(1:2))/JPMULT
410        ENDIF
411C
412C       Regular grid flag
413C
414        IF( (NOREPR.EQ.JPGAUSSIAN).OR.(NOREPR.EQ.JPFGGROT) ) THEN
415          KSEC2(17) = 0
416        ELSE
417          KSEC2(17) = 1
418        ENDIF
419C
420C       Following left same as for input product
421C       - earth flag
422C       - components flag
423C     Set the components flag for rotated U and V coefficients
424C
425        IF(LUVCOMP) THEN
426          KSEC2(19) = 8
427        ENDIF
428
429C       - reserved fields
430C
431C       For reduced grid, move in number of points along each parallel
432C
433          IF( (NOREPR.EQ.JPQUASI) .OR.
434     X        (NOREPR.EQ.JPQGGROT) ) THEN
435          DO ITEMP = 1, KSEC2(3)
436            KSEC2(22+ITEMP) = NOLPTS(ITEMP)
437          ENDDO
438        ENDIF
439C
440      ENDIF
441C
442C***********************************************************************
443C     Section 3.3. Setup section 2 for spherical harmonic coefficients.
444C***********************************************************************
445C
446 330  CONTINUE
447C
448      IF ( (NOREPR.EQ.JPSPHERE).OR.(NOREPR.EQ.JPSPHROT) ) THEN
449C
450C       I, K, M pentagonal resolution parameters
451C
452        KSEC2(2) = NORESO
453        KSEC2(3) = NORESO
454        KSEC2(4) = NORESO
455C
456C       Representation type, associated legendre functions of the
457C                            first kind
458        KSEC2(5) = 1
459C
460C       Representation mode, complex packing
461C
462        KSEC2(6) = 2
463C
464C       Following left same as for input product
465C       - reserved words 7-11
466C       - no.of vertical coordinate parameters,
467C       - lat/long of southern pole of rotation
468C       - lat/long of pole of stretching
469C       - reserved words 17-22
470C
471C       If rotated, put in new lat/long of southern pole of rotation
472C       EMOS-214: store REAL values in parallel data structure (real precision), for values that requiring sub-millidegree precision
473C
474        IF( LIROTAT.OR.LOROTAT ) THEN
475          IF( NOROTA(1).GE.0 ) THEN
476            KSEC2(13) = (NOROTA(1) + (JPMICRO/2)) / JPMICRO
477          ELSE
478            KSEC2(13) = (NOROTA(1) - (JPMICRO/2)) / JPMICRO
479          ENDIF
480          IF( NOROTA(2).GE.0 ) THEN
481            KSEC2(14) = (NOROTA(2) + (JPMICRO/2)) / JPMICRO
482          ELSE
483            KSEC2(14) = (NOROTA(2) - (JPMICRO/2)) / JPMICRO
484          ENDIF
485          RSEC2(13:14) = FLOAT(NOROTA(1:2))/JPMULT
486        ENDIF
487      ENDIF
488C
489C***********************************************************************
490C     Section 3.   Setup output bitmap section 3.
491C***********************************************************************
492      IF(ISEC1(5).EQ.192) THEN
493         KSEC3(2)  = NINT(RMISSGV)
494         ZASEC3(2) = RMISSGV
495cs         KSEC3(2)  = ISEC3(2)
496cs         ZASEC3(2) = ZSEC3(2)
497         KSEC1(5)  = 192
498         ISEC1(5)  = 0
499      ENDIF
500C
501C***********************************************************************
502C     Section 4.   Setup output product section 4.
503C***********************************************************************
504C
505 400  CONTINUE
506C
507C     Number of values to be packed
508C
509      IF ( (NOREPR.EQ.JPSPHERE).OR.(NOREPR.EQ.JPSPHROT) ) THEN
510        KSEC4(1) = (NORESO + 1) * (NORESO + 2)
511      ELSE IF( (NOREPR.EQ.JPQUASI).OR.(NOREPR.EQ.JPQGGROT) ) THEN
512        KSEC4(1) = NOPCNT
513      ELSE
514        KSEC4(1) = NOWE * NONS
515      ENDIF
516C
517C     If all the values are missing, set the count of values negative
518C
519      IF(NOMISS.NE.0) THEN
520        KSEC4(1) = -KSEC4(1)
521      ENDIF
522C
523C     Number of bits used for each packed value
524C
525      IF(LNOACC) THEN
526        KSEC4(2) = NOACC
527      ELSE
528        KSEC4(2) = NIACC
529      ENDIF
530C
531C     Type of data, spherical harmonic = 128, grid point = 0
532C
533      IF ( (NOREPR.EQ.JPSPHERE).OR.(NOREPR.EQ.JPSPHROT) ) THEN
534        KSEC4(3) = 128
535      ELSE
536        KSEC4(3) = 0
537      ENDIF
538C
539C     Type of packing, spherical harmonic = complex
540C
541      IF ( (NOREPR.EQ.JPSPHERE).OR.(NOREPR.EQ.JPSPHROT) ) THEN
542        KSEC4(4) = 1
543      ELSE
544        KSEC4(4) = 4
545      ENDIF
546
547C     Sinisa added jpeg packing just for merging with grib_api
548        IF( NOHFUNC.EQ.'C' ) THEN
549c  spectral complex
550            KSEC4(4) = 1
551        ELSEIF( NOHFUNC.EQ.'S'.AND.NOREPR.EQ.JPSPHERE ) THEN
552c  spectral simple
553            KSEC4(4) = 2
554        ELSEIF( NOHFUNC.EQ.'J' ) THEN
555c  grid jpeg
556            KSEC4(4) = 3
557        ELSEIF( NOHFUNC.EQ.'S' ) THEN
558c  grid simple
559            KSEC4(4) = 4
560        ELSEIF( NOHFUNC.EQ.'K' ) THEN
561c  grid second order
562            KSEC4(4) = 7
563        ENDIF
564C
565C     Type of data = floating point
566C
567      KSEC4(5) = 0
568C
569C     Additional flags indicator = none
570C
571      KSEC4(6) = 0
572C
573C     Reserved word, set to 0
574C
575      KSEC4(7) = 0
576C
577C     Following set to simplest case
578C     - no.of values indicator
579C     - secondary bitmaps indicator
580C     - values width indicator
581C     - no.of bits for 2nd order values
582C
583      KSEC4(8)  = 0
584      KSEC4(9)  = 0
585      KSEC4(10) = 0
586      KSEC4(11) = 0
587C
588C     Reserved words, set to 0
589C
590      KSEC4(12) = 0
591      KSEC4(13) = 0
592      KSEC4(14) = 0
593      KSEC4(15) = 0
594C
595C     If spherical harmonics, set following for complex packing
596C
597      IF ( (NOREPR.EQ.JPSPHERE).OR.(NOREPR.EQ.JPSPHROT) ) THEN
598C
599C       KSEC4(16), pointer to start of packed data, setup by packing
600C       KSEC4(17), scaling factor P, unchanged from input
601C       KSEC4(18), pentagonal resolution parameter J for packing of subset,
602C                  unchanged from input
603C       KSEC4(19), pentagonal resolution parameter K for packing of subset,
604C                  unchanged from input
605C       KSEC4(20), pentagonal resolution parameter M for packing of subset,
606C                  unchanged from input
607C
608      ELSE
609        KSEC4(16:20) = 0
610      ENDIF
611C
612C     Words 21-33 reserved, set to zero.
613C
614      KSEC4(21:33) = 0
615C
616C***********************************************************************
617C     Section 9.   Closedown
618C***********************************************************************
619C
620 900  CONTINUE
621C
622      RETURN
623C
624C     Invalid data represntation type
625C
626 910  CONTINUE
627      CALL INTLOG(JP_ERROR,
628     X  'GASETUP: Data representation type not recognized: ',NOREPR)
629      CALL INTLOG(JP_ERROR,
630     X  'GASETUP: Only the following types are recognized:',JPQUIET)
631      CALL INTLOG(JP_ERROR,'GASETUP: Lat/long grid = ', JPREGULAR)
632      CALL INTLOG(JP_ERROR,'GASETUP: Lat/long (rotated) = ', JPREGROT)
633      CALL INTLOG(JP_ERROR,'GASETUP: regular gaussian = ', JPGAUSSIAN)
634      CALL INTLOG(JP_ERROR,'GASETUP: reg gauss rotated = ', JPFGGROT)
635      CALL INTLOG(JP_ERROR,'GASETUP: reduced gaussian = ', JPQUASI)
636      CALL INTLOG(JP_ERROR,'GASETUP: red gauss rotated = ', JPQUASI)
637      CALL INTLOG(JP_ERROR,'GASETUP: spherical harmonic = ', JPSPHERE)
638      CALL INTLOG(JP_ERROR,'GASETUP: spectral (rotated) = ', JPSPHROT)
639C
640      GASETUP = JPROUTINE + 1
641      RETURN
642      END
643