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 IGPOLEG(PIFELD, KIWE, POFELD, KOWE, KPR, KERR)
12C
13C---->
14C**** *IGPOLEG*
15C
16C     Purpose
17C     -------
18C
19C     Calculate the values at the pole of a regular
20C     latitude/longitude field when the input is a Gaussian field.
21C
22C     This routine is used for any field except a wind field.
23C
24C     Interface
25C     ---------
26C
27C     IERR = IGPOLEG(PIFELD, KIWE, POFELD, KOWE, KPR, KERR)
28C
29C     Input parameters
30C     ----------------
31C
32C     PIFELD     - A "polar" row of the input field provided by the
33C                  calling routine.
34C
35C     KIWE       - The number of points in the West-East direction in
36C                  the input field.
37C
38C     KOWE       - The number of points in the West-East direction in
39C                  the output field.
40C
41C     KPR        - The debug print switch.
42C                  0  , No debugging output.
43C                  1  , Produce debugging output.
44C
45C     KERR       - The error control flag.
46C                  -ve, No error message. Return error code.
47C                  0  , Hard failure with error message.
48C                  +ve, Print error message. Return error code.
49C
50C     Output parameters
51C     -----------------
52C
53C     POFELD     - The corresponding "polar" row of the output field
54C                  returned to the calling routine.
55C
56C     Return value
57C     ------------
58C
59C     The error indicator (INTEGER).
60C
61C
62C     Common block usage
63C     ------------------
64C
65C     None
66C
67C     Externals
68C     ---------
69C
70C     INTLOG(R)    - Logs messages.
71C
72C     Method
73C     ------
74C
75C     A Gaussian field does not have a line of latitude at the pole
76C     so this routine forces all the values on the polar line of
77C     latitude to the average of the values at the nearest Gaussian
78C     line in the input field.
79C
80C     This method was originally implemented by
81C
82C     K. RIDER            * ECMWF *     OCTOBER 1991.
83C
84C     Reference
85C     ---------
86C
87C     None
88C
89C     Comments
90C     --------
91C
92C     Program contains sections 0 to 2 and 9
93C
94C     Author
95C     ------
96C
97C     K. Fielding      *ECMWF*      Oct 1993
98C
99C     Modifications
100C     -------------
101C
102C     Allow for missing data values
103C     J.D.Chambers      ECMWF       August 2000
104C
105C----<
106C     -----------------------------------------------------------------|
107C
108      IMPLICIT NONE
109C
110#include "parim.h"
111#include "nifld.common"
112C
113C     Function arguments
114C
115      INTEGER KIWE, KOWE, KPR, KERR
116      REAL PIFELD(KIWE), POFELD(KOWE)
117C
118C     Local variables
119C
120      INTEGER JILON, JOLON, COUNT
121      REAL ZSUM
122C
123C     Statement function
124C
125      REAL A, B
126      LOGICAL NOTEQ
127      NOTEQ(A,B) = (ABS((A)-(B)).GT.(ABS(A)*1E-3))
128C
129C     -----------------------------------------------------------------|
130C*    Section 1. Initialisation
131C     -----------------------------------------------------------------|
132C
133  100 CONTINUE
134C
135      IF( KPR.GE.1 ) CALL INTLOG(JP_DEBUG,'IGPOLEG: Section 1.',JPQUIET)
136C
137      IGPOLEG = 0
138C
139      IF( KPR.GE.1 ) THEN
140        CALL INTLOG(JP_DEBUG,'IGPOLEG: No. of input fld longs. = ',KIWE)
141        CALL INTLOG(JP_DEBUG,'IGPOLEG: No.of output fld longs. = ',KOWE)
142      ENDIF
143C
144C     -----------------------------------------------------------------|
145C*    Section 2. Use average value for non-winds
146C     -----------------------------------------------------------------|
147C
148  200 CONTINUE
149C
150      IF( KPR.GE.1 ) CALL INTLOG(JP_DEBUG,'IGPOLEG: Section 2.',JPQUIET)
151C
152      ZSUM = PPZERO
153      COUNT = 0
154C
155      IF( LIMISSV ) THEN
156        DO JILON = 1, KIWE
157          IF( NOTEQ(PIFELD(JILON),RMISSGV) ) THEN
158            ZSUM = ZSUM + PIFELD(JILON)
159            COUNT = COUNT + 1
160          ENDIF
161        ENDDO
162      ELSE
163        DO JILON = 1, KIWE
164          ZSUM = ZSUM + PIFELD(JILON)
165          COUNT = COUNT + 1
166        ENDDO
167      ENDIF
168C
169      IF( COUNT.GT.0 ) THEN
170        ZSUM = ZSUM / REAL(COUNT)
171      ELSE
172        ZSUM = RMISSGV
173      ENDIF
174C
175      DO JOLON = 1, KOWE
176         POFELD(JOLON) = ZSUM
177      ENDDO
178C
179C     -----------------------------------------------------------------|
180C*    Section 9. Return to calling routine. Format statements
181C     -----------------------------------------------------------------|
182C
183  900 CONTINUE
184C
185      IF( KPR.GE.1 ) CALL INTLOG(JP_DEBUG,'IGPOLEG: Section 9.',JPQUIET)
186C
187C
188      RETURN
189      END
190