NCEPLIBS-sp  2.3.3
sptgptsd.f
Go to the documentation of this file.
1 C> @file
2 C>
3 C> Transform spectral scalar 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 SCALAR QUANTITIES
8 C> TO SPECIFIED SETS OF STATION POINT VALUES
9 C> AND THEIR GRADIENTS ON THE GLOBE.
10 C> THE WAVE-SPACE CAN BE EITHER TRIANGULAR OR RHOMBOIDAL.
11 C> THE WAVE AND POINT FIELDS MAY HAVE GENERAL INDEXING,
12 C> BUT EACH WAVE FIELD IS IN SEQUENTIAL 'IBM ORDER',
13 C> I.E. WITH ZONAL WAVENUMBER AS THE SLOWER INDEX.
14 C> THE TRANSFORMS ARE ALL MULTIPROCESSED OVER STATIONS.
15 C> TRANSFORM SEVERAL FIELDS AT A TIME TO IMPROVE VECTORIZATION.
16 C> SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT.
17 C>
18 C> PROGRAM HISTORY LOG:
19 C> - 96-02-29 IREDELL
20 C> - 1998-12-15 IREDELL OPENMP DIRECTIVES INSERTED
21 C> - 1999-08-18 IREDELL OPENMP DIRECTIVE TYPO FIXED
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 WAVE - REAL (*) WAVE FIELDS
39 C> @param GP - REAL (*) STATION POINT SETS
40 C> @param XP - REAL (*) STATION POINT X-GRADIENT SETS
41 C> @param YP - REAL (*) STATION POINT Y-GRADIENT 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> - SPGRADY COMPUTE Y-GRADIENT IN SPECTRAL SPACE
48 C> - SPGRADX COMPUTE X-GRADIENT IN FOURIER SPACE
49 C> - SPFFTPT COMPUTE FOURIER TRANSFORM TO GRIDPOINTS
50  SUBROUTINE sptgptsd(IROMB,MAXWV,KMAX,NMAX,
51  & KWSKIP,KGSKIP,NRSKIP,NGSKIP,
52  & RLAT,RLON,WAVE,GP,XP,YP)
53 
54  REAL RLAT(*),RLON(*),WAVE(*)
55  REAL GP(*),XP(*),YP(*)
56  REAL EPS((MAXWV+1)*((IROMB+1)*MAXWV+2)/2),EPSTOP(MAXWV+1)
57  REAL ENN1((MAXWV+1)*((IROMB+1)*MAXWV+2)/2)
58  REAL ELONN1((MAXWV+1)*((IROMB+1)*MAXWV+2)/2)
59  REAL EON((MAXWV+1)*((IROMB+1)*MAXWV+2)/2),EONTOP(MAXWV+1)
60  INTEGER MP(2*KMAX)
61  REAL W((MAXWV+1)*((IROMB+1)*MAXWV+2)/2*2,2*KMAX)
62  REAL WTOP(2*(MAXWV+1),2*KMAX)
63  REAL PLN((MAXWV+1)*((IROMB+1)*MAXWV+2)/2),PLNTOP(MAXWV+1)
64  REAL F(2*MAXWV+2,2,3*KMAX),G(3*KMAX)
65  parameter(pi=3.14159265358979)
66 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
67 C CALCULATE PRELIMINARY CONSTANTS
68  CALL spwget(iromb,maxwv,eps,epstop,enn1,elonn1,eon,eontop)
69  mx=(maxwv+1)*((iromb+1)*maxwv+2)/2
70  mxtop=maxwv+1
71  mdim=2*mx
72  idim=2*maxwv+2
73  kw=kwskip
74  kg=kgskip
75  nr=nrskip
76  ng=ngskip
77  IF(kw.EQ.0) kw=2*mx
78  IF(kg.EQ.0) kg=nmax
79  IF(nr.EQ.0) nr=1
80  IF(ng.EQ.0) ng=1
81  mp(1:kmax)=10
82  mp(kmax+1:2*kmax)=1
83 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
84 C CALCULATE SPECTRAL WINDS
85 C$OMP PARALLEL DO PRIVATE(KWS,KS,KY)
86  DO k=1,kmax
87  kws=(k-1)*kw
88  ks=0*kmax+k
89  ky=1*kmax+k
90  DO i=1,2*mx
91  w(i,ks)=wave(kws+i)
92  ENDDO
93  DO i=1,2*mxtop
94  wtop(i,ks)=0
95  ENDDO
96  CALL spgrady(iromb,maxwv,enn1,eon,eontop,
97  & wave(kws+1),w(1,ky),wtop(1,ky))
98  ENDDO
99 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
100 C CALCULATE STATION FIELDS
101 C$OMP PARALLEL DO PRIVATE(KS,KY,KX,SLAT1,CLAT1)
102 C$OMP& PRIVATE(PLN,PLNTOP,F,G,NK)
103  DO n=1,nmax
104  IF(abs(rlat((n-1)*nr+1)).GE.89.9995) THEN
105  slat1=sign(1.,rlat((n-1)*nr+1))
106  clat1=0.
107  ELSE
108  slat1=sin(pi/180*rlat((n-1)*nr+1))
109  clat1=cos(pi/180*rlat((n-1)*nr+1))
110  ENDIF
111  CALL splegend(iromb,maxwv,slat1,clat1,eps,epstop,
112  & pln,plntop)
113  CALL spsynth(iromb,maxwv,2*maxwv,idim,mdim,2*mxtop,2*kmax,
114  & clat1,pln,plntop,mp,w,wtop,f)
115  CALL spgradx(maxwv,idim,kmax,mp,clat1,f(1,1,1),f(1,1,2*kmax+1))
116  CALL spfftpt(maxwv,1,idim,1,3*kmax,rlon((n-1)*nr+1),f,g)
117  DO k=1,kmax
118  ks=0*kmax+k
119  ky=1*kmax+k
120  kx=2*kmax+k
121  nk=(n-1)*ng+(k-1)*kg+1
122  gp(nk)=g(ks)
123  xp(nk)=g(kx)
124  yp(nk)=g(ky)
125  ENDDO
126  ENDDO
127 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
128  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
sptgptsd
subroutine sptgptsd(IROMB, MAXWV, KMAX, NMAX, KWSKIP, KGSKIP, NRSKIP, NGSKIP, RLAT, RLON, WAVE, GP, XP, YP)
THIS SUBPROGRAM PERFORMS A SPHERICAL TRANSFORM FROM SPECTRAL COEFFICIENTS OF SCALAR QUANTITIES TO SPE...
Definition: sptgptsd.f:53
spgrady
subroutine spgrady(I, M, ENN1, EON, EONTOP, Q, QDY, QDYTOP)
COMPUTES THE HORIZONTAL VECTOR Y-GRADIENT OF A SCALAR FIELD IN SPECTRAL SPACE.
Definition: spgrady.f:27
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