sptrunsv.f

Go to the documentation of this file.

C> @file
C>
C> Spectrally interpolate vectors to polar stereo
C> @author IREDELL @date 96-02-29
 
C> THIS SUBPROGRAM SPECTRALLY TRUNCATES VECTOR FIELDS
C> ON A GLOBAL CYLINDRICAL GRID, RETURNING THE FIELDS
C> TO SPECIFIC PAIRS OF POLAR STEREOGRAPHIC SCALAR FIELDS.
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> @param IROMB    - INTEGER SPECTRAL DOMAIN SHAPE
C>                (0 FOR TRIANGULAR, 1 FOR RHOMBOIDAL)
C> @param MAXWV    - INTEGER SPECTRAL TRUNCATION
C> @param 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> @param IMAXI    - INTEGER EVEN NUMBER OF INPUT LONGITUDES.
C> @param JMAXI    - INTEGER NUMBER OF INPUT LATITUDES.
C> @param KMAX     - INTEGER NUMBER OF FIELDS TO TRANSFORM.
C> @param NPS      - INTEGER ODD ORDER OF THE POLAR STEREOGRAPHIC GRIDS
C> @param 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> @param ISKIPI   - INTEGER SKIP NUMBER BETWEEN INPUT LONGITUDES
C>                (DEFAULTS TO 1 IF ISKIPI=0)
C> @param JSKIPI   - INTEGER SKIP NUMBER BETWEEN INPUT LATITUDES FROM SOUTH
C>                (DEFAULTS TO -IMAXI IF JSKIPI=0)
C> @param KSKIPI   - INTEGER SKIP NUMBER BETWEEN INPUT GRID FIELDS
C>                (DEFAULTS TO IMAXI*JMAXI IF KSKIPI=0)
C> @param KGSKIP   - INTEGER SKIP NUMBER BETWEEN GRID FIELDS
C>                (DEFAULTS TO NPS*NPS IF KGSKIP=0)
C> @param NISKIP   - INTEGER SKIP NUMBER BETWEEN GRID I-POINTS
C>                (DEFAULTS TO 1 IF NISKIP=0)
C> @param NJSKIP   - INTEGER SKIP NUMBER BETWEEN GRID J-POINTS
C>                (DEFAULTS TO NPS IF NJSKIP=0)
C> @param JCPU     - INTEGER NUMBER OF CPUS OVER WHICH TO MULTIPROCESS
C>                (DEFAULTS TO ENVIRONMENT NCPUS IF JCPU=0)
C> @param TRUE     - REAL LATITUDE AT WHICH PS GRID IS TRUE (USUALLY 60.)
C> @param XMESH    - REAL GRID LENGTH AT TRUE LATITUDE (M)
C> @param ORIENT   - REAL LONGITUDE AT BOTTOM OF NORTHERN PS GRID
C>                (SOUTHERN PS GRID WILL HAVE OPPOSITE ORIENTATION.)
C> @param GRIDUI   - REAL (*) INPUT GRID U-WINDS
C> @param GRIDVI   - REAL (*) INPUT GRID V-WINDS
C> @param LUV      - LOGICAL FLAG WHETHER TO RETURN WINDS
C> @param LDZ      - LOGICAL FLAG WHETHER TO RETURN DIVERGENCE AND VORTICITY
C> @param LPS      - LOGICAL FLAG WHETHER TO RETURN POTENTIAL AND STREAMFCN
C> @param UN       - REAL (*) NORTHERN PS U-WINDS IF LUV
C> @param VN       - REAL (*) NORTHERN PS V-WINDS IF LUV
C> @param US       - REAL (*) SOUTHERN PS U-WINDS IF LUV
C> @param VS       - REAL (*) SOUTHERN PS V-WINDS IF LUV
C> @param DN       - REAL (*) NORTHERN DIVERGENCES IF LDZ
C> @param ZN       - REAL (*) NORTHERN VORTICITIES IF LDZ
C> @param DS       - REAL (*) SOUTHERN DIVERGENCES IF LDZ
C> @param ZS       - REAL (*) SOUTHERN VORTICITIES IF LDZ
C> @param PN       - REAL (*) NORTHERN POTENTIALS IF LPS
C> @param SN       - REAL (*) NORTHERN STREAMFCNS IF LPS
C> @param PS       - REAL (*) SOUTHERN POTENTIALS IF LPS
C> @param SS       - REAL (*) SOUTHERN 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>   - SPTGPS       TRANSFORM SPECTRAL SCALAR TO POLAR STEREO.
C>   - SPTGPSV      TRANSFORM SPECTRAL VECTOR TO POLAR STEREO.
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
      SUBROUTINE sptrunsv(IROMB,MAXWV,IDRTI,IMAXI,JMAXI,KMAX,NPS,
     &                    IPRIME,ISKIPI,JSKIPI,KSKIPI,KGSKIP,
     &                    NISKIP,NJSKIP,JCPU,TRUE,XMESH,ORIENT,
     &                    GRIDUI,GRIDVI,
     &                    LUV,UN,VN,US,VS,LDZ,DN,ZN,DS,ZS,
     &                    LPS,PN,SN,PS,SS)
      LOGICAL LUV,LDZ,LPS
      REAL GRIDUI(*),GRIDVI(*)
      REAL UN(*),VN(*),US(*),VS(*),DN(*),ZN(*),DS(*),ZS(*)
      REAL PN(*),SN(*),PS(*),SS(*)
      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 sptgpsv(iromb,maxwv,kmax,nps,mdim,kgskip,niskip,njskip,
     &               true,xmesh,orient,wd,wz,un,vn,us,vs)
      ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  TRANSFORM WAVE TO OUTPUT DIVERGENCE AND VORTICITY
      IF(ldz) THEN
        CALL sptgps(iromb,maxwv,kmax,nps,mdim,kgskip,niskip,njskip,
     &              true,xmesh,orient,wd,dn,ds)
        CALL sptgps(iromb,maxwv,kmax,nps,mdim,kgskip,niskip,njskip,
     &              true,xmesh,orient,wz,zn,zs)
      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 sptgps(iromb,maxwv,kmax,nps,mdim,kgskip,niskip,njskip,
     &              true,xmesh,orient,wd,pn,ps)
        CALL sptgps(iromb,maxwv,kmax,nps,mdim,kgskip,niskip,njskip,
     &              true,xmesh,orient,wz,sn,ss)
      ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      END