NCEPLIBS-sp  2.3.3
sptrungv.f
Go to the documentation of this file.
1 C> @file
2 C>
3 C> Spectrally interpolate vectors to stations
4 C> @author IREDELL @date 96-02-29
5 
6 C> THIS SUBPROGRAM SPECTRALLY TRUNCATES VECTORS FIELDS
7 C> ON A GLOBAL CYLINDRICAL GRID, RETURNING THE FIELDS
8 C> TO SPECIFIED SETS OF STATION POINTS ON THE GLOBE.
9 C> THE WAVE-SPACE CAN BE EITHER TRIANGULAR OR RHOMBOIDAL.
10 C> THE GRID-SPACE CAN BE EITHER AN EQUALLY-SPACED GRID
11 C> (WITH OR WITHOUT POLE POINTS) OR A GAUSSIAN GRID.
12 C> THE GRID AND POINT FIELDS MAY HAVE GENERAL INDEXING.
13 C> THE TRANSFORMS ARE ALL MULTIPROCESSED.
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>
21 C> @param IROMB - INTEGER SPECTRAL DOMAIN SHAPE
22 C> (0 FOR TRIANGULAR, 1 FOR RHOMBOIDAL)
23 C> @param MAXWV - INTEGER SPECTRAL TRUNCATION
24 C> @param IDRTI - INTEGER INPUT GRID IDENTIFIER
25 C> (IDRTI=4 FOR GAUSSIAN GRID,
26 C> IDRTI=0 FOR EQUALLY-SPACED GRID INCLUDING POLES,
27 C> IDRTI=256 FOR EQUALLY-SPACED GRID EXCLUDING POLES)
28 C> @param IMAXI - INTEGER EVEN NUMBER OF INPUT LONGITUDES.
29 C> @param JMAXI - INTEGER NUMBER OF INPUT LATITUDES.
30 C> @param KMAX - INTEGER NUMBER OF FIELDS TO TRANSFORM.
31 C> @param NMAX - INTEGER NUMBER OF STATION POINTS TO RETURN
32 C> @param IPRIME - INTEGER INPUT LONGITUDE INDEX FOR THE PRIME MERIDIAN.
33 C> (DEFAULTS TO 1 IF IPRIME=0)
34 C> (OUTPUT LONGITUDE INDEX FOR PRIME MERIDIAN ASSUMED 1.)
35 C> @param ISKIPI - INTEGER SKIP NUMBER BETWEEN INPUT LONGITUDES
36 C> (DEFAULTS TO 1 IF ISKIPI=0)
37 C> @param JSKIPI - INTEGER SKIP NUMBER BETWEEN INPUT LATITUDES FROM SOUTH
38 C> (DEFAULTS TO -IMAXI IF JSKIPI=0)
39 C> @param KSKIPI - INTEGER SKIP NUMBER BETWEEN INPUT GRID FIELDS
40 C> (DEFAULTS TO IMAXI*JMAXI IF KSKIPI=0)
41 C> @param KGSKIP - INTEGER SKIP NUMBER BETWEEN STATION POINT SETS
42 C> (DEFAULTS TO NMAX IF KGSKIP=0)
43 C> @param NRSKIP - INTEGER SKIP NUMBER BETWEEN STATION LATS AND LONS
44 C> (DEFAULTS TO 1 IF NRSKIP=0)
45 C> @param NGSKIP - INTEGER SKIP NUMBER BETWEEN STATION POINTS
46 C> (DEFAULTS TO 1 IF NGSKIP=0)
47 C> @param RLAT - REAL (*) STATION LATITUDES IN DEGREES
48 C> @param RLON - REAL (*) STATION LONGITUDES IN DEGREES
49 C> @param JCPU - INTEGER NUMBER OF CPUS OVER WHICH TO MULTIPROCESS
50 C> (DEFAULTS TO ENVIRONMENT NCPUS IF JCPU=0)
51 C> @param GRIDUI - REAL (*) INPUT GRID U-WINDS
52 C> @param GRIDVI - REAL (*) INPUT GRID V-WINDS
53 C> @param LUV - LOGICAL FLAG WHETHER TO RETURN WINDS
54 C> @param LDZ - LOGICAL FLAG WHETHER TO RETURN DIVERGENCE AND VORTICITY
55 C> @param LPS - LOGICAL FLAG WHETHER TO RETURN POTENTIAL AND STREAMFCN
56 C> @param UP - REAL (*) STATION U-WINDS IF LUV
57 C> @param VP - REAL (*) STATION V-WINDS IF LUV
58 C> @param DP - REAL (*) STATION DIVERGENCES IF LDZ
59 C> @param ZP - REAL (*) STATION VORTICITIES IF LDZ
60 C> @param PP - REAL (*) STATION POTENTIALS IF LPS
61 C> @param SP - REAL (*) STATION STREAMFCNS IF LPS
62 C>
63 C> SUBPROGRAMS CALLED:
64 C> - SPWGET GET WAVE-SPACE CONSTANTS
65 C> - SPLAPLAC COMPUTE LAPLACIAN IN SPECTRAL SPACE
66 C> - SPTRANV PERFORM A VECTOR SPHERICAL TRANSFORM
67 C> - SPTGPT TRANSFORM SPECTRAL SCALAR TO STATION POINTS
68 C> - SPTGPTV TRANSFORM SPECTRAL VECTOR TO STATION POINTS
69 C> - NCPUS GETS ENVIRONMENT NUMBER OF CPUS
70 C>
71 C> REMARKS: MINIMUM GRID DIMENSIONS FOR UNALIASED TRANSFORMS TO SPECTRAL:
72 C> DIMENSION |LINEAR |QUADRATIC
73 C> ----------------------- |--------- |-------------
74 C> IMAX |2*MAXWV+2 |3*MAXWV/2*2+2
75 C> JMAX (IDRT=4,IROMB=0) |1*MAXWV+1 |3*MAXWV/2+1
76 C> JMAX (IDRT=4,IROMB=1) |2*MAXWV+1 |5*MAXWV/2+1
77 C> JMAX (IDRT=0,IROMB=0) |2*MAXWV+3 |3*MAXWV/2*2+3
78 C> JMAX (IDRT=0,IROMB=1) |4*MAXWV+3 |5*MAXWV/2*2+3
79 C> JMAX (IDRT=256,IROMB=0) |2*MAXWV+1 |3*MAXWV/2*2+1
80 C> JMAX (IDRT=256,IROMB=1) |4*MAXWV+1 |5*MAXWV/2*2+1
81  SUBROUTINE sptrungv(IROMB,MAXWV,IDRTI,IMAXI,JMAXI,KMAX,NMAX,
82  & IPRIME,ISKIPI,JSKIPI,KSKIPI,KGSKIP,
83  & NRSKIP,NGSKIP,JCPU,RLAT,RLON,GRIDUI,GRIDVI,
84  & LUV,UP,VP,LDZ,DP,ZP,LPS,PP,SP)
85 
86  LOGICAL LUV,LDZ,LPS
87  REAL RLAT(*),RLON(*),GRIDUI(*),GRIDVI(*)
88  REAL UP(*),VP(*),DP(*),ZP(*),PP(*),SP(*)
89  REAL EPS((MAXWV+1)*((IROMB+1)*MAXWV+2)/2),EPSTOP(MAXWV+1)
90  REAL ENN1((MAXWV+1)*((IROMB+1)*MAXWV+2)/2)
91  REAL ELONN1((MAXWV+1)*((IROMB+1)*MAXWV+2)/2)
92  REAL EON((MAXWV+1)*((IROMB+1)*MAXWV+2)/2),EONTOP(MAXWV+1)
93  REAL WD((MAXWV+1)*((IROMB+1)*MAXWV+2)/2*2+1,KMAX)
94  REAL WZ((MAXWV+1)*((IROMB+1)*MAXWV+2)/2*2+1,KMAX)
95 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
96 C TRANSFORM INPUT GRID TO WAVE
97  jc=jcpu
98  IF(jc.EQ.0) jc=ncpus()
99  mx=(maxwv+1)*((iromb+1)*maxwv+2)/2
100  mdim=2*mx+1
101  jn=-jskipi
102  IF(jn.EQ.0) jn=imaxi
103  js=-jn
104  inp=(jmaxi-1)*max(0,-jn)+1
105  isp=(jmaxi-1)*max(0,-js)+1
106  CALL sptranv(iromb,maxwv,idrti,imaxi,jmaxi,kmax,
107  & iprime,iskipi,jn,js,mdim,kskipi,0,0,jc,
108  & wd,wz,
109  & gridui(inp),gridui(isp),gridvi(inp),gridvi(isp),-1)
110 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
111 C TRANSFORM WAVE TO OUTPUT WINDS
112  IF(luv) THEN
113  CALL sptgptv(iromb,maxwv,kmax,nmax,mdim,kgskip,nrskip,ngskip,
114  & rlat,rlon,wd,wz,up,vp)
115  ENDIF
116 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
117 C TRANSFORM WAVE TO OUTPUT DIVERGENCE AND VORTICITY
118  IF(ldz) THEN
119  CALL sptgpt(iromb,maxwv,kmax,nmax,mdim,kgskip,nrskip,ngskip,
120  & rlat,rlon,wd,dp)
121  CALL sptgpt(iromb,maxwv,kmax,nmax,mdim,kgskip,nrskip,ngskip,
122  & rlat,rlon,wz,zp)
123  ENDIF
124 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
125 C TRANSFORM WAVE TO OUTPUT POTENTIAL AND STREAMFUNCTION
126  IF(lps) THEN
127  CALL spwget(iromb,maxwv,eps,epstop,enn1,elonn1,eon,eontop)
128 C$OMP PARALLEL DO
129  DO k=1,kmax
130  CALL splaplac(iromb,maxwv,enn1,wd(1,k),wd(1,k),-1)
131  CALL splaplac(iromb,maxwv,enn1,wz(1,k),wz(1,k),-1)
132  wd(1:2,k)=0.
133  wz(1:2,k)=0.
134  ENDDO
135  CALL sptgpt(iromb,maxwv,kmax,nmax,mdim,kgskip,nrskip,ngskip,
136  & rlat,rlon,wd,pp)
137  CALL sptgpt(iromb,maxwv,kmax,nmax,mdim,kgskip,nrskip,ngskip,
138  & rlat,rlon,wz,sp)
139  ENDIF
140 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
141  END
spwget
subroutine spwget(IROMB, MAXWV, EPS, EPSTOP, ENN1, ELONN1, EON, EONTOP)
This subprogram gets wave-space constants.
Definition: spwget.f:22
splaplac
subroutine splaplac(I, M, ENN1, Q, QD2, IDIR)
COMPUTES THE LAPLACIAN OR THE INVERSE LAPLACIAN OF A SCALAR FIELD IN SPECTRAL SPACE.
Definition: splaplac.f:22
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
ncpus
function ncpus()
Set number of cpus.
Definition: ncpus.F:21
sptrungv
subroutine sptrungv(IROMB, MAXWV, IDRTI, IMAXI, JMAXI, KMAX, NMAX, IPRIME, ISKIPI, JSKIPI, KSKIPI, KGSKIP, NRSKIP, NGSKIP, JCPU, RLAT, RLON, GRIDUI, GRIDVI, LUV, UP, VP, LDZ, DP, ZP, LPS, PP, SP)
THIS SUBPROGRAM SPECTRALLY TRUNCATES VECTORS FIELDS ON A GLOBAL CYLINDRICAL GRID, RETURNING THE FIELD...
Definition: sptrungv.f:85
sptranv
subroutine sptranv(IROMB, MAXWV, IDRT, IMAX, JMAX, KMAX, IPRIME, ISKIP, JNSKIP, JSSKIP, KWSKIP, KGSKIP, JBEG, JEND, JCPU, WAVED, WAVEZ, GRIDUN, GRIDUS, GRIDVN, GRIDVS, IDIR)
THIS SUBPROGRAM PERFORMS A SPHERICAL TRANSFORM BETWEEN SPECTRAL COEFFICIENTS OF DIVERGENCES AND CURLS...
Definition: sptranv.f:85
sptgpt
subroutine sptgpt(IROMB, MAXWV, KMAX, NMAX, KWSKIP, KGSKIP, NRSKIP, NGSKIP, RLAT, RLON, WAVE, GP)
This subprogram performs a spherical transform from spectral coefficients of scalar quantities to spe...
Definition: sptgpt.f:48