NCEPLIBS-sp  2.3.3
sptgptv.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 ON THE GLOBE.
9 C> THE WAVE-SPACE CAN BE EITHER TRIANGULAR OR RHOMBOIDAL.
10 C> THE WAVE AND POINT FIELDS MAY HAVE GENERAL INDEXING,
11 C> BUT EACH WAVE FIELD IS IN SEQUENTIAL 'IBM ORDER',
12 C> I.E. WITH ZONAL WAVENUMBER AS THE SLOWER INDEX.
13 C> THE TRANSFORMS ARE ALL MULTIPROCESSED OVER STATIONS.
14 C> TRANSFORM SEVERAL FIELDS AT A TIME TO IMPROVE VECTORIZATION.
15 C> SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT.
16 C>
17 C> PROGRAM HISTORY LOG:
18 C> - 96-02-29 IREDELL
19 C> - 1998-12-15 IREDELL OPENMP DIRECTIVES INSERTED
20 C> - 1999-08-18 IREDELL OPENMP DIRECTIVE TYPO FIXED
21 C> - 2003-06-30 IREDELL USE SPFFTPT
22 C>
23 C> @param IROMB - INTEGER SPECTRAL DOMAIN SHAPE
24 C> (0 FOR TRIANGULAR, 1 FOR RHOMBOIDAL)
25 C> @param MAXWV - INTEGER SPECTRAL TRUNCATION
26 C> @param KMAX - INTEGER NUMBER OF FIELDS TO TRANSFORM.
27 C> @param NMAX - INTEGER NUMBER OF STATION POINTS TO RETURN
28 C> @param KWSKIP - INTEGER SKIP NUMBER BETWEEN WAVE FIELDS
29 C> (DEFAULTS TO (MAXWV+1)*((IROMB+1)*MAXWV+2) IF KWSKIP=0)
30 C> @param KGSKIP - INTEGER SKIP NUMBER BETWEEN STATION POINT SETS
31 C> (DEFAULTS TO NMAX IF KGSKIP=0)
32 C> @param NRSKIP - INTEGER SKIP NUMBER BETWEEN STATION LATS AND LONS
33 C> (DEFAULTS TO 1 IF NRSKIP=0)
34 C> @param NGSKIP - INTEGER SKIP NUMBER BETWEEN STATION POINTS
35 C> (DEFAULTS TO 1 IF NGSKIP=0)
36 C> @param RLAT - REAL (*) STATION LATITUDES IN DEGREES
37 C> @param RLON - REAL (*) STATION LONGITUDES IN DEGREES
38 C> @param WAVED - REAL (*) WAVE DIVERGENCE FIELDS
39 C> @param WAVEZ - REAL (*) WAVE VORTICITY FIELDS
40 C> @param UP - REAL (*) STATION POINT U-WIND SETS
41 C> @param VP - REAL (*) STATION POINT V-WIND SETS
42 C>
43 C> SUBPROGRAMS CALLED:
44 C> - SPWGET GET WAVE-SPACE CONSTANTS
45 C> - SPLEGEND COMPUTE LEGENDRE POLYNOMIALS
46 C> - SPSYNTH SYNTHESIZE FOURIER FROM SPECTRAL
47 C> - SPDZ2UV COMPUTE WINDS FROM DIVERGENCE AND VORTICITY
48 C> - SPFFTPT POINTWISE FOURIER TRANSFORM
49  SUBROUTINE sptgptv(IROMB,MAXWV,KMAX,NMAX,
50  & KWSKIP,KGSKIP,NRSKIP,NGSKIP,
51  & RLAT,RLON,WAVED,WAVEZ,UP,VP)
52 
53  REAL RLAT(*),RLON(*),WAVED(*),WAVEZ(*),UP(*),VP(*)
54  REAL EPS((MAXWV+1)*((IROMB+1)*MAXWV+2)/2),EPSTOP(MAXWV+1)
55  REAL ENN1((MAXWV+1)*((IROMB+1)*MAXWV+2)/2)
56  REAL ELONN1((MAXWV+1)*((IROMB+1)*MAXWV+2)/2)
57  REAL EON((MAXWV+1)*((IROMB+1)*MAXWV+2)/2),EONTOP(MAXWV+1)
58  INTEGER MP(2*KMAX)
59  REAL W((MAXWV+1)*((IROMB+1)*MAXWV+2)/2*2+1,2*KMAX)
60  REAL WTOP(2*(MAXWV+1),2*KMAX)
61  REAL PLN((MAXWV+1)*((IROMB+1)*MAXWV+2)/2),PLNTOP(MAXWV+1)
62  REAL F(2*MAXWV+3,2,2*KMAX)
63  REAL G(2*KMAX)
64  parameter(pi=3.14159265358979)
65 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
66 C CALCULATE PRELIMINARY CONSTANTS
67  CALL spwget(iromb,maxwv,eps,epstop,enn1,elonn1,eon,eontop)
68  mx=(maxwv+1)*((iromb+1)*maxwv+2)/2
69  mxtop=maxwv+1
70  mdim=2*mx+1
71  idim=2*maxwv+3
72  kw=kwskip
73  kg=kgskip
74  nr=nrskip
75  ng=ngskip
76  IF(kw.EQ.0) kw=2*mx
77  IF(kg.EQ.0) kg=nmax
78  IF(nr.EQ.0) nr=1
79  IF(ng.EQ.0) ng=1
80  mp=1
81 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
82 C CALCULATE SPECTRAL WINDS
83 C$OMP PARALLEL DO PRIVATE(KWS)
84  DO k=1,kmax
85  kws=(k-1)*kw
86  CALL spdz2uv(iromb,maxwv,enn1,elonn1,eon,eontop,
87  & waved(kws+1),wavez(kws+1),
88  & w(1,k),w(1,kmax+k),wtop(1,k),wtop(1,kmax+k))
89  ENDDO
90 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
91 C CALCULATE STATION FIELDS
92 C$OMP PARALLEL DO PRIVATE(KU,KV,RADLAT,SLAT1,CLAT1)
93 C$OMP& PRIVATE(PLN,PLNTOP,F,G,NK)
94  DO n=1,nmax
95  radlat=pi/180*rlat((n-1)*nr+1)
96  IF(rlat((n-1)*nr+1).GE.89.9995) THEN
97  slat1=1.
98  clat1=0.
99  ELSEIF(rlat((n-1)*nr+1).LE.-89.9995) THEN
100  slat1=-1.
101  clat1=0.
102  ELSE
103  slat1=sin(radlat)
104  clat1=cos(radlat)
105  ENDIF
106  CALL splegend(iromb,maxwv,slat1,clat1,eps,epstop,
107  & pln,plntop)
108  CALL spsynth(iromb,maxwv,2*maxwv,idim,mdim,2*mxtop,2*kmax,
109  & clat1,pln,plntop,mp,w,wtop,f)
110  CALL spfftpt(maxwv,1,2*maxwv+3,1,2*kmax,rlon((n-1)*nr+1),f,g)
111  DO k=1,kmax
112  ku=k
113  kv=k+kmax
114  nk=(n-1)*ng+(k-1)*kg+1
115  up(nk)=g(ku)
116  vp(nk)=g(kv)
117  ENDDO
118  ENDDO
119 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
120  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
sptgptv
subroutine sptgptv(IROMB, MAXWV, KMAX, NMAX, KWSKIP, KGSKIP, NRSKIP, NGSKIP, RLAT, RLON, WAVED, WAVEZ, UP, VP)
THIS SUBPROGRAM PERFORMS A SPHERICAL TRANSFORM FROM SPECTRAL COEFFICIENTS OF DIVERGENCES AND CURLS TO...
Definition: sptgptv.f:52
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
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