C-----------------------------------------------------------------------
SUBROUTINE SPTGPTVD(IROMB,MAXWV,KMAX,NMAX,
& KWSKIP,KGSKIP,NRSKIP,NGSKIP,
& RLAT,RLON,WAVED,WAVEZ,
& DP,ZP,UP,VP,UXP,VXP,UYP,VYP)
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: SPTGPTVD TRANSFORM SPECTRAL VECTOR TO STATION POINTS
C PRGMMR: IREDELL ORG: W/NMC23 DATE: 96-02-29
C
C ABSTRACT: THIS SUBPROGRAM PERFORMS A SPHERICAL TRANSFORM
C FROM SPECTRAL COEFFICIENTS OF DIVERGENCES AND CURLS
C TO SPECIFIED SETS OF STATION POINT VECTORS AND THEIR
C GRADIENTS ON THE GLOBE.
C DP=(D(UP)/DLON+D(VP*CLAT)/DLAT)/(R*CLAT)
C ZP=(D(VP)/DLON-D(UP*CLAT)/DLAT)/(R*CLAT)
C UXP=D(UP*CLAT)/DLON/(R*CLAT)
C VXP=D(VP*CLAT)/DLON/(R*CLAT)
C UYP=D(UP*CLAT)/DLAT/R
C VYP=D(VP*CLAT)/DLAT/R
C THE WAVE-SPACE CAN BE EITHER TRIANGULAR OR RHOMBOIDAL.
C THE WAVE AND POINT FIELDS MAY HAVE GENERAL INDEXING,
C BUT EACH WAVE FIELD IS IN SEQUENTIAL 'IBM ORDER',
C I.E. WITH ZONAL WAVENUMBER AS THE SLOWER INDEX.
C THE TRANSFORMS ARE ALL MULTIPROCESSED OVER STATIONS.
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 1999-08-18 IREDELL OPENMP DIRECTIVE TYPO FIXED
C
C USAGE: CALL SPTGPTVD(IROMB,MAXWV,KMAX,NMAX,
C & KWSKIP,KGSKIP,NRSKIP,NGSKIP,
C & RLAT,RLON,WAVED,WAVEZ,
C & DP,ZP,UP,VP,UXP,VXP,UYP,VYP)
C INPUT ARGUMENTS:
C IROMB - INTEGER SPECTRAL DOMAIN SHAPE
C (0 FOR TRIANGULAR, 1 FOR RHOMBOIDAL)
C MAXWV - INTEGER SPECTRAL TRUNCATION
C KMAX - INTEGER NUMBER OF FIELDS TO TRANSFORM.
C NMAX - INTEGER NUMBER OF STATION POINTS TO RETURN
C KWSKIP - INTEGER SKIP NUMBER BETWEEN WAVE FIELDS
C (DEFAULTS TO (MAXWV+1)*((IROMB+1)*MAXWV+2) IF KWSKIP=0)
C KGSKIP - INTEGER SKIP NUMBER BETWEEN STATION POINT SETS
C (DEFAULTS TO NMAX IF KGSKIP=0)
C NRSKIP - INTEGER SKIP NUMBER BETWEEN STATION LATS AND LONS
C (DEFAULTS TO 1 IF NRSKIP=0)
C NGSKIP - INTEGER SKIP NUMBER BETWEEN STATION POINTS
C (DEFAULTS TO 1 IF NGSKIP=0)
C RLAT - REAL (*) STATION LATITUDES IN DEGREES
C RLON - REAL (*) STATION LONGITUDES IN DEGREES
C WAVED - REAL (*) WAVE DIVERGENCE FIELDS
C WAVEZ - REAL (*) WAVE VORTICITY FIELDS
C OUTPUT ARGUMENTS:
C DP - REAL (*) STATION POINT DIVERGENCE SETS
C ZP - REAL (*) STATION POINT VORTICITY SETS
C UP - REAL (*) STATION POINT U-WIND SETS
C VP - REAL (*) STATION POINT V-WIND SETS
C UXP - REAL (*) STATION POINT U-WIND X-GRADIENT SETS
C VXP - REAL (*) STATION POINT V-WIND X-GRADIENT SETS
C UYP - REAL (*) STATION POINT U-WIND Y-GRADIENT SETS
C VYP - REAL (*) STATION POINT V-WIND Y-GRADIENT SETS
C
C SUBPROGRAMS CALLED:
C SPWGET GET WAVE-SPACE CONSTANTS
C SPLEGEND COMPUTE LEGENDRE POLYNOMIALS
C SPSYNTH SYNTHESIZE FOURIER FROM SPECTRAL
C SPDZ2UV COMPUTE WINDS FROM DIVERGENCE AND VORTICITY
C SPGRADX COMPUTE X-GRADIENT IN FOURIER SPACE
C SPFFTPT COMPUTE FOURIER TRANSFORM TO GRIDPOINTS
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 77
C
C$$$
REAL RLAT(*),RLON(*),WAVED(*),WAVEZ(*)
REAL DP(*),ZP(*),UP(*),VP(*),UXP(*),VXP(*),UYP(*),VYP(*)
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)
INTEGER MP(4*KMAX)
REAL W((MAXWV+1)*((IROMB+1)*MAXWV+2)/2*2,4*KMAX)
REAL WTOP(2*(MAXWV+1),4*KMAX)
REAL PLN((MAXWV+1)*((IROMB+1)*MAXWV+2)/2),PLNTOP(MAXWV+1)
REAL F(2*MAXWV+2,2,6*KMAX),G(6*KMAX)
PARAMETER(PI=3.14159265358979)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C CALCULATE PRELIMINARY CONSTANTS
CALL SPWGET(IROMB,MAXWV,EPS,EPSTOP,ENN1,ELONN1,EON,EONTOP)
MX=(MAXWV+1)*((IROMB+1)*MAXWV+2)/2
MXTOP=MAXWV+1
MDIM=2*MX
IDIM=2*MAXWV+2
KW=KWSKIP
KG=KGSKIP
NR=NRSKIP
NG=NGSKIP
IF(KW.EQ.0) KW=2*MX
IF(KG.EQ.0) KG=NMAX
IF(NR.EQ.0) NR=1
IF(NG.EQ.0) NG=1
MP(1:2*KMAX)=0
MP(2*KMAX+1:4*KMAX)=1
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C CALCULATE SPECTRAL WINDS
C$OMP PARALLEL DO PRIVATE(KWS,KD,KZ,KU,KV)
DO K=1,KMAX
KWS=(K-1)*KW
KD=0*KMAX+K
KZ=1*KMAX+K
KU=2*KMAX+K
KV=3*KMAX+K
DO I=1,2*MX
W(I,KD)=WAVED(KWS+I)
W(I,KZ)=WAVEZ(KWS+I)
ENDDO
DO I=1,2*MXTOP
WTOP(I,KD)=0
WTOP(I,KZ)=0
ENDDO
CALL SPDZ2UV(IROMB,MAXWV,ENN1,ELONN1,EON,EONTOP,
& WAVED(KWS+1),WAVEZ(KWS+1),
& W(1,KU),W(1,KV),WTOP(1,KU),WTOP(1,KV))
ENDDO
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C CALCULATE STATION FIELDS
C$OMP PARALLEL DO PRIVATE(KD,KZ,KU,KV,KUX,KVX,SLAT1,CLAT1)
C$OMP& PRIVATE(PLN,PLNTOP,F,G,NK)
DO N=1,NMAX
KU=2*KMAX+1
KUX=4*KMAX+1
IF(ABS(RLAT((N-1)*NR+1)).GE.89.9995) THEN
SLAT1=SIGN(1.,RLAT((N-1)*NR+1))
CLAT1=0.
ELSE
SLAT1=SIN(PI/180*RLAT((N-1)*NR+1))
CLAT1=COS(PI/180*RLAT((N-1)*NR+1))
ENDIF
CALL SPLEGEND(IROMB,MAXWV,SLAT1,CLAT1,EPS,EPSTOP,
& PLN,PLNTOP)
CALL SPSYNTH(IROMB,MAXWV,2*MAXWV,IDIM,MDIM,2*MXTOP,4*KMAX,
& CLAT1,PLN,PLNTOP,MP,W,WTOP,F)
CALL SPGRADX(MAXWV,IDIM,2*KMAX,MP(2*KMAX+1),CLAT1,
& F(1,1,2*KMAX+1),F(1,1,4*KMAX+1))
CALL SPFFTPT(MAXWV,1,IDIM,1,6*KMAX,RLON((N-1)*NR+1),F,G)
DO K=1,KMAX
KD=0*KMAX+K
KZ=1*KMAX+K
KU=2*KMAX+K
KV=3*KMAX+K
KUX=4*KMAX+K
KVX=5*KMAX+K
NK=(N-1)*NG+(K-1)*KG+1
DP(NK)=G(KD)
ZP(NK)=G(KZ)
UP(NK)=G(KU)
VP(NK)=G(KV)
UXP(NK)=G(KUX)
VXP(NK)=G(KVX)
UYP(NK)=G(KVX)-CLAT1*G(KZ)
VYP(NK)=CLAT1*G(KD)-G(KUX)
ENDDO
ENDDO
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
END