NCEPLIBS-sp  2.5.0
sptgpsv.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Transform spectral vector to polar stereo.
3 C>
4 C> ### Program History Log
5 C> Date | Programmer | Comments
6 C> -----|------------|---------
7 C> 96-02-29 | Iredell | Initial.
8 C> 1998-12-15 | Iredell | Openmp directives inserted.
9 C>
10 C> @author Iredell @date 96-02-29
11 
12 C> This subprogram performs a spherical transform
13 C> from spectral coefficients of divergences and curls
14 C> to vector fields on a pair of polar stereographic grids.
15 C> The wave-space can be either triangular or rhomboidal.
16 C>
17 C> The wave and grid fields may have general indexing,
18 C> but each wave field is in sequential 'IBM order',
19 C> i.e. with zonal wavenumber as the slower index.
20 C>
21 C> The two square polar stereographic grids are centered
22 C> on the respective poles, with the orientation longitude
23 C> of the southern hemisphere grid 180 degrees opposite
24 C> that of the northern hemisphere grid.
25 C>
26 C> The vectors are automatically rotated to be resolved
27 C> relative to the respective polar stereographic grids.
28 C>
29 C> The transform is made efficient
30 C> by combining points in eight sectors
31 C> of each polar stereographic grid,
32 C> numbered as in the diagram below.
33 C> The pole and the sector boundaries
34 C> are treated specially in the code.
35 C> Unfortunately, this approach induces
36 C> some hairy indexing and code loquacity,
37 C> for which the developer apologizes.
38 C>
39 C> <pre>
40 C> \ 4 | 5 /
41 C> \ | /
42 C> 3 \ | / 6
43 C> \|/
44 C> ----+----
45 C> /|\
46 C> 2 / | \ 7
47 C> / | \
48 C> / 1 | 8 \
49 C> </pre>
50 C>
51 C> The transforms are all multiprocessed over sector points.
52 C> transform several fields at a time to improve vectorization.
53 C> subprogram can be called from a multiprocessing environment.
54 C>
55 C> @param IROMB spectral domain shape
56 C> (0 for triangular, 1 for rhomboidal)
57 C> @param MAXWV spectral truncation
58 C> @param KMAX number of fields to transform.
59 C> @param NPS odd order of the polar stereographic grids
60 C> @param KWSKIP skip number between wave fields
61 C> (defaults to (MAXWV+1)*((IROMB+1)*MAXWV+2) if KWSKIP=0)
62 C> @param KGSKIP skip number between grid fields
63 C> (defaults to NPS*NPS if KGSKIP=0)
64 C> @param NISKIP skip number between grid i-points
65 C> (defaults to 1 if NISKIP=0)
66 C> @param NJSKIP skip number between grid j-points
67 C> (defaults to NPS if NJSKIP=0)
68 C> @param TRUE latitude at which ps grid is true (usually 60.)
69 C> @param XMESH grid length at true latitude (m)
70 C> @param ORIENT longitude at bottom of northern ps grid
71 C> (southern ps grid will have opposite orientation.)
72 C> @param WAVED wave divergence fields
73 C> @param WAVEZ wave vorticity fields
74 C> @param UN northern polar stereographic u-winds
75 C> @param VN northern polar stereographic v-winds
76 C> @param US southern polar stereographic u-winds
77 C> @param VS southern polar stereographic v-winds
78 C>
79 C> @author Iredell @date 96-02-29
80  SUBROUTINE sptgpsv(IROMB,MAXWV,KMAX,NPS,
81  & KWSKIP,KGSKIP,NISKIP,NJSKIP,
82  & TRUE,XMESH,ORIENT,WAVED,WAVEZ,UN,VN,US,VS)
83 
84  REAL WAVED(*),WAVEZ(*),UN(*),VN(*),US(*),VS(*)
85  REAL EPS((MAXWV+1)*((IROMB+1)*MAXWV+2)/2),EPSTOP(MAXWV+1)
86  REAL ENN1((MAXWV+1)*((IROMB+1)*MAXWV+2)/2)
87  REAL ELONN1((MAXWV+1)*((IROMB+1)*MAXWV+2)/2)
88  REAL EON((MAXWV+1)*((IROMB+1)*MAXWV+2)/2),EONTOP(MAXWV+1)
89  INTEGER MP(2*KMAX)
90  REAL SLON(MAXWV,8),CLON(MAXWV,8),SROT(0:3),CROT(0:3)
91  REAL W((MAXWV+1)*((IROMB+1)*MAXWV+2)/2*2+1,2*KMAX)
92  REAL WTOP(2*(MAXWV+1),2*KMAX)
93  REAL PLN((MAXWV+1)*((IROMB+1)*MAXWV+2)/2),PLNTOP(MAXWV+1)
94  REAL F(2*MAXWV+3,2,2*KMAX)
95  DATA srot/0.,1.,0.,-1./,crot/1.,0.,-1.,0./
96  parameter(rerth=6.3712e6)
97  parameter(pi=3.14159265358979,dpr=180./pi)
98 
99 C CALCULATE PRELIMINARY CONSTANTS
100  CALL spwget(iromb,maxwv,eps,epstop,enn1,elonn1,eon,eontop)
101  mx=(maxwv+1)*((iromb+1)*maxwv+2)/2
102  mxtop=maxwv+1
103  mdim=2*mx+1
104  idim=2*maxwv+3
105  kw=kwskip
106  kg=kgskip
107  ni=niskip
108  nj=njskip
109  IF(kw.EQ.0) kw=2*mx
110  IF(kg.EQ.0) kg=nps*nps
111  IF(ni.EQ.0) ni=1
112  IF(nj.EQ.0) nj=nps
113  mp=1
114  nph=(nps-1)/2
115  gq=((1.+sin(true/dpr))*rerth/xmesh)**2
116  srh=sqrt(0.5)
117 
118 C CALCULATE SPECTRAL WINDS
119 C$OMP PARALLEL DO PRIVATE(KWS)
120  DO k=1,kmax
121  kws=(k-1)*kw
122  CALL spdz2uv(iromb,maxwv,enn1,elonn1,eon,eontop,
123  & waved(kws+1),wavez(kws+1),
124  & w(1,k),w(1,kmax+k),wtop(1,k),wtop(1,kmax+k))
125  ENDDO
126 
127 C CALCULATE POLE POINT
128  i1=nph+1
129  j1=nph+1
130  ij1=(i1-1)*ni+(j1-1)*nj+1
131  slat1=1.
132  clat1=0.
133  CALL splegend(iromb,maxwv,slat1,clat1,eps,epstop,
134  & pln,plntop)
135  CALL spsynth(iromb,maxwv,2*maxwv,idim,mdim,2*mxtop,2*kmax,
136  & clat1,pln,plntop,mp,w,wtop,f)
137  coso=cos(orient/dpr)
138  sino=sin(orient/dpr)
139 CDIR$ IVDEP
140  DO k=1,kmax
141  ku=k
142  kv=k+kmax
143  ijk1=ij1+(k-1)*kg
144  un(ijk1)=2*( coso*f(3,1,ku)+sino*f(3,1,kv))
145  vn(ijk1)=2*(-sino*f(3,1,ku)+coso*f(3,1,kv))
146  us(ijk1)=2*( coso*f(3,2,ku)-sino*f(3,2,kv))
147  vs(ijk1)=2*( sino*f(3,2,ku)+coso*f(3,2,kv))
148  ENDDO
149 
150 C CALCULATE POINTS ALONG THE ROW AND COLUMN OF THE POLE,
151 C STARTING AT THE ORIENTATION LONGITUDE AND GOING CLOCKWISE.
152 C$OMP PARALLEL DO PRIVATE(I1,J2,I2,J3,I3,J4,I4,J5,I5,J6,I6,J7,I7,J8,I8)
153 C$OMP& PRIVATE(IJ1,IJ2,IJ3,IJ4,IJ5,IJ6,IJ7,IJ8)
154 C$OMP& PRIVATE(IJK1,IJK2,IJK3,IJK4,IJK5,IJK6,IJK7,IJK8)
155 C$OMP& PRIVATE(DJ1,DI1,RQ,RR,RADLON,RADLON1,RADLON2,SLAT1,CLAT1)
156 C$OMP& PRIVATE(PLN,PLNTOP,F,SLON,CLON,KU,KV,LR,LI)
157  DO j1=1,nph
158  i1=nph+1
159  radlon=orient/dpr
160  j3=nps+1-i1
161  i3=j1
162  j5=nps+1-j1
163  i5=nps+1-i1
164  j7=i1
165  i7=nps+1-j1
166  ij1=(i1-1)*ni+(j1-1)*nj+1
167  ij3=(i3-1)*ni+(j3-1)*nj+1
168  ij5=(i5-1)*ni+(j5-1)*nj+1
169  ij7=(i7-1)*ni+(j7-1)*nj+1
170  di1=i1-nph-1
171  dj1=j1-nph-1
172  rq=di1**2+dj1**2
173  slat1=(gq-rq)/(gq+rq)
174  clat1=sqrt(1.-slat1**2)
175  CALL splegend(iromb,maxwv,slat1,clat1,eps,epstop,
176  & pln,plntop)
177  CALL spsynth(iromb,maxwv,2*maxwv,idim,mdim,2*mxtop,2*kmax,
178  & clat1,pln,plntop,mp,w,wtop,f)
179  DO l=1,maxwv
180  slon(l,1)=sin(l*radlon)
181  clon(l,1)=cos(l*radlon)
182  slon(l,3)=slon(l,1)*crot(mod(1*l,4))
183  & -clon(l,1)*srot(mod(1*l,4))
184  clon(l,3)=clon(l,1)*crot(mod(1*l,4))
185  & +slon(l,1)*srot(mod(1*l,4))
186  slon(l,5)=slon(l,1)*crot(mod(2*l,4))
187  & -clon(l,1)*srot(mod(2*l,4))
188  clon(l,5)=clon(l,1)*crot(mod(2*l,4))
189  & +slon(l,1)*srot(mod(2*l,4))
190  slon(l,7)=slon(l,1)*crot(mod(3*l,4))
191  & -clon(l,1)*srot(mod(3*l,4))
192  clon(l,7)=clon(l,1)*crot(mod(3*l,4))
193  & +slon(l,1)*srot(mod(3*l,4))
194  ENDDO
195 CDIR$ IVDEP
196  DO k=1,kmax
197  ku=k
198  kv=k+kmax
199  ijk1=ij1+(k-1)*kg
200  ijk3=ij3+(k-1)*kg
201  ijk5=ij5+(k-1)*kg
202  ijk7=ij7+(k-1)*kg
203  un(ijk1)= f(1,1,ku)
204  vn(ijk1)= f(1,1,kv)
205  un(ijk3)= f(1,1,kv)
206  vn(ijk3)=-f(1,1,ku)
207  un(ijk5)=-f(1,1,ku)
208  vn(ijk5)=-f(1,1,kv)
209  un(ijk7)=-f(1,1,kv)
210  vn(ijk7)= f(1,1,ku)
211  us(ijk1)=-f(1,2,ku)
212  vs(ijk1)=-f(1,2,kv)
213  us(ijk3)=-f(1,2,kv)
214  vs(ijk3)= f(1,2,ku)
215  us(ijk5)= f(1,2,ku)
216  vs(ijk5)= f(1,2,kv)
217  us(ijk7)= f(1,2,kv)
218  vs(ijk7)=-f(1,2,ku)
219  ENDDO
220  IF(kmax.EQ.1) THEN
221  ku=1
222  kv=2
223  DO l=1,maxwv
224  lr=2*l+1
225  li=2*l+2
226  un(ij1)=un(ij1)+2*(f(lr,1,ku)*clon(l,1)
227  & -f(li,1,ku)*slon(l,1))
228  vn(ij1)=vn(ij1)+2*(f(lr,1,kv)*clon(l,1)
229  & -f(li,1,kv)*slon(l,1))
230  un(ij3)=un(ij3)+2*(f(lr,1,kv)*clon(l,3)
231  & -f(li,1,kv)*slon(l,3))
232  vn(ij3)=vn(ij3)-2*(f(lr,1,ku)*clon(l,3)
233  & -f(li,1,ku)*slon(l,3))
234  un(ij5)=un(ij5)-2*(f(lr,1,ku)*clon(l,5)
235  & -f(li,1,ku)*slon(l,5))
236  vn(ij5)=vn(ij5)-2*(f(lr,1,kv)*clon(l,5)
237  & -f(li,1,kv)*slon(l,5))
238  un(ij7)=un(ij7)-2*(f(lr,1,kv)*clon(l,7)
239  & -f(li,1,kv)*slon(l,7))
240  vn(ij7)=vn(ij7)+2*(f(lr,1,ku)*clon(l,7)
241  & -f(li,1,ku)*slon(l,7))
242  us(ij1)=us(ij1)-2*(f(lr,2,ku)*clon(l,5)
243  & -f(li,2,ku)*slon(l,5))
244  vs(ij1)=vs(ij1)-2*(f(lr,2,kv)*clon(l,5)
245  & -f(li,2,kv)*slon(l,5))
246  us(ij3)=us(ij3)-2*(f(lr,2,kv)*clon(l,3)
247  & -f(li,2,kv)*slon(l,3))
248  vs(ij3)=vs(ij3)+2*(f(lr,2,ku)*clon(l,3)
249  & -f(li,2,ku)*slon(l,3))
250  us(ij5)=us(ij5)+2*(f(lr,2,ku)*clon(l,1)
251  & -f(li,2,ku)*slon(l,1))
252  vs(ij5)=vs(ij5)+2*(f(lr,2,kv)*clon(l,1)
253  & -f(li,2,kv)*slon(l,1))
254  us(ij7)=us(ij7)+2*(f(lr,2,kv)*clon(l,7)
255  & -f(li,2,kv)*slon(l,7))
256  vs(ij7)=vs(ij7)-2*(f(lr,2,ku)*clon(l,7)
257  & -f(li,2,ku)*slon(l,7))
258  ENDDO
259  ELSE
260  DO l=1,maxwv
261  lr=2*l+1
262  li=2*l+2
263 CDIR$ IVDEP
264  DO k=1,kmax
265  ku=k
266  kv=k+kmax
267  ijk1=ij1+(k-1)*kg
268  ijk3=ij3+(k-1)*kg
269  ijk5=ij5+(k-1)*kg
270  ijk7=ij7+(k-1)*kg
271  un(ijk1)=un(ijk1)+2*(f(lr,1,ku)*clon(l,1)
272  & -f(li,1,ku)*slon(l,1))
273  vn(ijk1)=vn(ijk1)+2*(f(lr,1,kv)*clon(l,1)
274  & -f(li,1,kv)*slon(l,1))
275  un(ijk3)=un(ijk3)+2*(f(lr,1,kv)*clon(l,3)
276  & -f(li,1,kv)*slon(l,3))
277  vn(ijk3)=vn(ijk3)-2*(f(lr,1,ku)*clon(l,3)
278  & -f(li,1,ku)*slon(l,3))
279  un(ijk5)=un(ijk5)-2*(f(lr,1,ku)*clon(l,5)
280  & -f(li,1,ku)*slon(l,5))
281  vn(ijk5)=vn(ijk5)-2*(f(lr,1,kv)*clon(l,5)
282  & -f(li,1,kv)*slon(l,5))
283  un(ijk7)=un(ijk7)-2*(f(lr,1,kv)*clon(l,7)
284  & -f(li,1,kv)*slon(l,7))
285  vn(ijk7)=vn(ijk7)+2*(f(lr,1,ku)*clon(l,7)
286  & -f(li,1,ku)*slon(l,7))
287  us(ijk1)=us(ijk1)-2*(f(lr,2,ku)*clon(l,5)
288  & -f(li,2,ku)*slon(l,5))
289  vs(ijk1)=vs(ijk1)-2*(f(lr,2,kv)*clon(l,5)
290  & -f(li,2,kv)*slon(l,5))
291  us(ijk3)=us(ijk3)-2*(f(lr,2,kv)*clon(l,3)
292  & -f(li,2,kv)*slon(l,3))
293  vs(ijk3)=vs(ijk3)+2*(f(lr,2,ku)*clon(l,3)
294  & -f(li,2,ku)*slon(l,3))
295  us(ijk5)=us(ijk5)+2*(f(lr,2,ku)*clon(l,1)
296  & -f(li,2,ku)*slon(l,1))
297  vs(ijk5)=vs(ijk5)+2*(f(lr,2,kv)*clon(l,1)
298  & -f(li,2,kv)*slon(l,1))
299  us(ijk7)=us(ijk7)+2*(f(lr,2,kv)*clon(l,7)
300  & -f(li,2,kv)*slon(l,7))
301  vs(ijk7)=vs(ijk7)-2*(f(lr,2,ku)*clon(l,7)
302  & -f(li,2,ku)*slon(l,7))
303  ENDDO
304  ENDDO
305  ENDIF
306  ENDDO
307 
308 C CALCULATE POINTS ON THE MAIN DIAGONALS THROUGH THE POLE,
309 C STARTING CLOCKWISE OF THE ORIENTATION LONGITUDE AND GOING CLOCKWISE.
310 C$OMP PARALLEL DO PRIVATE(I1,J2,I2,J3,I3,J4,I4,J5,I5,J6,I6,J7,I7,J8,I8)
311 C$OMP& PRIVATE(IJ1,IJ2,IJ3,IJ4,IJ5,IJ6,IJ7,IJ8)
312 C$OMP& PRIVATE(IJK1,IJK2,IJK3,IJK4,IJK5,IJK6,IJK7,IJK8)
313 C$OMP& PRIVATE(DJ1,DI1,RQ,RR,RADLON,RADLON1,RADLON2,SLAT1,CLAT1)
314 C$OMP& PRIVATE(PLN,PLNTOP,F,SLON,CLON,KU,KV,LR,LI)
315  DO j1=1,nph
316  i1=j1
317  radlon=(orient-45)/dpr
318  j3=nps+1-i1
319  i3=j1
320  j5=nps+1-j1
321  i5=nps+1-i1
322  j7=i1
323  i7=nps+1-j1
324  ij1=(i1-1)*ni+(j1-1)*nj+1
325  ij3=(i3-1)*ni+(j3-1)*nj+1
326  ij5=(i5-1)*ni+(j5-1)*nj+1
327  ij7=(i7-1)*ni+(j7-1)*nj+1
328  di1=i1-nph-1
329  dj1=j1-nph-1
330  rq=di1**2+dj1**2
331  slat1=(gq-rq)/(gq+rq)
332  clat1=sqrt(1.-slat1**2)
333  CALL splegend(iromb,maxwv,slat1,clat1,eps,epstop,
334  & pln,plntop)
335  CALL spsynth(iromb,maxwv,2*maxwv,idim,mdim,2*mxtop,2*kmax,
336  & clat1,pln,plntop,mp,w,wtop,f)
337  DO l=1,maxwv
338  slon(l,1)=sin(l*radlon)
339  clon(l,1)=cos(l*radlon)
340  slon(l,3)=slon(l,1)*crot(mod(1*l,4))
341  & -clon(l,1)*srot(mod(1*l,4))
342  clon(l,3)=clon(l,1)*crot(mod(1*l,4))
343  & +slon(l,1)*srot(mod(1*l,4))
344  slon(l,5)=slon(l,1)*crot(mod(2*l,4))
345  & -clon(l,1)*srot(mod(2*l,4))
346  clon(l,5)=clon(l,1)*crot(mod(2*l,4))
347  & +slon(l,1)*srot(mod(2*l,4))
348  slon(l,7)=slon(l,1)*crot(mod(3*l,4))
349  & -clon(l,1)*srot(mod(3*l,4))
350  clon(l,7)=clon(l,1)*crot(mod(3*l,4))
351  & +slon(l,1)*srot(mod(3*l,4))
352  ENDDO
353 CDIR$ IVDEP
354  DO k=1,kmax
355  ku=k
356  kv=k+kmax
357  ijk1=ij1+(k-1)*kg
358  ijk3=ij3+(k-1)*kg
359  ijk5=ij5+(k-1)*kg
360  ijk7=ij7+(k-1)*kg
361  un(ijk1)=srh*( f(1,1,ku)+f(1,1,kv))
362  vn(ijk1)=srh*(-f(1,1,ku)+f(1,1,kv))
363  un(ijk3)=srh*(-f(1,1,ku)+f(1,1,kv))
364  vn(ijk3)=srh*(-f(1,1,ku)-f(1,1,kv))
365  un(ijk5)=srh*(-f(1,1,ku)-f(1,1,kv))
366  vn(ijk5)=srh*( f(1,1,ku)-f(1,1,kv))
367  un(ijk7)=srh*( f(1,1,ku)-f(1,1,kv))
368  vn(ijk7)=srh*( f(1,1,ku)+f(1,1,kv))
369  us(ijk1)=srh*(-f(1,2,ku)-f(1,2,kv))
370  vs(ijk1)=srh*( f(1,2,ku)-f(1,2,kv))
371  us(ijk3)=srh*( f(1,2,ku)-f(1,2,kv))
372  vs(ijk3)=srh*( f(1,2,ku)+f(1,2,kv))
373  us(ijk5)=srh*( f(1,2,ku)+f(1,2,kv))
374  vs(ijk5)=srh*(-f(1,2,ku)+f(1,2,kv))
375  us(ijk7)=srh*(-f(1,2,ku)+f(1,2,kv))
376  vs(ijk7)=srh*(-f(1,2,ku)-f(1,2,kv))
377  ENDDO
378  IF(kmax.EQ.1) THEN
379  ku=1
380  kv=2
381  DO l=1,maxwv
382  lr=2*l+1
383  li=2*l+2
384  un(ij1)=un(ij1)+2*srh*(( f(lr,1,ku)+f(lr,1,kv))
385  & *clon(l,1)
386  & -( f(li,1,ku)+f(li,1,kv))
387  & *slon(l,1))
388  vn(ij1)=vn(ij1)+2*srh*((-f(lr,1,ku)+f(lr,1,kv))
389  & *clon(l,1)
390  & -(-f(li,1,ku)+f(li,1,kv))
391  & *slon(l,1))
392  un(ij3)=un(ij3)+2*srh*((-f(lr,1,ku)+f(lr,1,kv))
393  & *clon(l,3)
394  & -(-f(li,1,ku)+f(li,1,kv))
395  & *slon(l,3))
396  vn(ij3)=vn(ij3)+2*srh*((-f(lr,1,ku)-f(lr,1,kv))
397  & *clon(l,3)
398  & -(-f(li,1,ku)-f(li,1,kv))
399  & *slon(l,3))
400  un(ij5)=un(ij5)+2*srh*((-f(lr,1,ku)-f(lr,1,kv))
401  & *clon(l,5)
402  & -(-f(li,1,ku)-f(li,1,kv))
403  & *slon(l,5))
404  vn(ij5)=vn(ij5)+2*srh*(( f(lr,1,ku)-f(lr,1,kv))
405  & *clon(l,5)
406  & -( f(li,1,ku)-f(li,1,kv))
407  & *slon(l,5))
408  un(ij7)=un(ij7)+2*srh*(( f(lr,1,ku)-f(lr,1,kv))
409  & *clon(l,7)
410  & -( f(li,1,ku)-f(li,1,kv))
411  & *slon(l,7))
412  vn(ij7)=vn(ij7)+2*srh*(( f(lr,1,ku)+f(lr,1,kv))
413  & *clon(l,7)
414  & -( f(li,1,ku)+f(li,1,kv))
415  & *slon(l,7))
416  us(ij1)=us(ij1)+2*srh*((-f(lr,2,ku)-f(lr,2,kv))
417  & *clon(l,3)
418  & -(-f(li,2,ku)-f(li,2,kv))
419  & *slon(l,3))
420  vs(ij1)=vs(ij1)+2*srh*(( f(lr,2,ku)-f(lr,2,kv))
421  & *clon(l,3)
422  & -( f(li,2,ku)-f(li,2,kv))
423  & *slon(l,3))
424  us(ij3)=us(ij3)+2*srh*(( f(lr,2,ku)-f(lr,2,kv))
425  & *clon(l,1)
426  & -( f(li,2,ku)-f(li,2,kv))
427  & *slon(l,1))
428  vs(ij3)=vs(ij3)+2*srh*(( f(lr,2,ku)+f(lr,2,kv))
429  & *clon(l,1)
430  & -( f(li,2,ku)+f(li,2,kv))
431  & *slon(l,1))
432  us(ij5)=us(ij5)+2*srh*(( f(lr,2,ku)+f(lr,2,kv))
433  & *clon(l,7)
434  & -( f(li,2,ku)+f(li,2,kv))
435  & *slon(l,7))
436  vs(ij5)=vs(ij5)+2*srh*((-f(lr,2,ku)+f(lr,2,kv))
437  & *clon(l,7)
438  & -(-f(li,2,ku)+f(li,2,kv))
439  & *slon(l,7))
440  us(ij7)=us(ij7)+2*srh*((-f(lr,2,ku)+f(lr,2,kv))
441  & *clon(l,5)
442  & -(-f(li,2,ku)+f(li,2,kv))
443  & *slon(l,5))
444  vs(ij7)=vs(ij7)+2*srh*((-f(lr,2,ku)-f(lr,2,kv))
445  & *clon(l,5)
446  & -(-f(li,2,ku)-f(li,2,kv))
447  & *slon(l,5))
448  ENDDO
449  ELSE
450  DO l=1,maxwv
451  lr=2*l+1
452  li=2*l+2
453 CDIR$ IVDEP
454  DO k=1,kmax
455  ku=k
456  kv=k+kmax
457  ijk1=ij1+(k-1)*kg
458  ijk3=ij3+(k-1)*kg
459  ijk5=ij5+(k-1)*kg
460  ijk7=ij7+(k-1)*kg
461  un(ijk1)=un(ijk1)+2*srh*(( f(lr,1,ku)+f(lr,1,kv))
462  & *clon(l,1)
463  & -( f(li,1,ku)+f(li,1,kv))
464  & *slon(l,1))
465  vn(ijk1)=vn(ijk1)+2*srh*((-f(lr,1,ku)+f(lr,1,kv))
466  & *clon(l,1)
467  & -(-f(li,1,ku)+f(li,1,kv))
468  & *slon(l,1))
469  un(ijk3)=un(ijk3)+2*srh*((-f(lr,1,ku)+f(lr,1,kv))
470  & *clon(l,3)
471  & -(-f(li,1,ku)+f(li,1,kv))
472  & *slon(l,3))
473  vn(ijk3)=vn(ijk3)+2*srh*((-f(lr,1,ku)-f(lr,1,kv))
474  & *clon(l,3)
475  & -(-f(li,1,ku)-f(li,1,kv))
476  & *slon(l,3))
477  un(ijk5)=un(ijk5)+2*srh*((-f(lr,1,ku)-f(lr,1,kv))
478  & *clon(l,5)
479  & -(-f(li,1,ku)-f(li,1,kv))
480  & *slon(l,5))
481  vn(ijk5)=vn(ijk5)+2*srh*(( f(lr,1,ku)-f(lr,1,kv))
482  & *clon(l,5)
483  & -( f(li,1,ku)-f(li,1,kv))
484  & *slon(l,5))
485  un(ijk7)=un(ijk7)+2*srh*(( f(lr,1,ku)-f(lr,1,kv))
486  & *clon(l,7)
487  & -( f(li,1,ku)-f(li,1,kv))
488  & *slon(l,7))
489  vn(ijk7)=vn(ijk7)+2*srh*(( f(lr,1,ku)+f(lr,1,kv))
490  & *clon(l,7)
491  & -( f(li,1,ku)+f(li,1,kv))
492  & *slon(l,7))
493  us(ijk1)=us(ijk1)+2*srh*((-f(lr,2,ku)-f(lr,2,kv))
494  & *clon(l,3)
495  & -(-f(li,2,ku)-f(li,2,kv))
496  & *slon(l,3))
497  vs(ijk1)=vs(ijk1)+2*srh*(( f(lr,2,ku)-f(lr,2,kv))
498  & *clon(l,3)
499  & -( f(li,2,ku)-f(li,2,kv))
500  & *slon(l,3))
501  us(ijk3)=us(ijk3)+2*srh*(( f(lr,2,ku)-f(lr,2,kv))
502  & *clon(l,1)
503  & -( f(li,2,ku)-f(li,2,kv))
504  & *slon(l,1))
505  vs(ijk3)=vs(ijk3)+2*srh*(( f(lr,2,ku)+f(lr,2,kv))
506  & *clon(l,1)
507  & -( f(li,2,ku)+f(li,2,kv))
508  & *slon(l,1))
509  us(ijk5)=us(ijk5)+2*srh*(( f(lr,2,ku)+f(lr,2,kv))
510  & *clon(l,7)
511  & -( f(li,2,ku)+f(li,2,kv))
512  & *slon(l,7))
513  vs(ijk5)=vs(ijk5)+2*srh*((-f(lr,2,ku)+f(lr,2,kv))
514  & *clon(l,7)
515  & -(-f(li,2,ku)+f(li,2,kv))
516  & *slon(l,7))
517  us(ijk7)=us(ijk7)+2*srh*((-f(lr,2,ku)+f(lr,2,kv))
518  & *clon(l,5)
519  & -(-f(li,2,ku)+f(li,2,kv))
520  & *slon(l,5))
521  vs(ijk7)=vs(ijk7)+2*srh*((-f(lr,2,ku)-f(lr,2,kv))
522  & *clon(l,5)
523  & -(-f(li,2,ku)-f(li,2,kv))
524  & *slon(l,5))
525  ENDDO
526  ENDDO
527  ENDIF
528  ENDDO
529 
530 C CALCULATE THE REMAINDER OF THE POLAR STEREOGRAPHIC DOMAIN,
531 C STARTING AT THE SECTOR JUST CLOCKWISE OF THE ORIENTATION LONGITUDE
532 C AND GOING CLOCKWISE UNTIL ALL EIGHT SECTORS ARE DONE.
533 C$OMP PARALLEL DO PRIVATE(I1,J2,I2,J3,I3,J4,I4,J5,I5,J6,I6,J7,I7,J8,I8)
534 C$OMP& PRIVATE(IJ1,IJ2,IJ3,IJ4,IJ5,IJ6,IJ7,IJ8)
535 C$OMP& PRIVATE(IJK1,IJK2,IJK3,IJK4,IJK5,IJK6,IJK7,IJK8)
536 C$OMP& PRIVATE(DJ1,DI1,RQ,RR,RADLON,RADLON1,RADLON2,SLAT1,CLAT1)
537 C$OMP& PRIVATE(PLN,PLNTOP,F,SLON,CLON,KU,KV,LR,LI)
538  DO j1=1,nph-1
539  DO i1=j1+1,nph
540  j2=i1
541  i2=j1
542  j3=nps+1-i1
543  i3=j1
544  j4=nps+1-j1
545  i4=i1
546  j5=nps+1-j1
547  i5=nps+1-i1
548  j6=nps+1-i1
549  i6=nps+1-j1
550  j7=i1
551  i7=nps+1-j1
552  j8=j1
553  i8=nps+1-i1
554  ij1=(i1-1)*ni+(j1-1)*nj+1
555  ij2=(i2-1)*ni+(j2-1)*nj+1
556  ij3=(i3-1)*ni+(j3-1)*nj+1
557  ij4=(i4-1)*ni+(j4-1)*nj+1
558  ij5=(i5-1)*ni+(j5-1)*nj+1
559  ij6=(i6-1)*ni+(j6-1)*nj+1
560  ij7=(i7-1)*ni+(j7-1)*nj+1
561  ij8=(i8-1)*ni+(j8-1)*nj+1
562  di1=i1-nph-1
563  dj1=j1-nph-1
564  rq=di1**2+dj1**2
565  rr=sqrt(1/rq)
566  slat1=(gq-rq)/(gq+rq)
567  clat1=sqrt(1.-slat1**2)
568  radlon1=orient/dpr+atan(-di1/dj1)
569  radlon2=(orient-45)/dpr*2-radlon1
570  CALL splegend(iromb,maxwv,slat1,clat1,eps,epstop,
571  & pln,plntop)
572  CALL spsynth(iromb,maxwv,2*maxwv,idim,mdim,2*mxtop,2*kmax,
573  & clat1,pln,plntop,mp,w,wtop,f)
574  DO l=1,maxwv
575  slon(l,1)=sin(l*radlon1)
576  clon(l,1)=cos(l*radlon1)
577  slon(l,2)=sin(l*radlon2)
578  clon(l,2)=cos(l*radlon2)
579  slon(l,3)=slon(l,1)*crot(mod(1*l,4))
580  & -clon(l,1)*srot(mod(1*l,4))
581  clon(l,3)=clon(l,1)*crot(mod(1*l,4))
582  & +slon(l,1)*srot(mod(1*l,4))
583  slon(l,4)=slon(l,2)*crot(mod(1*l,4))
584  & -clon(l,2)*srot(mod(1*l,4))
585  clon(l,4)=clon(l,2)*crot(mod(1*l,4))
586  & +slon(l,2)*srot(mod(1*l,4))
587  slon(l,5)=slon(l,1)*crot(mod(2*l,4))
588  & -clon(l,1)*srot(mod(2*l,4))
589  clon(l,5)=clon(l,1)*crot(mod(2*l,4))
590  & +slon(l,1)*srot(mod(2*l,4))
591  slon(l,6)=slon(l,2)*crot(mod(2*l,4))
592  & -clon(l,2)*srot(mod(2*l,4))
593  clon(l,6)=clon(l,2)*crot(mod(2*l,4))
594  & +slon(l,2)*srot(mod(2*l,4))
595  slon(l,7)=slon(l,1)*crot(mod(3*l,4))
596  & -clon(l,1)*srot(mod(3*l,4))
597  clon(l,7)=clon(l,1)*crot(mod(3*l,4))
598  & +slon(l,1)*srot(mod(3*l,4))
599  slon(l,8)=slon(l,2)*crot(mod(3*l,4))
600  & -clon(l,2)*srot(mod(3*l,4))
601  clon(l,8)=clon(l,2)*crot(mod(3*l,4))
602  & +slon(l,2)*srot(mod(3*l,4))
603  ENDDO
604 CDIR$ IVDEP
605  DO k=1,kmax
606  ku=k
607  kv=k+kmax
608  ijk1=ij1+(k-1)*kg
609  ijk2=ij2+(k-1)*kg
610  ijk3=ij3+(k-1)*kg
611  ijk4=ij4+(k-1)*kg
612  ijk5=ij5+(k-1)*kg
613  ijk6=ij6+(k-1)*kg
614  ijk7=ij7+(k-1)*kg
615  ijk8=ij8+(k-1)*kg
616  un(ijk1)=rr*(-dj1*f(1,1,ku)-di1*f(1,1,kv))
617  vn(ijk1)=rr*( di1*f(1,1,ku)-dj1*f(1,1,kv))
618  un(ijk2)=rr*(-di1*f(1,1,ku)-dj1*f(1,1,kv))
619  vn(ijk2)=rr*( dj1*f(1,1,ku)-di1*f(1,1,kv))
620  un(ijk3)=rr*( di1*f(1,1,ku)-dj1*f(1,1,kv))
621  vn(ijk3)=rr*( dj1*f(1,1,ku)+di1*f(1,1,kv))
622  un(ijk4)=rr*( dj1*f(1,1,ku)-di1*f(1,1,kv))
623  vn(ijk4)=rr*( di1*f(1,1,ku)+dj1*f(1,1,kv))
624  un(ijk5)=rr*( dj1*f(1,1,ku)+di1*f(1,1,kv))
625  vn(ijk5)=rr*(-di1*f(1,1,ku)+dj1*f(1,1,kv))
626  un(ijk6)=rr*( di1*f(1,1,ku)+dj1*f(1,1,kv))
627  vn(ijk6)=rr*(-dj1*f(1,1,ku)+di1*f(1,1,kv))
628  un(ijk7)=rr*(-di1*f(1,1,ku)+dj1*f(1,1,kv))
629  vn(ijk7)=rr*(-dj1*f(1,1,ku)-di1*f(1,1,kv))
630  un(ijk8)=rr*(-dj1*f(1,1,ku)+di1*f(1,1,kv))
631  vn(ijk8)=rr*(-di1*f(1,1,ku)-dj1*f(1,1,kv))
632  us(ijk1)=rr*( dj1*f(1,2,ku)+di1*f(1,2,kv))
633  vs(ijk1)=rr*(-di1*f(1,2,ku)+dj1*f(1,2,kv))
634  us(ijk2)=rr*( di1*f(1,2,ku)+dj1*f(1,2,kv))
635  vs(ijk2)=rr*(-dj1*f(1,2,ku)+di1*f(1,2,kv))
636  us(ijk3)=rr*(-di1*f(1,2,ku)+dj1*f(1,2,kv))
637  vs(ijk3)=rr*(-dj1*f(1,2,ku)-di1*f(1,2,kv))
638  us(ijk4)=rr*(-dj1*f(1,2,ku)+di1*f(1,2,kv))
639  vs(ijk4)=rr*(-di1*f(1,2,ku)-dj1*f(1,2,kv))
640  us(ijk5)=rr*(-dj1*f(1,2,ku)-di1*f(1,2,kv))
641  vs(ijk5)=rr*( di1*f(1,2,ku)-dj1*f(1,2,kv))
642  us(ijk6)=rr*(-di1*f(1,2,ku)-dj1*f(1,2,kv))
643  vs(ijk6)=rr*( dj1*f(1,2,ku)-di1*f(1,2,kv))
644  us(ijk7)=rr*( di1*f(1,2,ku)-dj1*f(1,2,kv))
645  vs(ijk7)=rr*( dj1*f(1,2,ku)+di1*f(1,2,kv))
646  us(ijk8)=rr*( dj1*f(1,2,ku)-di1*f(1,2,kv))
647  vs(ijk8)=rr*( di1*f(1,2,ku)+dj1*f(1,2,kv))
648  ENDDO
649  IF(kmax.EQ.1) THEN
650  ku=1
651  kv=2
652  DO l=1,maxwv
653  lr=2*l+1
654  li=2*l+2
655  un(ij1)=un(ij1)+2*rr*((-dj1*f(lr,1,ku)-di1*f(lr,1,kv))
656  & *clon(l,1)
657  & -(-dj1*f(li,1,ku)-di1*f(li,1,kv))
658  & *slon(l,1))
659  vn(ij1)=vn(ij1)+2*rr*(( di1*f(lr,1,ku)-dj1*f(lr,1,kv))
660  & *clon(l,1)
661  & -( di1*f(li,1,ku)-dj1*f(li,1,kv))
662  & *slon(l,1))
663  un(ij2)=un(ij2)+2*rr*((-di1*f(lr,1,ku)-dj1*f(lr,1,kv))
664  & *clon(l,2)
665  & -(-di1*f(li,1,ku)-dj1*f(li,1,kv))
666  & *slon(l,2))
667  vn(ij2)=vn(ij2)+2*rr*(( dj1*f(lr,1,ku)-di1*f(lr,1,kv))
668  & *clon(l,2)
669  & -( dj1*f(li,1,ku)-di1*f(li,1,kv))
670  & *slon(l,2))
671  un(ij3)=un(ij3)+2*rr*(( di1*f(lr,1,ku)-dj1*f(lr,1,kv))
672  & *clon(l,3)
673  & -( di1*f(li,1,ku)-dj1*f(li,1,kv))
674  & *slon(l,3))
675  vn(ij3)=vn(ij3)+2*rr*(( dj1*f(lr,1,ku)+di1*f(lr,1,kv))
676  & *clon(l,3)
677  & -( dj1*f(li,1,ku)+di1*f(li,1,kv))
678  & *slon(l,3))
679  un(ij4)=un(ij4)+2*rr*(( dj1*f(lr,1,ku)-di1*f(lr,1,kv))
680  & *clon(l,4)
681  & -( dj1*f(li,1,ku)-di1*f(li,1,kv))
682  & *slon(l,4))
683  vn(ij4)=vn(ij4)+2*rr*(( di1*f(lr,1,ku)+dj1*f(lr,1,kv))
684  & *clon(l,4)
685  & -( di1*f(li,1,ku)+dj1*f(li,1,kv))
686  & *slon(l,4))
687  un(ij5)=un(ij5)+2*rr*(( dj1*f(lr,1,ku)+di1*f(lr,1,kv))
688  & *clon(l,5)
689  & -( dj1*f(li,1,ku)+di1*f(li,1,kv))
690  & *slon(l,5))
691  vn(ij5)=vn(ij5)+2*rr*((-di1*f(lr,1,ku)+dj1*f(lr,1,kv))
692  & *clon(l,5)
693  & -(-di1*f(li,1,ku)+dj1*f(li,1,kv))
694  & *slon(l,5))
695  un(ij6)=un(ij6)+2*rr*(( di1*f(lr,1,ku)+dj1*f(lr,1,kv))
696  & *clon(l,6)
697  & -( di1*f(li,1,ku)+dj1*f(li,1,kv))
698  & *slon(l,6))
699  vn(ij6)=vn(ij6)+2*rr*((-dj1*f(lr,1,ku)+di1*f(lr,1,kv))
700  & *clon(l,6)
701  & -(-dj1*f(li,1,ku)+di1*f(li,1,kv))
702  & *slon(l,6))
703  un(ij7)=un(ij7)+2*rr*((-di1*f(lr,1,ku)+dj1*f(lr,1,kv))
704  & *clon(l,7)
705  & -(-di1*f(li,1,ku)+dj1*f(li,1,kv))
706  & *slon(l,7))
707  vn(ij7)=vn(ij7)+2*rr*((-dj1*f(lr,1,ku)-di1*f(lr,1,kv))
708  & *clon(l,7)
709  & -(-dj1*f(li,1,ku)-di1*f(li,1,kv))
710  & *slon(l,7))
711  un(ij8)=un(ij8)+2*rr*((-dj1*f(lr,1,ku)+di1*f(lr,1,kv))
712  & *clon(l,8)
713  & -(-dj1*f(li,1,ku)+di1*f(li,1,kv))
714  & *slon(l,8))
715  vn(ij8)=vn(ij8)+2*rr*((-di1*f(lr,1,ku)-dj1*f(lr,1,kv))
716  & *clon(l,8)
717  & -(-di1*f(li,1,ku)-dj1*f(li,1,kv))
718  & *slon(l,8))
719  us(ij1)=us(ij1)+2*rr*(( dj1*f(lr,2,ku)+di1*f(lr,2,kv))
720  & *clon(l,4)
721  & -( dj1*f(li,2,ku)+di1*f(li,2,kv))
722  & *slon(l,4))
723  vs(ij1)=vs(ij1)+2*rr*((-di1*f(lr,2,ku)+dj1*f(lr,2,kv))
724  & *clon(l,4)
725  & -(-di1*f(li,2,ku)+dj1*f(li,2,kv))
726  & *slon(l,4))
727  us(ij2)=us(ij2)+2*rr*(( di1*f(lr,2,ku)+dj1*f(lr,2,kv))
728  & *clon(l,3)
729  & -( di1*f(li,2,ku)+dj1*f(li,2,kv))
730  & *slon(l,3))
731  vs(ij2)=vs(ij2)+2*rr*((-dj1*f(lr,2,ku)+di1*f(lr,2,kv))
732  & *clon(l,3)
733  & -(-dj1*f(li,2,ku)+di1*f(li,2,kv))
734  & *slon(l,3))
735  us(ij3)=us(ij3)+2*rr*((-di1*f(lr,2,ku)+dj1*f(lr,2,kv))
736  & *clon(l,2)
737  & -(-di1*f(li,2,ku)+dj1*f(li,2,kv))
738  & *slon(l,2))
739  vs(ij3)=vs(ij3)+2*rr*((-dj1*f(lr,2,ku)-di1*f(lr,2,kv))
740  & *clon(l,2)
741  & -(-dj1*f(li,2,ku)-di1*f(li,2,kv))
742  & *slon(l,2))
743  us(ij4)=us(ij4)+2*rr*((-dj1*f(lr,2,ku)+di1*f(lr,2,kv))
744  & *clon(l,1)
745  & -(-dj1*f(li,2,ku)+di1*f(li,2,kv))
746  & *slon(l,1))
747  vs(ij4)=vs(ij4)+2*rr*((-di1*f(lr,2,ku)-dj1*f(lr,2,kv))
748  & *clon(l,1)
749  & -(-di1*f(li,2,ku)-dj1*f(li,2,kv))
750  & *slon(l,1))
751  us(ij5)=us(ij5)+2*rr*((-dj1*f(lr,2,ku)-di1*f(lr,2,kv))
752  & *clon(l,8)
753  & -(-dj1*f(li,2,ku)-di1*f(li,2,kv))
754  & *slon(l,8))
755  vs(ij5)=vs(ij5)+2*rr*(( di1*f(lr,2,ku)-dj1*f(lr,2,kv))
756  & *clon(l,8)
757  & -( di1*f(li,2,ku)-dj1*f(li,2,kv))
758  & *slon(l,8))
759  us(ij6)=us(ij6)+2*rr*((-di1*f(lr,2,ku)-dj1*f(lr,2,kv))
760  & *clon(l,7)
761  & -(-di1*f(li,2,ku)-dj1*f(li,2,kv))
762  & *slon(l,7))
763  vs(ij6)=vs(ij6)+2*rr*(( dj1*f(lr,2,ku)-di1*f(lr,2,kv))
764  & *clon(l,7)
765  & -( dj1*f(li,2,ku)-di1*f(li,2,kv))
766  & *slon(l,7))
767  us(ij7)=us(ij7)+2*rr*(( di1*f(lr,2,ku)-dj1*f(lr,2,kv))
768  & *clon(l,6)
769  & -( di1*f(li,2,ku)-dj1*f(li,2,kv))
770  & *slon(l,6))
771  vs(ij7)=vs(ij7)+2*rr*(( dj1*f(lr,2,ku)+di1*f(lr,2,kv))
772  & *clon(l,6)
773  & -( dj1*f(li,2,ku)+di1*f(li,2,kv))
774  & *slon(l,6))
775  us(ij8)=us(ij8)+2*rr*(( dj1*f(lr,2,ku)-di1*f(lr,2,kv))
776  & *clon(l,5)
777  & -( dj1*f(li,2,ku)-di1*f(li,2,kv))
778  & *slon(l,5))
779  vs(ij8)=vs(ij8)+2*rr*(( di1*f(lr,2,ku)+dj1*f(lr,2,kv))
780  & *clon(l,5)
781  & -( di1*f(li,2,ku)+dj1*f(li,2,kv))
782  & *slon(l,5))
783  ENDDO
784  ELSE
785  DO l=1,maxwv
786  lr=2*l+1
787  li=2*l+2
788 CDIR$ IVDEP
789  DO k=1,kmax
790  ku=k
791  kv=k+kmax
792  ijk1=ij1+(k-1)*kg
793  ijk2=ij2+(k-1)*kg
794  ijk3=ij3+(k-1)*kg
795  ijk4=ij4+(k-1)*kg
796  ijk5=ij5+(k-1)*kg
797  ijk6=ij6+(k-1)*kg
798  ijk7=ij7+(k-1)*kg
799  ijk8=ij8+(k-1)*kg
800  un(ijk1)=un(ijk1)+2*rr*((-dj1*f(lr,1,ku)-di1*f(lr,1,kv))
801  & *clon(l,1)
802  & -(-dj1*f(li,1,ku)-di1*f(li,1,kv))
803  & *slon(l,1))
804  vn(ijk1)=vn(ijk1)+2*rr*(( di1*f(lr,1,ku)-dj1*f(lr,1,kv))
805  & *clon(l,1)
806  & -( di1*f(li,1,ku)-dj1*f(li,1,kv))
807  & *slon(l,1))
808  un(ijk2)=un(ijk2)+2*rr*((-di1*f(lr,1,ku)-dj1*f(lr,1,kv))
809  & *clon(l,2)
810  & -(-di1*f(li,1,ku)-dj1*f(li,1,kv))
811  & *slon(l,2))
812  vn(ijk2)=vn(ijk2)+2*rr*(( dj1*f(lr,1,ku)-di1*f(lr,1,kv))
813  & *clon(l,2)
814  & -( dj1*f(li,1,ku)-di1*f(li,1,kv))
815  & *slon(l,2))
816  un(ijk3)=un(ijk3)+2*rr*(( di1*f(lr,1,ku)-dj1*f(lr,1,kv))
817  & *clon(l,3)
818  & -( di1*f(li,1,ku)-dj1*f(li,1,kv))
819  & *slon(l,3))
820  vn(ijk3)=vn(ijk3)+2*rr*(( dj1*f(lr,1,ku)+di1*f(lr,1,kv))
821  & *clon(l,3)
822  & -( dj1*f(li,1,ku)+di1*f(li,1,kv))
823  & *slon(l,3))
824  un(ijk4)=un(ijk4)+2*rr*(( dj1*f(lr,1,ku)-di1*f(lr,1,kv))
825  & *clon(l,4)
826  & -( dj1*f(li,1,ku)-di1*f(li,1,kv))
827  & *slon(l,4))
828  vn(ijk4)=vn(ijk4)+2*rr*(( di1*f(lr,1,ku)+dj1*f(lr,1,kv))
829  & *clon(l,4)
830  & -( di1*f(li,1,ku)+dj1*f(li,1,kv))
831  & *slon(l,4))
832  un(ijk5)=un(ijk5)+2*rr*(( dj1*f(lr,1,ku)+di1*f(lr,1,kv))
833  & *clon(l,5)
834  & -( dj1*f(li,1,ku)+di1*f(li,1,kv))
835  & *slon(l,5))
836  vn(ijk5)=vn(ijk5)+2*rr*((-di1*f(lr,1,ku)+dj1*f(lr,1,kv))
837  & *clon(l,5)
838  & -(-di1*f(li,1,ku)+dj1*f(li,1,kv))
839  & *slon(l,5))
840  un(ijk6)=un(ijk6)+2*rr*(( di1*f(lr,1,ku)+dj1*f(lr,1,kv))
841  & *clon(l,6)
842  & -( di1*f(li,1,ku)+dj1*f(li,1,kv))
843  & *slon(l,6))
844  vn(ijk6)=vn(ijk6)+2*rr*((-dj1*f(lr,1,ku)+di1*f(lr,1,kv))
845  & *clon(l,6)
846  & -(-dj1*f(li,1,ku)+di1*f(li,1,kv))
847  & *slon(l,6))
848  un(ijk7)=un(ijk7)+2*rr*((-di1*f(lr,1,ku)+dj1*f(lr,1,kv))
849  & *clon(l,7)
850  & -(-di1*f(li,1,ku)+dj1*f(li,1,kv))
851  & *slon(l,7))
852  vn(ijk7)=vn(ijk7)+2*rr*((-dj1*f(lr,1,ku)-di1*f(lr,1,kv))
853  & *clon(l,7)
854  & -(-dj1*f(li,1,ku)-di1*f(li,1,kv))
855  & *slon(l,7))
856  un(ijk8)=un(ijk8)+2*rr*((-dj1*f(lr,1,ku)+di1*f(lr,1,kv))
857  & *clon(l,8)
858  & -(-dj1*f(li,1,ku)+di1*f(li,1,kv))
859  & *slon(l,8))
860  vn(ijk8)=vn(ijk8)+2*rr*((-di1*f(lr,1,ku)-dj1*f(lr,1,kv))
861  & *clon(l,8)
862  & -(-di1*f(li,1,ku)-dj1*f(li,1,kv))
863  & *slon(l,8))
864  us(ijk1)=us(ijk1)+2*rr*(( dj1*f(lr,2,ku)+di1*f(lr,2,kv))
865  & *clon(l,4)
866  & -( dj1*f(li,2,ku)+di1*f(li,2,kv))
867  & *slon(l,4))
868  vs(ijk1)=vs(ijk1)+2*rr*((-di1*f(lr,2,ku)+dj1*f(lr,2,kv))
869  & *clon(l,4)
870  & -(-di1*f(li,2,ku)+dj1*f(li,2,kv))
871  & *slon(l,4))
872  us(ijk2)=us(ijk2)+2*rr*(( di1*f(lr,2,ku)+dj1*f(lr,2,kv))
873  & *clon(l,3)
874  & -( di1*f(li,2,ku)+dj1*f(li,2,kv))
875  & *slon(l,3))
876  vs(ijk2)=vs(ijk2)+2*rr*((-dj1*f(lr,2,ku)+di1*f(lr,2,kv))
877  & *clon(l,3)
878  & -(-dj1*f(li,2,ku)+di1*f(li,2,kv))
879  & *slon(l,3))
880  us(ijk3)=us(ijk3)+2*rr*((-di1*f(lr,2,ku)+dj1*f(lr,2,kv))
881  & *clon(l,2)
882  & -(-di1*f(li,2,ku)+dj1*f(li,2,kv))
883  & *slon(l,2))
884  vs(ijk3)=vs(ijk3)+2*rr*((-dj1*f(lr,2,ku)-di1*f(lr,2,kv))
885  & *clon(l,2)
886  & -(-dj1*f(li,2,ku)-di1*f(li,2,kv))
887  & *slon(l,2))
888  us(ijk4)=us(ijk4)+2*rr*((-dj1*f(lr,2,ku)+di1*f(lr,2,kv))
889  & *clon(l,1)
890  & -(-dj1*f(li,2,ku)+di1*f(li,2,kv))
891  & *slon(l,1))
892  vs(ijk4)=vs(ijk4)+2*rr*((-di1*f(lr,2,ku)-dj1*f(lr,2,kv))
893  & *clon(l,1)
894  & -(-di1*f(li,2,ku)-dj1*f(li,2,kv))
895  & *slon(l,1))
896  us(ijk5)=us(ijk5)+2*rr*((-dj1*f(lr,2,ku)-di1*f(lr,2,kv))
897  & *clon(l,8)
898  & -(-dj1*f(li,2,ku)-di1*f(li,2,kv))
899  & *slon(l,8))
900  vs(ijk5)=vs(ijk5)+2*rr*(( di1*f(lr,2,ku)-dj1*f(lr,2,kv))
901  & *clon(l,8)
902  & -( di1*f(li,2,ku)-dj1*f(li,2,kv))
903  & *slon(l,8))
904  us(ijk6)=us(ijk6)+2*rr*((-di1*f(lr,2,ku)-dj1*f(lr,2,kv))
905  & *clon(l,7)
906  & -(-di1*f(li,2,ku)-dj1*f(li,2,kv))
907  & *slon(l,7))
908  vs(ijk6)=vs(ijk6)+2*rr*(( dj1*f(lr,2,ku)-di1*f(lr,2,kv))
909  & *clon(l,7)
910  & -( dj1*f(li,2,ku)-di1*f(li,2,kv))
911  & *slon(l,7))
912  us(ijk7)=us(ijk7)+2*rr*(( di1*f(lr,2,ku)-dj1*f(lr,2,kv))
913  & *clon(l,6)
914  & -( di1*f(li,2,ku)-dj1*f(li,2,kv))
915  & *slon(l,6))
916  vs(ijk7)=vs(ijk7)+2*rr*(( dj1*f(lr,2,ku)+di1*f(lr,2,kv))
917  & *clon(l,6)
918  & -( dj1*f(li,2,ku)+di1*f(li,2,kv))
919  & *slon(l,6))
920  us(ijk8)=us(ijk8)+2*rr*(( dj1*f(lr,2,ku)-di1*f(lr,2,kv))
921  & *clon(l,5)
922  & -( dj1*f(li,2,ku)-di1*f(li,2,kv))
923  & *slon(l,5))
924  vs(ijk8)=vs(ijk8)+2*rr*(( di1*f(lr,2,ku)+dj1*f(lr,2,kv))
925  & *clon(l,5)
926  & -( di1*f(li,2,ku)+dj1*f(li,2,kv))
927  & *slon(l,5))
928  ENDDO
929  ENDDO
930  ENDIF
931  ENDDO
932  ENDDO
933 
934  END
spdz2uv
subroutine spdz2uv(I, M, ENN1, ELONN1, EON, EONTOP, D, Z, U, V, UTOP, VTOP)
Computes the wind components from divergence and vorticity in spectral space.
Definition: spdz2uv.f:49
splegend
subroutine splegend(I, M, SLAT, CLAT, EPS, EPSTOP, PLN, PLNTOP)
Evaluates the orthonormal associated Legendre polynomials in the spectral domain at a given latitude.
Definition: splegend.f:45
spsynth
subroutine spsynth(I, M, IM, IX, NC, NCTOP, KM, CLAT, PLN, PLNTOP, MP, SPC, SPCTOP, F)
Synthesizes Fourier coefficients from spectral coefficients for a latitude pair (Northern and Souther...
Definition: spsynth.f:39
sptgpsv
subroutine sptgpsv(IROMB, MAXWV, KMAX, NPS, KWSKIP, KGSKIP, NISKIP, NJSKIP, TRUE, XMESH, ORIENT, WAVED, WAVEZ, UN, VN, US, VS)
This subprogram performs a spherical transform from spectral coefficients of divergences and curls to...
Definition: sptgpsv.f:83
spwget
subroutine spwget(IROMB, MAXWV, EPS, EPSTOP, ENN1, ELONN1, EON, EONTOP)
This subprogram gets wave-space constants.
Definition: spwget.f:18