NCEPLIBS-sp  2.3.3
sptgptvd.f
Go to the documentation of this file.
1 C> @file
2 C>
3 C> Transform spectral vector to station points
4 C> @author IREDELL @date 96-02-29
5 
6 C> THIS SUBPROGRAM PERFORMS A SPHERICAL TRANSFORM
7 C> FROM SPECTRAL COEFFICIENTS OF DIVERGENCES AND CURLS
8 C> TO SPECIFIED SETS OF STATION POINT VECTORS AND THEIR
9 C> GRADIENTS ON THE GLOBE.
10 C> <pre>
11 C> DP=(D(UP)/DLON+D(VP*CLAT)/DLAT)/(R*CLAT)
12 C> ZP=(D(VP)/DLON-D(UP*CLAT)/DLAT)/(R*CLAT)
13 C> UXP=D(UP*CLAT)/DLON/(R*CLAT)
14 C> VXP=D(VP*CLAT)/DLON/(R*CLAT)
15 C> UYP=D(UP*CLAT)/DLAT/R
16 C> VYP=D(VP*CLAT)/DLAT/R
17 C> </pre>
18 C> THE WAVE-SPACE CAN BE EITHER TRIANGULAR OR RHOMBOIDAL.
19 C> THE WAVE AND POINT FIELDS MAY HAVE GENERAL INDEXING,
20 C> BUT EACH WAVE FIELD IS IN SEQUENTIAL 'IBM ORDER',
21 C> I.E. WITH ZONAL WAVENUMBER AS THE SLOWER INDEX.
22 C> THE TRANSFORMS ARE ALL MULTIPROCESSED OVER STATIONS.
23 C> TRANSFORM SEVERAL FIELDS AT A TIME TO IMPROVE VECTORIZATION.
24 C> SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT.
25 C>
26 C> PROGRAM HISTORY LOG:
27 C> - 96-02-29 IREDELL
28 C> - 1998-12-15 IREDELL OPENMP DIRECTIVES INSERTED
29 C> - 1999-08-18 IREDELL OPENMP DIRECTIVE TYPO FIXED
30 C>
31 C> @param IROMB - INTEGER SPECTRAL DOMAIN SHAPE
32 C> (0 FOR TRIANGULAR, 1 FOR RHOMBOIDAL)
33 C> @param MAXWV - INTEGER SPECTRAL TRUNCATION
34 C> @param KMAX - INTEGER NUMBER OF FIELDS TO TRANSFORM.
35 C> @param NMAX - INTEGER NUMBER OF STATION POINTS TO RETURN
36 C> @param KWSKIP - INTEGER SKIP NUMBER BETWEEN WAVE FIELDS
37 C> (DEFAULTS TO (MAXWV+1)*((IROMB+1)*MAXWV+2) IF KWSKIP=0)
38 C> @param KGSKIP - INTEGER SKIP NUMBER BETWEEN STATION POINT SETS
39 C> (DEFAULTS TO NMAX IF KGSKIP=0)
40 C> @param NRSKIP - INTEGER SKIP NUMBER BETWEEN STATION LATS AND LONS
41 C> (DEFAULTS TO 1 IF NRSKIP=0)
42 C> @param NGSKIP - INTEGER SKIP NUMBER BETWEEN STATION POINTS
43 C> (DEFAULTS TO 1 IF NGSKIP=0)
44 C> @param RLAT - REAL (*) STATION LATITUDES IN DEGREES
45 C> @param RLON - REAL (*) STATION LONGITUDES IN DEGREES
46 C> @param WAVED - REAL (*) WAVE DIVERGENCE FIELDS
47 C> @param WAVEZ - REAL (*) WAVE VORTICITY FIELDS
48 C> @param DP - REAL (*) STATION POINT DIVERGENCE SETS
49 C> @param ZP - REAL (*) STATION POINT VORTICITY SETS
50 C> @param UP - REAL (*) STATION POINT U-WIND SETS
51 C> @param VP - REAL (*) STATION POINT V-WIND SETS
52 C> @param UXP - REAL (*) STATION POINT U-WIND X-GRADIENT SETS
53 C> @param VXP - REAL (*) STATION POINT V-WIND X-GRADIENT SETS
54 C> @param UYP - REAL (*) STATION POINT U-WIND Y-GRADIENT SETS
55 C> @param VYP - REAL (*) STATION POINT V-WIND Y-GRADIENT SETS
56 C>
57 C> SUBPROGRAMS CALLED:
58 C> - SPWGET GET WAVE-SPACE CONSTANTS
59 C> - SPLEGEND COMPUTE LEGENDRE POLYNOMIALS
60 C> - SPSYNTH SYNTHESIZE FOURIER FROM SPECTRAL
61 C> - SPDZ2UV COMPUTE WINDS FROM DIVERGENCE AND VORTICITY
62 C> - SPGRADX COMPUTE X-GRADIENT IN FOURIER SPACE
63 C> - SPFFTPT COMPUTE FOURIER TRANSFORM TO GRIDPOINTS
64  SUBROUTINE sptgptvd(IROMB,MAXWV,KMAX,NMAX,
65  & KWSKIP,KGSKIP,NRSKIP,NGSKIP,
66  & RLAT,RLON,WAVED,WAVEZ,
67  & DP,ZP,UP,VP,UXP,VXP,UYP,VYP)
68 
69  REAL RLAT(*),RLON(*),WAVED(*),WAVEZ(*)
70  REAL DP(*),ZP(*),UP(*),VP(*),UXP(*),VXP(*),UYP(*),VYP(*)
71  REAL EPS((MAXWV+1)*((IROMB+1)*MAXWV+2)/2),EPSTOP(MAXWV+1)
72  REAL ENN1((MAXWV+1)*((IROMB+1)*MAXWV+2)/2)
73  REAL ELONN1((MAXWV+1)*((IROMB+1)*MAXWV+2)/2)
74  REAL EON((MAXWV+1)*((IROMB+1)*MAXWV+2)/2),EONTOP(MAXWV+1)
75  INTEGER MP(4*KMAX)
76  REAL W((MAXWV+1)*((IROMB+1)*MAXWV+2)/2*2,4*KMAX)
77  REAL WTOP(2*(MAXWV+1),4*KMAX)
78  REAL PLN((MAXWV+1)*((IROMB+1)*MAXWV+2)/2),PLNTOP(MAXWV+1)
79  REAL F(2*MAXWV+2,2,6*KMAX),G(6*KMAX)
80  parameter(pi=3.14159265358979)
81 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
82 C CALCULATE PRELIMINARY CONSTANTS
83  CALL spwget(iromb,maxwv,eps,epstop,enn1,elonn1,eon,eontop)
84  mx=(maxwv+1)*((iromb+1)*maxwv+2)/2
85  mxtop=maxwv+1
86  mdim=2*mx
87  idim=2*maxwv+2
88  kw=kwskip
89  kg=kgskip
90  nr=nrskip
91  ng=ngskip
92  IF(kw.EQ.0) kw=2*mx
93  IF(kg.EQ.0) kg=nmax
94  IF(nr.EQ.0) nr=1
95  IF(ng.EQ.0) ng=1
96  mp(1:2*kmax)=0
97  mp(2*kmax+1:4*kmax)=1
98 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
99 C CALCULATE SPECTRAL WINDS
100 C$OMP PARALLEL DO PRIVATE(KWS,KD,KZ,KU,KV)
101  DO k=1,kmax
102  kws=(k-1)*kw
103  kd=0*kmax+k
104  kz=1*kmax+k
105  ku=2*kmax+k
106  kv=3*kmax+k
107  DO i=1,2*mx
108  w(i,kd)=waved(kws+i)
109  w(i,kz)=wavez(kws+i)
110  ENDDO
111  DO i=1,2*mxtop
112  wtop(i,kd)=0
113  wtop(i,kz)=0
114  ENDDO
115  CALL spdz2uv(iromb,maxwv,enn1,elonn1,eon,eontop,
116  & waved(kws+1),wavez(kws+1),
117  & w(1,ku),w(1,kv),wtop(1,ku),wtop(1,kv))
118  ENDDO
119 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
120 C CALCULATE STATION FIELDS
121 C$OMP PARALLEL DO PRIVATE(KD,KZ,KU,KV,KUX,KVX,SLAT1,CLAT1)
122 C$OMP& PRIVATE(PLN,PLNTOP,F,G,NK)
123  DO n=1,nmax
124  ku=2*kmax+1
125  kux=4*kmax+1
126  IF(abs(rlat((n-1)*nr+1)).GE.89.9995) THEN
127  slat1=sign(1.,rlat((n-1)*nr+1))
128  clat1=0.
129  ELSE
130  slat1=sin(pi/180*rlat((n-1)*nr+1))
131  clat1=cos(pi/180*rlat((n-1)*nr+1))
132  ENDIF
133  CALL splegend(iromb,maxwv,slat1,clat1,eps,epstop,
134  & pln,plntop)
135  CALL spsynth(iromb,maxwv,2*maxwv,idim,mdim,2*mxtop,4*kmax,
136  & clat1,pln,plntop,mp,w,wtop,f)
137  CALL spgradx(maxwv,idim,2*kmax,mp(2*kmax+1),clat1,
138  & f(1,1,2*kmax+1),f(1,1,4*kmax+1))
139  CALL spfftpt(maxwv,1,idim,1,6*kmax,rlon((n-1)*nr+1),f,g)
140  DO k=1,kmax
141  kd=0*kmax+k
142  kz=1*kmax+k
143  ku=2*kmax+k
144  kv=3*kmax+k
145  kux=4*kmax+k
146  kvx=5*kmax+k
147  nk=(n-1)*ng+(k-1)*kg+1
148  dp(nk)=g(kd)
149  zp(nk)=g(kz)
150  up(nk)=g(ku)
151  vp(nk)=g(kv)
152  uxp(nk)=g(kux)
153  vxp(nk)=g(kvx)
154  uyp(nk)=g(kvx)-clat1*g(kz)
155  vyp(nk)=clat1*g(kd)-g(kux)
156  ENDDO
157  ENDDO
158 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
159  END
spwget
subroutine spwget(IROMB, MAXWV, EPS, EPSTOP, ENN1, ELONN1, EON, EONTOP)
This subprogram gets wave-space constants.
Definition: spwget.f:22
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:35
spfftpt
subroutine spfftpt(M, N, INCW, INCG, KMAX, RLON, W, G)
THIS SUBPROGRAM COMPUTES A SLOW FOURIER TRANSFORM FROM FOURIER SPACE TO A SET OF GRIDPOINTS.
Definition: spfftpt.f:22
spgradx
subroutine spgradx(M, INCW, KMAX, MP, CLAT, W, WX)
THIS SUBPROGRAM COMPUTES THE X-GRADIENT OF FIELDS IN COMPLEX FOURIER SPACE.
Definition: spgradx.f:35
sptgptvd
subroutine sptgptvd(IROMB, MAXWV, KMAX, NMAX, KWSKIP, KGSKIP, NRSKIP, NGSKIP, RLAT, RLON, WAVED, WAVEZ, DP, ZP, UP, VP, UXP, VXP, UYP, VYP)
THIS SUBPROGRAM PERFORMS A SPHERICAL TRANSFORM FROM SPECTRAL COEFFICIENTS OF DIVERGENCES AND CURLS TO...
Definition: sptgptvd.f:68
spdz2uv
subroutine spdz2uv(I, M, ENN1, ELONN1, EON, EONTOP, D, Z, U, V, UTOP, VTOP)
Compute winds from divergence and vorticity.
Definition: spdz2uv.f:45