NCEPLIBS-sp  2.3.3
sptrunmv.f
Go to the documentation of this file.
1 C> @file
2 C>
3 C> Spectrally interpolate vectors to mercator
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 MERCATOR GRID.
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 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 MI - INTEGER NUMBER OF POINTS IN THE FASTER ZONAL DIRECTION
32 C> @param MJ - INTEGER NUMBER OF POINTS IN THE SLOWER MERID DIRECTION
33 C> @param IPRIME - INTEGER INPUT LONGITUDE INDEX FOR THE PRIME MERIDIAN.
34 C> (DEFAULTS TO 1 IF IPRIME=0)
35 C> (OUTPUT LONGITUDE INDEX FOR PRIME MERIDIAN ASSUMED 1.)
36 C> @param ISKIPI - INTEGER SKIP NUMBER BETWEEN INPUT LONGITUDES
37 C> (DEFAULTS TO 1 IF ISKIPI=0)
38 C> @param JSKIPI - INTEGER SKIP NUMBER BETWEEN INPUT LATITUDES FROM SOUTH
39 C> (DEFAULTS TO -IMAXI IF JSKIPI=0)
40 C> @param KSKIPI - INTEGER SKIP NUMBER BETWEEN INPUT GRID FIELDS
41 C> (DEFAULTS TO IMAXI*JMAXI IF KSKIPI=0)
42 C> @param KGSKIP - INTEGER SKIP NUMBER BETWEEN GRID FIELDS
43 C> (DEFAULTS TO MI*MJ IF KGSKIP=0)
44 C> @param NISKIP - INTEGER SKIP NUMBER BETWEEN GRID I-POINTS
45 C> (DEFAULTS TO 1 IF NISKIP=0)
46 C> @param NJSKIP - INTEGER SKIP NUMBER BETWEEN GRID J-POINTS
47 C> (DEFAULTS TO MI IF NJSKIP=0)
48 C> @param JCPU - INTEGER NUMBER OF CPUS OVER WHICH TO MULTIPROCESS
49 C> (DEFAULTS TO ENVIRONMENT NCPUS IF JCPU=0)
50 C> @param RLAT1 - REAL LATITUDE OF THE FIRST GRID POINT IN DEGREES
51 C> @param RLON1 - REAL LONGITUDE OF THE FIRST GRID POINT IN DEGREES
52 C> @param DLAT - REAL LATITUDE INCREMENT IN DEGREES SUCH THAT
53 C> D(PHI)/D(J)=DLAT*COS(PHI) WHERE J IS MERIDIONAL INDEX.
54 C> DLAT IS NEGATIVE FOR GRIDS INDEXED SOUTHWARD.
55 C> (IN TERMS OF GRID INCREMENT DY VALID AT LATITUDE RLATI,
56 C> THE LATITUDE INCREMENT DLAT IS DETERMINED AS
57 C> DLAT=DPR*DY/(RERTH*COS(RLATI/DPR))
58 C> WHERE DPR=180/PI AND RERTH IS EARTH'S RADIUS)
59 C> @param DLON - REAL LONGITUDE INCREMENT IN DEGREES SUCH THAT
60 C> D(LAMBDA)/D(I)=DLON WHERE I IS ZONAL INDEX.
61 C> DLON IS NEGATIVE FOR GRIDS INDEXED WESTWARD.
62 C> @param GRIDUI - REAL (*) INPUT GRID U-WINDS
63 C> @param GRIDVI - REAL (*) INPUT GRID V-WINDS
64 C> @param LUV - LOGICAL FLAG WHETHER TO RETURN WINDS
65 C> @param LDZ - LOGICAL FLAG WHETHER TO RETURN DIVERGENCE AND VORTICITY
66 C> @param LPS - LOGICAL FLAG WHETHER TO RETURN POTENTIAL AND STREAMFCN
67 C> @param UM - REAL (*) MERCATOR U-WINDS IF LUV
68 C> @param VM - REAL (*) MERCATOR V-WINDS IF LUV
69 C> @param DM - REAL (*) MERCATOR DIVERGENCES IF LDZ
70 C> @param ZM - REAL (*) MERCATOR VORTICITIES IF LDZ
71 C> @param PM - REAL (*) MERCATOR POTENTIALS IF LPS
72 C> @param SM - REAL (*) MERCATOR STREAMFCNS IF LPS
73 C>
74 C> SUBPROGRAMS CALLED:
75 C> - SPWGET GET WAVE-SPACE CONSTANTS
76 C> - SPLAPLAC COMPUTE LAPLACIAN IN SPECTRAL SPACE
77 C> - SPTRANV PERFORM A VECTOR SPHERICAL TRANSFORM
78 C> - SPTGPM TRANSFORM SPECTRAL SCALAR TO MERCATOR
79 C> - SPTGPMV TRANSFORM SPECTRAL VECTOR TO MERCATOR
80 C> - NCPUS GETS ENVIRONMENT NUMBER OF CPUS
81 C>
82 C> REMARKS: MINIMUM GRID DIMENSIONS FOR UNALIASED TRANSFORMS TO SPECTRAL:
83 C> DIMENSION |LINEAR |QUADRATIC
84 C> ----------------------- |--------- |-------------
85 C> IMAX |2*MAXWV+2 |3*MAXWV/2*2+2
86 C> JMAX (IDRT=4,IROMB=0) |1*MAXWV+1 |3*MAXWV/2+1
87 C> JMAX (IDRT=4,IROMB=1) |2*MAXWV+1 |5*MAXWV/2+1
88 C> JMAX (IDRT=0,IROMB=0) |2*MAXWV+3 |3*MAXWV/2*2+3
89 C> JMAX (IDRT=0,IROMB=1) |4*MAXWV+3 |5*MAXWV/2*2+3
90 C> JMAX (IDRT=256,IROMB=0) |2*MAXWV+1 |3*MAXWV/2*2+1
91 C> JMAX (IDRT=256,IROMB=1) |4*MAXWV+1 |5*MAXWV/2*2+1
92  SUBROUTINE sptrunmv(IROMB,MAXWV,IDRTI,IMAXI,JMAXI,KMAX,MI,MJ,
93  & IPRIME,ISKIPI,JSKIPI,KSKIPI,KGSKIP,
94  & NISKIP,NJSKIP,JCPU,RLAT1,RLON1,DLAT,DLON,
95  & GRIDUI,GRIDVI,LUV,UM,VM,LDZ,DM,ZM,LPS,PM,SM)
96 
97  LOGICAL LUV,LDZ,LPS
98  REAL GRIDUI(*),GRIDVI(*)
99  REAL UM(*),VM(*),DM(*),ZM(*),PM(*),SM(*)
100  REAL W((MAXWV+1)*((IROMB+1)*MAXWV+2)/2*2+1,KMAX)
101  REAL EPS((MAXWV+1)*((IROMB+1)*MAXWV+2)/2),EPSTOP(MAXWV+1)
102  REAL ENN1((MAXWV+1)*((IROMB+1)*MAXWV+2)/2)
103  REAL ELONN1((MAXWV+1)*((IROMB+1)*MAXWV+2)/2)
104  REAL EON((MAXWV+1)*((IROMB+1)*MAXWV+2)/2),EONTOP(MAXWV+1)
105  REAL WD((MAXWV+1)*((IROMB+1)*MAXWV+2)/2*2+1,KMAX)
106  REAL WZ((MAXWV+1)*((IROMB+1)*MAXWV+2)/2*2+1,KMAX)
107 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
108 C TRANSFORM INPUT GRID TO WAVE
109  jc=jcpu
110  IF(jc.EQ.0) jc=ncpus()
111  mx=(maxwv+1)*((iromb+1)*maxwv+2)/2
112  mdim=2*mx+1
113  jn=-jskipi
114  IF(jn.EQ.0) jn=imaxi
115  js=-jn
116  inp=(jmaxi-1)*max(0,-jn)+1
117  isp=(jmaxi-1)*max(0,-js)+1
118  CALL sptranv(iromb,maxwv,idrti,imaxi,jmaxi,kmax,
119  & iprime,iskipi,jn,js,mdim,kskipi,0,0,jc,
120  & wd,wz,
121  & gridui(inp),gridui(isp),gridvi(inp),gridvi(isp),-1)
122 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
123 C TRANSFORM WAVE TO OUTPUT WINDS
124  IF(luv) THEN
125  CALL sptgpmv(iromb,maxwv,kmax,mi,mj,mdim,kgskip,niskip,njskip,
126  & rlat1,rlon1,dlat,dlon,wd,wz,um,vm)
127  ENDIF
128 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
129 C TRANSFORM WAVE TO OUTPUT DIVERGENCE AND VORTICITY
130  IF(ldz) THEN
131  CALL sptgpm(iromb,maxwv,kmax,mi,mj,mdim,kgskip,niskip,njskip,
132  & rlat1,rlon1,dlat,dlon,wd,dm)
133  CALL sptgpm(iromb,maxwv,kmax,mi,mj,mdim,kgskip,niskip,njskip,
134  & rlat1,rlon1,dlat,dlon,wz,zm)
135  ENDIF
136 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
137 C TRANSFORM WAVE TO OUTPUT POTENTIAL AND STREAMFUNCTION
138  IF(lps) THEN
139  CALL spwget(iromb,maxwv,eps,epstop,enn1,elonn1,eon,eontop)
140 C$OMP PARALLEL DO
141  DO k=1,kmax
142  CALL splaplac(iromb,maxwv,enn1,wd(1,k),wd(1,k),-1)
143  CALL splaplac(iromb,maxwv,enn1,wz(1,k),wz(1,k),-1)
144  wd(1:2,k)=0.
145  wz(1:2,k)=0.
146  ENDDO
147  CALL sptgpm(iromb,maxwv,kmax,mi,mj,mdim,kgskip,niskip,njskip,
148  & rlat1,rlon1,dlat,dlon,wd,pm)
149  CALL sptgpm(iromb,maxwv,kmax,mi,mj,mdim,kgskip,niskip,njskip,
150  & rlat1,rlon1,dlat,dlon,wz,sm)
151  ENDIF
152 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
153  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
sptgpm
subroutine sptgpm(IROMB, MAXWV, KMAX, MI, MJ, KWSKIP, KGSKIP, NISKIP, NJSKIP, RLAT1, RLON1, DLAT, DLON, WAVE, GM)
This subprogram performs a spherical transform from spectral coefficients of scalar quantities to sca...
Definition: sptgpm.f:59
sptgpmv
subroutine sptgpmv(IROMB, MAXWV, KMAX, MI, MJ, KWSKIP, KGSKIP, NISKIP, NJSKIP, RLAT1, RLON1, DLAT, DLON, WAVED, WAVEZ, UM, VM)
THIS SUBPROGRAM PERFORMS A SPHERICAL TRANSFORM FROM SPECTRAL COEFFICIENTS OF DIVERGENCES AND CURLS TO...
Definition: sptgpmv.f:62
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
sptrunmv
subroutine sptrunmv(IROMB, MAXWV, IDRTI, IMAXI, JMAXI, KMAX, MI, MJ, IPRIME, ISKIPI, JSKIPI, KSKIPI, KGSKIP, NISKIP, NJSKIP, JCPU, RLAT1, RLON1, DLAT, DLON, GRIDUI, GRIDVI, LUV, UM, VM, LDZ, DM, ZM, LPS, PM, SM)
THIS SUBPROGRAM SPECTRALLY TRUNCATES VECTOR FIELDS ON A GLOBAL CYLINDRICAL GRID, RETURNING THE FIELDS...
Definition: sptrunmv.f:96