1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
|
C Copyright 1981-2007 ECMWF
C
C Licensed under the GNU Lesser General Public License which
C incorporates the terms and conditions of version 3 of the GNU
C General Public License.
C See LICENSE and gpl-3.0.txt for details.
C
SUBROUTINE JSPPOLE(PSHUP,KNUMB,KTRUNC,OMARS,PXF)
IMPLICIT NONE
C
C---->
C**** *JSPPOLE* - Calculates fourier coefficient for U or V at pole
C
C Purpose
C -------
C
C Calculates fourier coefficient for first harmonic only
C for U and V wind component at the pole.
C
C Interface
C ---------
C
C CALL JSPPOLE(PSHUP,KNUMB,KTRUNC,OMARS,PXF)
C
C Input parameters
C ----------------
C
C PSHUP - Unpacked harmonics field, unpacked
C KNUMB - 1 for North Pole, otherwise South Pole
C KTRUNC - Number (value) of the trucation
C OMARS - .TRUE. if data is from MARS
C PXF - Fourier coefficients (zero on input)
C
C
C Output parameters
C -----------------
C
C PXF(2) - Single fourier coefficient calculated
C
C
C Common block usage
C -----------------
C
C None.
C
C
C Externals
C ---------
C
C None.
C
C
C Author
C ------
C
C J.D.Chambers *ECMWF* Oct 1993
C
C
C Modifications
C -------------
C
C None.
C
C
C Comments
C --------
C
C Created from SPPOLE.
C Changed to provide all parameters in the call, i.e. no common
C blocks are used.
C
C
C Method
C ------
C
C None.
C
C
C Reference
C _________
C
C None.
C
C----<
C _______________________________________________________
C
C* Section 0. Definition of variables.
C _______________________________________________________
C
C* Prefix conventions for variable names
C
C Logical L (but not LP), global or common.
C O, dummy argument
C G, local variable
C LP, parameter.
C Character C, global or common.
C H, dummy argument
C Y (but not YP), local variable
C YP, parameter.
C Integer M and N, global or common.
C K, dummy argument
C I, local variable
C J (but not JP), loop control
C JP, parameter.
C REAL A to F and Q to X, global or common.
C P (but not PP), dummy argument
C Z, local variable
C PP, parameter.
C
C Dummy arguments
C
COMPLEX PSHUP
INTEGER KNUMB
INTEGER KTRUNC
LOGICAL OMARS
COMPLEX PXF
DIMENSION PSHUP(*)
DIMENSION PXF(*)
C
C Local variables
C
INTEGER I1, ITIN1, ITOUT1, JN
REAL Z1, Z2, ZNORM, ZP1, ZP2, ZPOL
C
C -----------------------------------------------------------
C
C* 1. Set initial values
C ------------------
C
100 CONTINUE
C
ITIN1 = KTRUNC + 1
ITOUT1 = KTRUNC
C
ZPOL = 1.
IF (KNUMB .NE. 1) ZPOL = -1.0
C
ZP1 = -1.0
ZP2 = -3.0 * ZPOL
I1 = ITIN1 + 1
C
C* 2. Change normalisation (if flagged as necessary)
C --------------------
C
200 CONTINUE
C
IF (OMARS) THEN
ZNORM = -SQRT(2.0)
ELSE
ZNORM = 1
ENDIF
C
C
C* 3. Calculation
C -----------
C
300 CONTINUE
PXF(2) = (0.0,0.0)
C
C Calculate the fourier coefficient for the first harmonic only.
DO 310 JN = 1,ITOUT1,2
C
Z1 = SQRT( (2.0*JN + 1.0)/(2.0*JN*(JN + 1.0)) )
Z2 = SQRT( (2.0*(JN + 1.0) +1.0)/(2.0*(JN +1.0)*(JN +2.0)) )
C
IF (JN .EQ. ITOUT1) Z2 = 0.0
C
PXF(2) = PXF(2) +(Z1*ZP1*PSHUP(I1) +Z2*ZP2*PSHUP(I1+1))*ZNORM
ZP1 = ZP1 - 2.0*(JN + 1.0) - 1.0
ZP2 = ZP2 - (2.0*(JN + 2.0) + 1.0)*ZPOL
I1 = I1 + 2
C
310 CONTINUE
C
C -------------------------------------------------------------
C
RETURN
C
END
|
