NCEPLIBS-sp  2.3.3
sptrunv.f
Go to the documentation of this file.
1 C> @file
2 C>
3 C> Spectrally truncate gridded vector fields
4 C> @author IREDELL @date 96-02-29
5 
6 C> This subprogram spectrally truncates vector fields
7 C> on a global cylindrical grid, returning the fields
8 C> to a possibly different global cylindrical grid.
9 C> The wave-space can be either triangular or rhomboidal.
10 C> Either grid-space can be either an equally-spaced grid
11 C> (with or without pole points) or a gaussian grid.
12 C> The grid fields may have general indexing.
13 C> The transforms are all multiprocessed.
14 C> Over zonal wavenumber to ensure reproducibility.
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>
22 C> @param IROMB - INTEGER SPECTRAL DOMAIN SHAPE
23 C> (0 FOR TRIANGULAR, 1 FOR RHOMBOIDAL)
24 C> @param MAXWV - INTEGER SPECTRAL TRUNCATION
25 C> @param IDRTI - INTEGER INPUT GRID IDENTIFIER
26 C> (IDRTI=4 FOR GAUSSIAN GRID,
27 C> IDRTI=0 FOR EQUALLY-SPACED GRID INCLUDING POLES,
28 C> IDRTI=256 FOR EQUALLY-SPACED GRID EXCLUDING POLES)
29 C> @param IMAXI - INTEGER EVEN NUMBER OF INPUT LONGITUDES.
30 C> @param JMAXI - INTEGER NUMBER OF INPUT LATITUDES.
31 C> @param IDRTO - INTEGER OUTPUT GRID IDENTIFIER
32 C> (IDRTO=4 FOR GAUSSIAN GRID,
33 C> IDRTO=0 FOR EQUALLY-SPACED GRID INCLUDING POLES,
34 C> IDRTO=256 FOR EQUALLY-SPACED GRID EXCLUDING POLES)
35 C> @param IMAXO - INTEGER EVEN NUMBER OF OUTPUT LONGITUDES.
36 C> @param JMAXO - INTEGER NUMBER OF OUTPUT LATITUDES.
37 C> @param KMAX - INTEGER NUMBER OF FIELDS TO TRANSFORM.
38 C> @param IPRIME - INTEGER INPUT LONGITUDE INDEX FOR THE PRIME MERIDIAN.
39 C> (DEFAULTS TO 1 IF IPRIME=0)
40 C> (OUTPUT LONGITUDE INDEX FOR PRIME MERIDIAN ASSUMED 1.)
41 C> @param ISKIPI - INTEGER SKIP NUMBER BETWEEN INPUT LONGITUDES
42 C> (DEFAULTS TO 1 IF ISKIPI=0)
43 C> @param JSKIPI - INTEGER SKIP NUMBER BETWEEN INPUT LATITUDES FROM SOUTH
44 C> (DEFAULTS TO -IMAXI IF JSKIPI=0)
45 C> @param KSKIPI - INTEGER SKIP NUMBER BETWEEN INPUT GRID FIELDS
46 C> (DEFAULTS TO IMAXI*JMAXI IF KSKIPI=0)
47 C> @param ISKIPO - INTEGER SKIP NUMBER BETWEEN OUTPUT LONGITUDES
48 C> (DEFAULTS TO 1 IF ISKIPO=0)
49 C> @param JSKIPO - INTEGER SKIP NUMBER BETWEEN OUTPUT LATITUDES FROM SOUTH
50 C> (DEFAULTS TO -IMAXO IF JSKIPO=0)
51 C> @param KSKIPO - INTEGER SKIP NUMBER BETWEEN OUTPUT GRID FIELDS
52 C> (DEFAULTS TO IMAXO*JMAXO IF KSKIPO=0)
53 C> @param JCPU - INTEGER NUMBER OF CPUS OVER WHICH TO MULTIPROCESS
54 C> (DEFAULTS TO ENVIRONMENT NCPUS IF JCPU=0)
55 C> @param GRIDUI - REAL (*) INPUT GRID U-WINDS
56 C> @param GRIDVI - REAL (*) INPUT GRID V-WINDS
57 C> @param LUV - LOGICAL FLAG WHETHER TO RETURN WINDS
58 C> @param LDZ - LOGICAL FLAG WHETHER TO RETURN DIVERGENCE AND VORTICITY
59 C> @param LPS - LOGICAL FLAG WHETHER TO RETURN POTENTIAL AND STREAMFCN
60 C> @param GRIDUO - REAL (*) OUTPUT U-WINDS IF LUV
61 C> (MAY OVERLAY INPUT FIELDS IF GRID SHAPE IS APPROPRIATE)
62 C> @param GRIDVO - REAL (*) OUTPUT V-WINDS IF LUV
63 C> (MAY OVERLAY INPUT FIELDS IF GRID SHAPE IS APPROPRIATE)
64 C> @param GRIDDO - REAL (*) OUTPUT DIVERGENCES IF LDZ
65 C> (MAY OVERLAY INPUT FIELDS IF GRID SHAPE IS APPROPRIATE)
66 C> @param GRIDZO - REAL (*) OUTPUT VORTICITIES IF LDZ
67 C> (MAY OVERLAY INPUT FIELDS IF GRID SHAPE IS APPROPRIATE)
68 C> @param GRIDPO - REAL (*) OUTPUT POTENTIALS IF LPS
69 C> (MAY OVERLAY INPUT FIELDS IF GRID SHAPE IS APPROPRIATE)
70 C> @param GRIDSO - REAL (*) OUTPUT STREAMFCNS IF LPS
71 C> (MAY OVERLAY INPUT FIELDS IF GRID SHAPE IS APPROPRIATE)
72 C>
73 C> SUBPROGRAMS CALLED:
74 C> - SPWGET() GET WAVE-SPACE CONSTANTS
75 C> - SPLAPLAC() COMPUTE LAPLACIAN IN SPECTRAL SPACE
76 C> - SPTRAN() PERFORM A SCALAR SPHERICAL TRANSFORM
77 C> - SPTRANV() PERFORM A VECTOR SPHERICAL TRANSFORM
78 C> - NCPUS() GETS ENVIRONMENT NUMBER OF CPUS
79 C>
80 C> REMARKS: MINIMUM GRID DIMENSIONS FOR UNALIASED TRANSFORMS TO SPECTRAL:
81 C> DIMENSION |LINEAR |QUADRATIC
82 C> ----------------------- |--------- |-------------
83 C> IMAX |2*MAXWV+2 |3*MAXWV/2*2+2
84 C> JMAX (IDRT=4,IROMB=0) |1*MAXWV+1 |3*MAXWV/2+1
85 C> JMAX (IDRT=4,IROMB=1) |2*MAXWV+1 |5*MAXWV/2+1
86 C> JMAX (IDRT=0,IROMB=0) |2*MAXWV+3 |3*MAXWV/2*2+3
87 C> JMAX (IDRT=0,IROMB=1) |4*MAXWV+3 |5*MAXWV/2*2+3
88 C> JMAX (IDRT=256,IROMB=0) |2*MAXWV+1 |3*MAXWV/2*2+1
89 C> JMAX (IDRT=256,IROMB=1) |4*MAXWV+1 |5*MAXWV/2*2+1
90  SUBROUTINE sptrunv(IROMB,MAXWV,IDRTI,IMAXI,JMAXI,
91  & IDRTO,IMAXO,JMAXO,KMAX,
92  & IPRIME,ISKIPI,JSKIPI,KSKIPI,
93  & ISKIPO,JSKIPO,KSKIPO,JCPU,GRIDUI,GRIDVI,
94  & LUV,GRIDUO,GRIDVO,LDZ,GRIDDO,GRIDZO,
95  & LPS,GRIDPO,GRIDSO)
96  LOGICAL LUV,LDZ,LPS
97  REAL GRIDUI(*),GRIDVI(*)
98  REAL GRIDUO(*),GRIDVO(*),GRIDDO(*),GRIDZO(*),GRIDPO(*),GRIDSO(*)
99  REAL EPS((MAXWV+1)*((IROMB+1)*MAXWV+2)/2),EPSTOP(MAXWV+1)
100  REAL ENN1((MAXWV+1)*((IROMB+1)*MAXWV+2)/2)
101  REAL ELONN1((MAXWV+1)*((IROMB+1)*MAXWV+2)/2)
102  REAL EON((MAXWV+1)*((IROMB+1)*MAXWV+2)/2),EONTOP(MAXWV+1)
103  REAL WD((MAXWV+1)*((IROMB+1)*MAXWV+2)/2*2+1,KMAX)
104  REAL WZ((MAXWV+1)*((IROMB+1)*MAXWV+2)/2*2+1,KMAX)
105 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
106 C TRANSFORM INPUT GRID TO WAVE
107  jc=jcpu
108  IF(jc.EQ.0) jc=ncpus()
109  mx=(maxwv+1)*((iromb+1)*maxwv+2)/2
110  mdim=2*mx+1
111  jn=-jskipi
112  IF(jn.EQ.0) jn=imaxi
113  js=-jn
114  inp=(jmaxi-1)*max(0,-jn)+1
115  isp=(jmaxi-1)*max(0,-js)+1
116  CALL sptranv(iromb,maxwv,idrti,imaxi,jmaxi,kmax,
117  & iprime,iskipi,jn,js,mdim,kskipi,0,0,jc,
118  & wd,wz,
119  & gridui(inp),gridui(isp),gridvi(inp),gridvi(isp),-1)
120 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
121 C TRANSFORM WAVE TO OUTPUT WINDS
122  jn=-jskipo
123  IF(jn.EQ.0) jn=imaxo
124  js=-jn
125  inp=(jmaxo-1)*max(0,-jn)+1
126  isp=(jmaxo-1)*max(0,-js)+1
127  IF(luv) THEN
128  CALL sptranv(iromb,maxwv,idrto,imaxo,jmaxo,kmax,
129  & 0,iskipo,jn,js,mdim,kskipo,0,0,jc,
130  & wd,wz,
131  & griduo(inp),griduo(isp),gridvo(inp),gridvo(isp),1)
132  ENDIF
133 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
134 C TRANSFORM WAVE TO OUTPUT DIVERGENCE AND VORTICITY
135  IF(ldz) THEN
136  CALL sptran(iromb,maxwv,idrto,imaxo,jmaxo,kmax,
137  & 0,iskipo,jn,js,mdim,kskipo,0,0,jc,
138  & wd,griddo(inp),griddo(isp),1)
139  CALL sptran(iromb,maxwv,idrto,imaxo,jmaxo,kmax,
140  & 0,iskipo,jn,js,mdim,kskipo,0,0,jc,
141  & wz,gridzo(inp),gridzo(isp),1)
142  ENDIF
143 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
144 C TRANSFORM WAVE TO OUTPUT POTENTIAL AND STREAMFUNCTION
145  IF(lps) THEN
146  CALL spwget(iromb,maxwv,eps,epstop,enn1,elonn1,eon,eontop)
147 C$OMP PARALLEL DO
148  DO k=1,kmax
149  CALL splaplac(iromb,maxwv,enn1,wd(1,k),wd(1,k),-1)
150  CALL splaplac(iromb,maxwv,enn1,wz(1,k),wz(1,k),-1)
151  wd(1:2,k)=0.
152  wz(1:2,k)=0.
153  ENDDO
154  CALL sptran(iromb,maxwv,idrto,imaxo,jmaxo,kmax,
155  & 0,iskipo,jn,js,mdim,kskipo,0,0,jc,
156  & wd,gridpo(inp),gridpo(isp),1)
157  CALL sptran(iromb,maxwv,idrto,imaxo,jmaxo,kmax,
158  & 0,iskipo,jn,js,mdim,kskipo,0,0,jc,
159  & wz,gridso(inp),gridso(isp),1)
160  ENDIF
161 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
162  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
sptran
subroutine sptran(IROMB, MAXWV, IDRT, IMAX, JMAX, KMAX, IPRIME, ISKIP, JNSKIP, JSSKIP, KWSKIP, KGSKIP, JBEG, JEND, JCPU, WAVE, GRIDN, GRIDS, IDIR)
This subprogram performs a spherical transform between spectral coefficients of scalar quantities and...
Definition: sptran.f:80
ncpus
function ncpus()
Set number of cpus.
Definition: ncpus.F:21
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
sptrunv
subroutine sptrunv(IROMB, MAXWV, IDRTI, IMAXI, JMAXI, IDRTO, IMAXO, JMAXO, KMAX, IPRIME, ISKIPI, JSKIPI, KSKIPI, ISKIPO, JSKIPO, KSKIPO, JCPU, GRIDUI, GRIDVI, LUV, GRIDUO, GRIDVO, LDZ, GRIDDO, GRIDZO, LPS, GRIDPO, GRIDSO)
This subprogram spectrally truncates vector fields on a global cylindrical grid, returning the fields...
Definition: sptrunv.f:96