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 IGDINS (KILATG, KINS, KOLATG, KONS, ONPOLE,
12     1   OSPOLE, KNSIND, KNSDIST, KPR, KERR)
13C
14C---->
15C**** *IGDINS*
16C
17C     PURPOSE
18C     _______
19C
20C     Calculate the distances between points in an output latitude
21C     array and its North and South neighbours in the input latitude
22C     array.
23C
24C     INTERFACE
25C     _________
26C
27C     IERR = IGDINS (KILATG, KINS, KOLATG, KONS, ONPOLE, OSPOLE,
28C    1   KNSIND, KNSDIST, KPR, KERR)
29C
30C     Input parameters
31C     ________________
32C
33C     KILATG     - The array of input latitudes.
34C
35C     KINS       - The number of points in the North-South direction
36C                  in the input field.
37C
38C     KOLATG     - The array of output latitudes.
39C
40C     KONS       - The number of points in the North-South direction
41C                  in the output field.
42C
43C     ONPOLE     - This variable will be true if the input field
44C                  includes the most Northerly line of latitude for
45C                  the field type. This means latitude 90 North for
46C                  a regular field and the first line of a Gaussian
47C                  field.
48C
49C     OSPOLE     - This variable will be true if the input field
50C                  includes the most Southerly line of latitude for
51C                  the field type. This means latitude 90 South for
52C                  a regular field and the last line of a Gaussian
53C                  field.
54C
55C     KPR        - The debug print switch.
56C                  0  , No debugging output.
57C                  1  , Produce debugging output.
58C
59C     KERR       - The error control flag.
60C                  -ve, No error message. Return error code.
61C                  0  , Hard failure with error message.
62C                  +ve, Print error message. Return error code.
63C
64C     Output parameters
65C     ________________
66C
67C     KNSIND     - This array will contain the array offsets of the
68C                  North and South points in the input array required
69C                  for interpolation.
70C
71C     KNSDIST    - This array will contain the distances to lines
72C                  in input field from the associated lines of
73C                  latitude in the output field.
74C
75C     Return value
76C     ____________
77C
78C     The error indicator (INTEGER).
79C
80C     Error and Warning Return Values
81C     _______________________________
82C
83C     24501 An output latitude was found that was outside the area
84C           spanned by the input latitudes.
85C
86C     Common block usage
87C     __________________
88C
89C     None
90C
91C     EXTERNALS
92C     _________
93C
94C     INTLOG(R)    - Logs messages.
95C
96C     METHOD
97C     ______
98C
99C     This routine will create the arrays of offsets and distance as
100C     two arrays of length (2, Number of output latitudes).
101C
102C     If an input Gaussian grid includes the "polar" line and the
103C     output field includes a line of latitude between this "polar"
104C     line and the pole then the position of this "polar" Gaussian
105C     line is assumed to be at the pole for that line of latitude only.
106C
107C     REFERENCE
108C     _________
109C
110C     None
111C
112C     COMMENTS
113C     ________
114C
115C     Program contains sections 0 to 2 and 9
116C
117C     AUTHOR
118C     ______
119C
120C     K. Fielding      *ECMWF*      Oct 1993
121C
122C     MODIFICATIONS
123C     _____________
124C
125C     None
126C
127C----<
128C     _______________________________________________________
129C
130C
131C*    Section 0. Definition of variables.
132C     _______________________________________________________
133C
134C*    Prefix conventions for variable names
135C
136C     Logical      L (but not LP), global or common.
137C                  O, dummy argument
138C                  G, local variable
139C                  LP, parameter.
140C     Character    C, global or common.
141C                  H, dummy argument
142C                  Y (but not YP), local variable
143C                  YP, parameter.
144C     Integer      M and N, global or common.
145C                  K, dummy argument
146C                  I, local variable
147C                  J (but not JP), loop control
148C                  JP, parameter.
149C     REAL         A to F and Q to X, global or common.
150C                  P (but not PP), dummy argument
151C                  Z, local variable
152C                  PP, parameter.
153C
154C     Implicit statement to force declarations
155C
156      IMPLICIT NONE
157C
158#include "parim.h"
159C
160C     Dummy arguments
161      LOGICAL ONPOLE, OSPOLE
162      INTEGER KINS, KONS, KPR, KERR
163      INTEGER KILATG (KINS), KOLATG (KONS)
164      INTEGER KNSIND (2, KONS), KNSDIST (2, KONS)
165C
166C     Local variables
167      INTEGER IBASE
168      INTEGER JOUT, JINP
169      INTEGER JPROUTINE
170      PARAMETER (JPROUTINE = 24500)
171C
172C     _______________________________________________________
173C
174C*    Section 1. Initialisation
175C     _______________________________________________________
176C
177  100 CONTINUE
178C
179      IF (KPR.GE.1) CALL INTLOG(JP_DEBUG,'IGDINS: Section 1.',JPQUIET)
180C
181      IGDINS = 0
182C
183      IF (KPR .GE. 1) THEN
184        CALL INTLOG(JP_DEBUG,'IGDINS: Input parameters.',JPQUIET)
185        CALL INTLOG(JP_DEBUG,'IGDINS: No.input fld lines = ',KINS)
186        CALL INTLOG(JP_DEBUG,'IGDINS: No.output fld lines = ',KONS)
187        CALL INTLOG(JP_DEBUG,'IGDINS: Input fld spread from ',KILATG(1))
188        CALL INTLOG(JP_DEBUG,'IGDINS: to ', KILATG(KINS))
189        CALL INTLOG(JP_DEBUG,'IGDINS: Outpt fld spread from ',KOLATG(1))
190        CALL INTLOG(JP_DEBUG,'IGDINS: to ', KOLATG(KONS))
191C
192        IF ( ONPOLE ) THEN
193          CALL INTLOG(JP_DEBUG,'IGDINS: N. pole in inpt field.',JPQUIET)
194        ELSE
195          CALL INTLOG(JP_DEBUG,'IGDINS: N.pole NOT in inpt fld',JPQUIET)
196        ENDIF
197C
198        IF ( OSPOLE ) THEN
199          CALL INTLOG(JP_DEBUG,'IGDINS: S. pole in inpt field.',JPQUIET)
200        ELSE
201          CALL INTLOG(JP_DEBUG,'IGDINS: S.pole NOT in inpt fld',JPQUIET)
202        ENDIF
203      ENDIF
204C
205C     _______________________________________________________
206C
207C*    Section 2. Select points along a line of meridian
208C     _______________________________________________________
209C
210  200 CONTINUE
211C
212      IF (KPR.GE.1) CALL INTLOG(JP_DEBUG,'IGDINS: Section 2.',JPQUIET)
213C
214C     Last latitude found to be used as start of search
215C     for next latitude
216C
217      IBASE = 1
218C
219      DO 220 JOUT = 1, KONS
220C
221C       Allow special code for points beyond North limit of
222C       Gaussian grid which has all points up to pole
223C
224C       Sinisa remove check for pole - already exist in iagcntl
225        IF (IBASE .EQ. 1 .AND. KOLATG(JOUT).GT.KILATG (1) ) THEN
226C
227          KNSIND (JP_I_N, JOUT) = 1
228          KNSIND (JP_I_S, JOUT) = 2
229          IBASE = 1
230C
231          KNSDIST (JP_I_N, JOUT) = JP90 - KOLATG (JOUT)
232          KNSDIST (JP_I_S, JOUT) = KOLATG (JOUT) - KILATG (2)
233C
234          GO TO 220
235C
236        ENDIF
237C
238        DO 210 JINP = IBASE, KINS - 1
239C
240C         This test allows the exact match at both ends to be treated
241C         correctly. Although the point is checked for equality at
242C         both ends the first test will be used except for the South
243C         Gaussian limit.
244C
245          IF (KOLATG (JOUT) .LE. KILATG (JINP) .AND.
246     X         KOLATG (JOUT) .GE. KILATG (JINP + 1) ) THEN
247C
248            KNSIND (JP_I_N, JOUT) = JINP
249            KNSIND (JP_I_S, JOUT) = JINP + 1
250            IBASE = JINP
251C
252            KNSDIST (JP_I_N, JOUT) = KILATG (JINP) -
253     X            KOLATG (JOUT)
254            KNSDIST (JP_I_S, JOUT) = KOLATG (JOUT) -
255     X            KILATG (JINP + 1)
256C
257            GO TO 220
258C
259          ENDIF
260C
261  210   CONTINUE
262C
263C       Allow special code for points beyond South limit of
264C       Gaussian grid which has all points up to pole
265C
266C       Sinisa remove check for pole - already exist in iagcntl
267        IF (KOLATG (JOUT) .LT. KILATG (KINS) ) THEN
268C
269          KNSIND (JP_I_N, JOUT) = KINS - 1
270          KNSIND (JP_I_S, JOUT) = KINS
271          IBASE = KINS
272C
273          KNSDIST (JP_I_N, JOUT) = KILATG (KINS - 1) -
274     X         KOLATG (JOUT)
275          KNSDIST (JP_I_S, JOUT) = KOLATG (JOUT) - JP90
276C
277        ELSE
278C
279          IGDINS = JPROUTINE + 1
280          IF (KERR .GE. 0) THEN
281            CALL INTLOGR(JP_ERROR,
282     X        'IGDINS: Output lat. value ',REAL(KOLATG(JOUT))/PPMULT)
283            CALL INTLOGR(JP_ERROR,
284     X        'IGDINS: outside input range = ',REAL(KILATG(1))/PPMULT)
285            CALL INTLOGR(JP_ERROR,
286     X        'IGDINS: to ',REAL(KILATG(KINS))/PPMULT)
287          ENDIF
288C
289          IF (KERR .EQ. 0) CALL INTLOGR(JP_FATAL,
290     X      'IGDINS: Interpolation failing.',IGDINS)
291C
292          GO TO 900
293C
294        ENDIF
295C
296  220 CONTINUE
297C
298C
299C     _______________________________________________________
300C
301C*    Section 9. Return to calling routine. Format statements
302C     _______________________________________________________
303C
304  900 CONTINUE
305C
306      IF (KPR.GE.1) CALL INTLOG(JP_DEBUG,'IGDINS: Section 9.',JPQUIET)
307C
308      RETURN
309      END
310