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 IGPOLEW(PIFELD, KIWE, POFELD, KOWE, KWEIND,
12     1   KWEDIST, KPR, KERR)
13C
14C---->
15C**** *IGPOLEW*
16C
17C     Purpose
18C     -------
19C
20C     Calculates the values at the pole of a regular
21C     latitude/longitude wind field when the input is a Gaussian field.
22C
23C     This routine is only used for a wind field.
24C
25C     Interface
26C     ---------
27C
28C     IERR = IGPOLEW(PIFELD, KIWE, POFELD, KOWE, KWEIND, KWEDIST,
29C    1   KPR, KERR)
30C
31C     Input parameters
32C     ----------------
33C
34C     PIFELD     - A "polar" row of the input field provided by the
35C                  calling routine.
36C
37C     KIWE       - The number of points in the West-East direction in
38C                  the input field.
39C
40C     KOWE       - The number of points in the West-East direction in
41C                  the output field.
42C
43C     KWEIND     - This array contains the array offsets of the West
44C                  and East points in the input array required for
45C                  interpolation.
46C
47C     KWEDIST    - This array holds the distances to longitude values
48C                  in the input field from the associated longitude
49C                  values in the output field.
50C
51C     KPR        - The debug print switch.
52C                  0  , No debugging output.
53C                  1  , Produce debugging output.
54C
55C     KERR       - The error control flag.
56C                  -ve, No error message. Return error code.
57C                  0  , Hard failure with error message.
58C                  +ve, Print error message. Return error code.
59C
60C     Output parameters
61C     -----------------
62C
63C     POFELD     - The corresponding "polar" row of the output field
64C                  returned to the calling routine.
65C
66C     Return value
67C     ------------
68C
69C     The error indicator (INTEGER).
70C
71C     Error and Warning Return Values
72C
73C     None
74C
75C     Common block usage
76C     ------------------
77C
78C     None
79C
80C     Externals
81C     ---------
82C
83C     INTLOG(R)    - Logs messages.
84C
85C     Method
86C     ------
87C
88C     A Gaussian field does not have a line of latitude at the pole
89C     so this routine performs a linear interpolation of points on the
90C     nearest Gaussian line and then puts these values into the output
91C     array. The intention is to provide U and V values at the pole
92C     which have a "directional" value.
93C
94C     This method was originally implemented by
95C
96C     K. RIDER            * ECMWF *     OCTOBER 1991.
97C
98C     Reference
99C     ---------
100C
101C     None
102C
103C     Comments
104C     --------
105C
106C     Program contains sections 0 to 2 and 9
107C
108C     Author
109C     ------
110C
111C     K. Fielding      *ECMWF*      Oct 1993
112C
113C     Modifications
114C     -------------
115C
116C     Allow for missing data values
117C     J.D.Chambers      ECMWF       August 2000
118C
119C----<
120C     -----------------------------------------------------------------|
121C*    Section 0. Definition of variables.
122C     -----------------------------------------------------------------|
123C
124      IMPLICIT NONE
125C
126#include "parim.h"
127#include "nifld.common"
128C
129C     Function arguments
130C
131      INTEGER KIWE, KOWE, KPR, KERR
132      INTEGER KWEIND(2, KOWE), KWEDIST(2, KOWE)
133      REAL PIFELD(KIWE), POFELD(KOWE)
134C
135C     Local variables
136C
137      INTEGER JOLON, COUNT
138      REAL ZLOW, ZHIGH
139C
140C     Statement function
141C
142      REAL A, B
143      LOGICAL NOTEQ
144      NOTEQ(A,B) = (ABS((A)-(B)).GT.(ABS(A)*1E-3))
145C
146C     -----------------------------------------------------------------|
147C*    Section 1. Initialisation
148C     -----------------------------------------------------------------|
149C
150  100 CONTINUE
151C
152      IF( KPR.GE.1 ) CALL INTLOG(JP_DEBUG,'IGPOLEW: Section 1.',JPQUIET)
153C
154      IGPOLEW = 0
155C
156      IF( KPR.GE.1 ) THEN
157        CALL INTLOG(JP_DEBUG,'IGPOLEW: No.input fld longs = ',KIWE)
158        CALL INTLOG(JP_DEBUG,'IGPOLEW: No.output fld longs = ',KOWE)
159      ENDIF
160C
161C     -----------------------------------------------------------------|
162C*    Section 2. Interpolation code for winds
163C     -----------------------------------------------------------------|
164C
165  200 CONTINUE
166C
167      IF( KPR.GE.1 ) CALL INTLOG(JP_DEBUG,'IGPOLEW: Section 2.',JPQUIET)
168C
169      DO JOLON = 1, KOWE
170C
171C       Compute weigths for west and east neighbours
172C
173        ZLOW = REAL(KWEDIST(JP_I_E,JOLON)) /
174     X      REAL(KWEDIST(JP_I_E,JOLON) + KWEDIST(JP_I_W,JOLON) )
175C
176        ZHIGH = PPONE - ZLOW
177C
178C       Count non-missing data values
179C
180        IF( LIMISSV ) THEN
181          COUNT = 0
182          IF( NOTEQ(PIFELD(KWEIND(JP_I_W,JOLON)),RMISSGV) )
183     X      COUNT = COUNT + 1
184          IF( NOTEQ(PIFELD(KWEIND(JP_I_E,JOLON)),RMISSGV) )
185     X      COUNT = COUNT + 1
186        ELSE
187          COUNT = 2
188        ENDIF
189C
190C       Interpolate using both neighbours if neither is missing
191C
192        IF( COUNT.EQ.2 ) THEN
193          POFELD(JOLON) = ZLOW  * PIFELD(KWEIND(JP_I_W,JOLON)) +
194     X                    ZHIGH * PIFELD(KWEIND(JP_I_E,JOLON))
195C
196C       Set missing if all neighbours are missing
197C
198        ELSE IF( COUNT.EQ.0 ) THEN
199          POFELD(JOLON) = RMISSGV
200C
201C       Otherwise, use the nearest neighbour
202C
203        ELSE IF( ZLOW.GT.ZHIGH ) THEN
204          POFELD(JOLON) = PIFELD(KWEIND(JP_I_W,JOLON))
205        ELSE
206          POFELD(JOLON) = PIFELD(KWEIND(JP_I_E,JOLON))
207        ENDIF
208C
209      ENDDO
210C
211C     -----------------------------------------------------------------|
212C*    Section 9. Return to calling routine. Format statements
213C     -----------------------------------------------------------------|
214C
215  900 CONTINUE
216C
217      IF( KPR.GE.1 ) CALL INTLOG(JP_DEBUG,'IGPOLEW: Section 9.',JPQUIET)
218C
219      RETURN
220      END
221