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 JUVPOLE(PSHUP, KTRUNC, PZFA, KLONO, KRET)
12C
13C---->
14C**** JUVPOLE
15C
16C     Purpose
17C     -------
18C     This routine creates polar wind U or V components for lat/long
19C     grid fields.
20C
21C
22C     Interface
23C     ---------
24C     CALL JUVPOLE(PSHUP, KTRUNC, PZFA, KLONO, KRET)
25C
26C
27C     Input parameters
28C     ----------------
29C     PSHUP   - Spherical harmonics field, unpacked
30C     KTRUNC  - Truncation number of spherical harmonics field
31C     KLONO   - Number of longitude points in output field
32C
33C
34C     Output parameters
35C     -----------------
36C     PZFA - Output grid point field; contains upto 32 each of
37C            North and South latitude rows symmetrically.
38C     KRET - Return status code
39C            0 = OK
40C
41C
42C     Common block usage
43C     ------------------
44C     JDCNDBG
45C
46C
47C     Method
48C     ------
49C     For each pole, creates the reduced gaussian grid lines nearest to
50C     the pole and does a linear interpolation to the polar longitude.
51C
52C
53C     Externals
54C     ---------
55C     JAGGGP  - converts spectral input to a gaussian grid
56C     INTLOG  - Output log message
57C
58C
59C     Reference
60C     ---------
61C     None.
62C
63C     Comments
64C     --------
65C     None.
66C
67C
68C     Author
69C     ------
70C     J.D.Chambers      ECMWF    October 2002
71C
72C
73C     Modifications
74C     -------------
75C     None.
76C
77C
78C----<
79C     -----------------------------------------------------------------|
80C
81      IMPLICIT NONE
82C
83#include "jparams.h"
84#include "parim.h"
85#include "current.h"
86#include "nofld.common"
87#include "grfixed.h"
88C
89C     Subroutine arguments
90C
91      COMPLEX PSHUP(*)
92      REAL PZFA(JPLONO + 2, 64)
93      INTEGER KTRUNC, KLONO, KRET
94C
95C     Parameters
96C
97C     Local variables
98C
99      REAL EAST, WEST, LAT, POUTF(18), ALATS(320)
100      REAL XLONG, WLEFT, XSTEP, GSTEP
101      INTEGER KPTS(320), NUM, LOOP, NLEFT, NRIGHT, LUV
102      CHARACTER*1 HTYPE
103C
104C     Externals
105C
106      INTEGER  IGGLAT
107      EXTERNAL IGGLAT
108C
109C     -----------------------------------------------------------------|
110C*    Section 1.  Initialization.
111C     -----------------------------------------------------------------|
112C
113  100 CONTINUE
114C
115      KRET  = 0
116C
117      NUM = 160
118      GSTEP = 360.0 / 18.0
119      XSTEP = 360.0 / REAL(KLONO)
120      EAST  = 360.0 - GSTEP
121      WEST  = 0.0
122C
123C     -----------------------------------------------------------------|
124C*    Section 2.  Create North pole values
125C     -----------------------------------------------------------------|
126C
127  200 CONTINUE
128C
129C     Form the N160 reduced gaussian grid latitude near the North pole
130C
131      LAT = 90.0
132      HTYPE = 'R'
133      LUV = 1
134      CALL JAGGGP(PSHUP, KTRUNC, LAT, LAT, WEST, EAST,
135     X            NUM, HTYPE, KPTS, POUTF, LUV, KRET)
136      IF( KRET.NE.0 ) THEN
137        CALL INTLOG(JP_ERROR,
138     X    'JUVPOLE: problem forming Northern gaussian grid latitude',
139     X    JPQUIET)
140        GOTO 900
141      ENDIF
142C
143C     Interpolate to the lat/long northern latitude grid points
144C
145      DO LOOP = 1, KLONO
146C
147C       Find the gaussian neighbours on either side of lat/long point
148C       and their weights
149C
150        XLONG = XSTEP * REAL(LOOP-1)
151C
152        NLEFT  = 1 + INT(XLONG/GSTEP)
153        NRIGHT = NLEFT + 1
154        IF( NRIGHT.GT.18 ) NRIGHT = 1
155C
156        WLEFT = 1.0 - (ABS((XLONG - (NLEFT-1)*GSTEP))/GSTEP)
157C
158        PZFA(LOOP,1) = POUTF(NLEFT)*WLEFT + POUTF(NRIGHT)*(1.0-WLEFT)
159      ENDDO
160C
161C     -----------------------------------------------------------------|
162C*    Section 3.  Create South pole values
163C     -----------------------------------------------------------------|
164C
165  300 CONTINUE
166C
167C     Store latitude and point count values for the next call to JAGGGP
168C     which uses the 'U' option (user supplied values).
169C
170      NOGAUSO = NUM
171C
172      KRET  = IGGLAT(NUM*2, ALATS, 1, 1)
173      IF( KRET.NE.0 ) THEN
174        CALL INTLOG(JP_ERROR, 'JUVPOLE: IGGLAT call failed',KRET)
175        KRET = KRET
176        GOTO 900
177      ENDIF
178C
179      DO LOOP = 1, NUM*2
180        NOLPTS(LOOP)  = KPTS(LOOP)
181        ROGAUSS(LOOP) = ALATS(LOOP)
182      ENDDO
183C
184C     Form the N160 reduced gaussian grid latitude near the South pole
185C
186      LAT = -90.0
187      HTYPE = 'U'
188      LUV = 1
189      CALL JAGGGP(PSHUP, KTRUNC, LAT, LAT, WEST, EAST,
190     X            NUM, HTYPE, KPTS, POUTF, LUV, KRET)
191      IF( KRET.NE.0 ) THEN
192        CALL INTLOG(JP_ERROR,
193     X    'JUVPOLE: problem forming Southern gaussian grid latitude',
194     X    JPQUIET)
195        GOTO 900
196      ENDIF
197C
198C     Interpolate to the lat/long southern latitude grid points
199C
200      DO LOOP = 1, KLONO
201C
202C       Find the gaussian neighbours on either side of lat/long point
203C       and their weights
204C
205        XLONG = XSTEP * REAL(LOOP-1)
206C
207        NLEFT  = 1 + INT(XLONG/GSTEP)
208        NRIGHT = NLEFT + 1
209        IF( NRIGHT.GT.18 ) NRIGHT = 1
210C
211        WLEFT = 1.0 - (ABS((XLONG - (NLEFT-1)*GSTEP))/GSTEP)
212C
213        PZFA(LOOP,2) = POUTF(NLEFT)*WLEFT + POUTF(NRIGHT)*(1.0-WLEFT)
214      ENDDO
215C
216C     -----------------------------------------------------------------|
217C*    Section 9.  Return.
218C     -----------------------------------------------------------------|
219C
220 900  CONTINUE
221C
222      RETURN
223      END
224