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      SUBROUTINE JMKOFGG( HTYPE,
12     X                    KNORTH,KSOUTH,PWEST,PEAST,KNUM,KPTS,KOFSET)
13C
14C---->
15C**** JMKOFGG
16C
17C     Purpose
18C     _______
19C
20C     This routine builds up the offsets into the storage array for
21C     every row in the gaussian grid.
22C
23C
24C     Interface
25C     _________
26C
27C     CALL JMKOFGG(HTYPE,KNORTH,KSOUTH,PWEST,PEAST,KNUM,KPTS,KOFSET)
28C
29C
30C     Input parameters
31C     ________________
32C
33C     KNUM    - Gaussian grid number
34C     HTYPE   - Gaussian grid type
35C               = 'R' for reduced ("quasi-regular"),
36C               = 'O' for reduced/octahedral,
37C               = 'F' for full,
38C               = 'U' for user-defined reduced gaussian grid
39C     KNORTH  - Northern latitude row number
40C     KSOUTH  - Southern latitude row number
41C     PWEST   - Westernmost longitude for output field (degrees)
42C     PEAST   - Easternmost longitude for output field (degrees)
43C     KPTS    - Array giving the number of points in each row for the
44C               gaussian grid
45C
46C
47C     Output parameters
48C     ________________
49C
50C     KOFSET  - Array of offsets for storing each row of the grid
51C               values in an output buffer
52C
53C
54C     Common block usage
55C     __________________
56C
57C     None
58C
59C
60C     Method
61C     ______
62C
63C     Build up the offsets allowing for latitudes which are not in the
64C     requested latitude band.  All offsets outside the latitude band
65C     are set to zero.
66C
67C
68C     Externals
69C     _________
70C
71C     None
72C
73C
74C     Reference
75C     _________
76C
77C     None
78C
79C
80C     Comments
81C     ________
82C
83C
84C
85C     Author
86C     ______
87C
88C     J.D.Chambers      ECMWF       Jan 1994
89C
90C
91C     Modifications
92C     _____________
93C
94C     None
95C
96C
97C----<
98C     _______________________________________________________
99C
100C*    Section 0. Definition of variables.
101C     _______________________________________________________
102C
103      IMPLICIT NONE
104C
105C     Subroutine arguments
106C
107      CHARACTER*1 HTYPE
108      INTEGER KNORTH, KSOUTH, KNUM, KPTS, KOFSET
109      REAL    PWEST, PEAST
110Cjdc  DIMENSION KPTS(*), KOFSET(*)
111      DIMENSION KPTS(320), KOFSET(320)
112C
113C     Local variables
114C
115      INTEGER LAT, NUMPTS
116      REAL RINTVL
117C
118C     _______________________________________________________
119C
120C*    Section 1. Fill in array of offsets
121C     _______________________________________________________
122C
123  200 CONTINUE
124C
125C     Loop through all possible latitudes
126      DO LAT = 1, 2*KNUM
127        IF ( (LAT .LT. KNORTH) .OR. (LAT .GT. KSOUTH) ) THEN
128          KOFSET(LAT) = 0
129        ELSE
130          IF ( LAT .EQ. KNORTH ) THEN
131            KOFSET(LAT) = 1
132          ELSE
133            IF( HTYPE.EQ.'R' .OR. HTYPE.EQ.'r' .OR.
134     X          HTYPE.EQ.'O' .OR. HTYPE.EQ.'o' .OR.
135     X          HTYPE.EQ.'U' .OR. HTYPE.EQ.'u' ) THEN
136              NUMPTS = KPTS(LAT -1)
137            ELSE
138              RINTVL = (PEAST - PWEST)*FLOAT( KPTS(LAT -1) ) / 360.0
139              NUMPTS = NINT( RINTVL ) + 1
140            ENDIF
141            KOFSET(LAT) = KOFSET(LAT -1) + NUMPTS
142          ENDIF
143        ENDIF
144      ENDDO
145C
146C     _______________________________________________________
147C
148C*    Section 9. Return to calling routine. Format statements
149C     _______________________________________________________
150C
151  900 CONTINUE
152C
153      RETURN
154      END
155