C-----------------------------------------------------------------------
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)
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: SPTRUNMV SPECTRALLY INTERPOLATE VECTORS TO MERCATOR
C PRGMMR: IREDELL ORG: W/NMC23 DATE: 96-02-29
C
C ABSTRACT: THIS SUBPROGRAM SPECTRALLY TRUNCATES VECTOR FIELDS
C ON A GLOBAL CYLINDRICAL GRID, RETURNING THE FIELDS
C TO A MERCATOR GRID.
C THE WAVE-SPACE CAN BE EITHER TRIANGULAR OR RHOMBOIDAL.
C THE GRID-SPACE CAN BE EITHER AN EQUALLY-SPACED GRID
C (WITH OR WITHOUT POLE POINTS) OR A GAUSSIAN GRID.
C THE GRID FIELDS MAY HAVE GENERAL INDEXING.
C THE TRANSFORMS ARE ALL MULTIPROCESSED.
C TRANSFORM SEVERAL FIELDS AT A TIME TO IMPROVE VECTORIZATION.
C SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT.
C
C PROGRAM HISTORY LOG:
C 96-02-29 IREDELL
C 1998-12-15 IREDELL OPENMP DIRECTIVES INSERTED
C
C USAGE: CALL SPTRUNMV(IROMB,MAXWV,IDRTI,IMAXI,JMAXI,KMAX,MI,MJ,
C & IPRIME,ISKIPI,JSKIPI,KSKIPI,KGSKIP,
C & NISKIP,NJSKIP,JCPU,RLAT1,RLON1,DLAT,DLON,
C & GRIDUI,GRIDVI,LUV,UM,VM,LDZ,DM,ZM,LPS,PM,SM)
C INPUT ARGUMENTS:
C IROMB - INTEGER SPECTRAL DOMAIN SHAPE
C (0 FOR TRIANGULAR, 1 FOR RHOMBOIDAL)
C MAXWV - INTEGER SPECTRAL TRUNCATION
C IDRTI - INTEGER INPUT GRID IDENTIFIER
C (IDRTI=4 FOR GAUSSIAN GRID,
C IDRTI=0 FOR EQUALLY-SPACED GRID INCLUDING POLES,
C IDRTI=256 FOR EQUALLY-SPACED GRID EXCLUDING POLES)
C IMAXI - INTEGER EVEN NUMBER OF INPUT LONGITUDES.
C JMAXI - INTEGER NUMBER OF INPUT LATITUDES.
C KMAX - INTEGER NUMBER OF FIELDS TO TRANSFORM.
C MI - INTEGER NUMBER OF POINTS IN THE FASTER ZONAL DIRECTION
C MJ - INTEGER NUMBER OF POINTS IN THE SLOWER MERID DIRECTION
C IPRIME - INTEGER INPUT LONGITUDE INDEX FOR THE PRIME MERIDIAN.
C (DEFAULTS TO 1 IF IPRIME=0)
C (OUTPUT LONGITUDE INDEX FOR PRIME MERIDIAN ASSUMED 1.)
C ISKIPI - INTEGER SKIP NUMBER BETWEEN INPUT LONGITUDES
C (DEFAULTS TO 1 IF ISKIPI=0)
C JSKIPI - INTEGER SKIP NUMBER BETWEEN INPUT LATITUDES FROM SOUTH
C (DEFAULTS TO -IMAXI IF JSKIPI=0)
C KSKIPI - INTEGER SKIP NUMBER BETWEEN INPUT GRID FIELDS
C (DEFAULTS TO IMAXI*JMAXI IF KSKIPI=0)
C KGSKIP - INTEGER SKIP NUMBER BETWEEN GRID FIELDS
C (DEFAULTS TO MI*MJ IF KGSKIP=0)
C NISKIP - INTEGER SKIP NUMBER BETWEEN GRID I-POINTS
C (DEFAULTS TO 1 IF NISKIP=0)
C NJSKIP - INTEGER SKIP NUMBER BETWEEN GRID J-POINTS
C (DEFAULTS TO MI IF NJSKIP=0)
C JCPU - INTEGER NUMBER OF CPUS OVER WHICH TO MULTIPROCESS
C (DEFAULTS TO ENVIRONMENT NCPUS IF JCPU=0)
C RLAT1 - REAL LATITUDE OF THE FIRST GRID POINT IN DEGREES
C RLON1 - REAL LONGITUDE OF THE FIRST GRID POINT IN DEGREES
C DLAT - REAL LATITUDE INCREMENT IN DEGREES SUCH THAT
C D(PHI)/D(J)=DLAT*COS(PHI) WHERE J IS MERIDIONAL INDEX.
C DLAT IS NEGATIVE FOR GRIDS INDEXED SOUTHWARD.
C (IN TERMS OF GRID INCREMENT DY VALID AT LATITUDE RLATI,
C THE LATITUDE INCREMENT DLAT IS DETERMINED AS
C DLAT=DPR*DY/(RERTH*COS(RLATI/DPR))
C WHERE DPR=180/PI AND RERTH IS EARTH'S RADIUS)
C DLON - REAL LONGITUDE INCREMENT IN DEGREES SUCH THAT
C D(LAMBDA)/D(I)=DLON WHERE I IS ZONAL INDEX.
C DLON IS NEGATIVE FOR GRIDS INDEXED WESTWARD.
C GRIDUI - REAL (*) INPUT GRID U-WINDS
C GRIDVI - REAL (*) INPUT GRID V-WINDS
C LUV - LOGICAL FLAG WHETHER TO RETURN WINDS
C LDZ - LOGICAL FLAG WHETHER TO RETURN DIVERGENCE AND VORTICITY
C LPS - LOGICAL FLAG WHETHER TO RETURN POTENTIAL AND STREAMFCN
C OUTPUT ARGUMENTS:
C UM - REAL (*) MERCATOR U-WINDS IF LUV
C VM - REAL (*) MERCATOR V-WINDS IF LUV
C DM - REAL (*) MERCATOR DIVERGENCES IF LDZ
C ZM - REAL (*) MERCATOR VORTICITIES IF LDZ
C PM - REAL (*) MERCATOR POTENTIALS IF LPS
C SM - REAL (*) MERCATOR STREAMFCNS IF LPS
C
C SUBPROGRAMS CALLED:
C SPWGET GET WAVE-SPACE CONSTANTS
C SPLAPLAC COMPUTE LAPLACIAN IN SPECTRAL SPACE
C SPTRANV PERFORM A VECTOR SPHERICAL TRANSFORM
C SPTGPM TRANSFORM SPECTRAL SCALAR TO MERCATOR
C SPTGPMV TRANSFORM SPECTRAL VECTOR TO MERCATOR
C NCPUS GETS ENVIRONMENT NUMBER OF CPUS
C
C REMARKS: MINIMUM GRID DIMENSIONS FOR UNALIASED TRANSFORMS TO SPECTRAL:
C DIMENSION LINEAR QUADRATIC
C ----------------------- --------- -------------
C IMAX 2*MAXWV+2 3*MAXWV/2*2+2
C JMAX (IDRT=4,IROMB=0) 1*MAXWV+1 3*MAXWV/2+1
C JMAX (IDRT=4,IROMB=1) 2*MAXWV+1 5*MAXWV/2+1
C JMAX (IDRT=0,IROMB=0) 2*MAXWV+3 3*MAXWV/2*2+3
C JMAX (IDRT=0,IROMB=1) 4*MAXWV+3 5*MAXWV/2*2+3
C JMAX (IDRT=256,IROMB=0) 2*MAXWV+1 3*MAXWV/2*2+1
C JMAX (IDRT=256,IROMB=1) 4*MAXWV+1 5*MAXWV/2*2+1
C ----------------------- --------- -------------
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 77
C
C$$$
LOGICAL LUV,LDZ,LPS
REAL GRIDUI(*),GRIDVI(*)
REAL UM(*),VM(*),DM(*),ZM(*),PM(*),SM(*)
REAL W((MAXWV+1)*((IROMB+1)*MAXWV+2)/2*2+1,KMAX)
REAL EPS((MAXWV+1)*((IROMB+1)*MAXWV+2)/2),EPSTOP(MAXWV+1)
REAL ENN1((MAXWV+1)*((IROMB+1)*MAXWV+2)/2)
REAL ELONN1((MAXWV+1)*((IROMB+1)*MAXWV+2)/2)
REAL EON((MAXWV+1)*((IROMB+1)*MAXWV+2)/2),EONTOP(MAXWV+1)
REAL WD((MAXWV+1)*((IROMB+1)*MAXWV+2)/2*2+1,KMAX)
REAL WZ((MAXWV+1)*((IROMB+1)*MAXWV+2)/2*2+1,KMAX)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C TRANSFORM INPUT GRID TO WAVE
JC=JCPU
IF(JC.EQ.0) JC=NCPUS()
MX=(MAXWV+1)*((IROMB+1)*MAXWV+2)/2
MDIM=2*MX+1
JN=-JSKIPI
IF(JN.EQ.0) JN=IMAXI
JS=-JN
INP=(JMAXI-1)*MAX(0,-JN)+1
ISP=(JMAXI-1)*MAX(0,-JS)+1
CALL SPTRANV(IROMB,MAXWV,IDRTI,IMAXI,JMAXI,KMAX,
& IPRIME,ISKIPI,JN,JS,MDIM,KSKIPI,0,0,JC,
& WD,WZ,
& GRIDUI(INP),GRIDUI(ISP),GRIDVI(INP),GRIDVI(ISP),-1)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C TRANSFORM WAVE TO OUTPUT WINDS
IF(LUV) THEN
CALL SPTGPMV(IROMB,MAXWV,KMAX,MI,MJ,MDIM,KGSKIP,NISKIP,NJSKIP,
& RLAT1,RLON1,DLAT,DLON,WD,WZ,UM,VM)
ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C TRANSFORM WAVE TO OUTPUT DIVERGENCE AND VORTICITY
IF(LDZ) THEN
CALL SPTGPM(IROMB,MAXWV,KMAX,MI,MJ,MDIM,KGSKIP,NISKIP,NJSKIP,
& RLAT1,RLON1,DLAT,DLON,WD,DM)
CALL SPTGPM(IROMB,MAXWV,KMAX,MI,MJ,MDIM,KGSKIP,NISKIP,NJSKIP,
& RLAT1,RLON1,DLAT,DLON,WZ,ZM)
ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C TRANSFORM WAVE TO OUTPUT POTENTIAL AND STREAMFUNCTION
IF(LPS) THEN
CALL SPWGET(IROMB,MAXWV,EPS,EPSTOP,ENN1,ELONN1,EON,EONTOP)
C$OMP PARALLEL DO
DO K=1,KMAX
CALL SPLAPLAC(IROMB,MAXWV,ENN1,WD(1,K),WD(1,K),-1)
CALL SPLAPLAC(IROMB,MAXWV,ENN1,WZ(1,K),WZ(1,K),-1)
WD(1:2,K)=0.
WZ(1:2,K)=0.
ENDDO
CALL SPTGPM(IROMB,MAXWV,KMAX,MI,MJ,MDIM,KGSKIP,NISKIP,NJSKIP,
& RLAT1,RLON1,DLAT,DLON,WD,PM)
CALL SPTGPM(IROMB,MAXWV,KMAX,MI,MJ,MDIM,KGSKIP,NISKIP,NJSKIP,
& RLAT1,RLON1,DLAT,DLON,WZ,SM)
ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
END