sptranf1.f

Go to the documentation of this file.

C> @file
C>
C> Sptranf spectral transform
C> @author IREDELL @date 96-02-29
 
C> THIS SUBPROGRAM PERFORMS AN SINGLE LATITUDE TRANSFORM FOR
C> SUBPROGRAM SPTRANF.  USE THIS SUBPROGRAM OUTSIDE
C> THE SPTRANF FAMILY CONTEXT AT YOUR OWN RISK.
C>
C> @param IROMB    - INTEGER SPECTRAL DOMAIN SHAPE
C>                (0 FOR TRIANGULAR, 1 FOR RHOMBOIDAL)
C> @param MAXWV    - INTEGER SPECTRAL TRUNCATION
C> @param IDRT     - INTEGER GRID IDENTIFIER
C>                (IDRT=4 FOR GAUSSIAN GRID,
C>                 IDRT=0 FOR EQUALLY-SPACED GRID INCLUDING POLES,
C>                 IDRT=256 FOR EQUALLY-SPACED GRID EXCLUDING POLES)
C> @param IMAX     - INTEGER EVEN NUMBER OF LONGITUDES
C> @param JMAX     - INTEGER NUMBER OF LATITUDES
C> @param JB       - INTEGER LATITUDE INDEX (FROM POLE) TO BEGIN TRANSFORM
C> @param JE       - INTEGER LATITUDE INDEX (FROM POLE) TO END TRANSFORM
C> @param EPS      - REAL ((MAXWV+1)*((IROMB+1)*MAXWV+2)/2)
C> @param EPSTOP   - REAL (MAXWV+1)
C> @param ENN1     - REAL ((MAXWV+1)*((IROMB+1)*MAXWV+2)/2)
C> @param ELONN1   - REAL ((MAXWV+1)*((IROMB+1)*MAXWV+2)/2)
C> @param EON      - REAL ((MAXWV+1)*((IROMB+1)*MAXWV+2)/2)
C> @param EONTOP   - REAL (MAXWV+1)
C> @param CLAT     - REAL (JB:JE) COSINES OF LATITUDE
C> @param SLAT     - REAL (JB:JE) SINES OF LATITUDE
C> @param WLAT     - REAL (JB:JE) GAUSSIAN WEIGHTS
C> @param AFFT     - REAL(8) (50000+4*IMAX) AUXILIARY ARRAY IF IDIR=0
C> @param PLN      - REAL ((M+1)*((I+1)*M+2)/2,JB:JE) LEGENDRE POLYNOMIALS
C> @param PLNTOP   - REAL (M+1,JB:JE) LEGENDRE POLYNOMIAL OVER TOP
C> @param MP       - INTEGER IDENTIFIER (0 FOR SCALAR, 1 FOR VECTOR)
C> @param[out] W        - REAL (*) WAVE FIELD IF IDIR>0
C> @param[out] WTOP     - REAL (*) WAVE FIELD OVER TOP IF IDIR>0
C> @param[out] G        - REAL (IMAX,2,JB:JE) GRID FIELD IF IDIR<0
C> @param IDIR     - INTEGER TRANSFORM FLAG
C>                (IDIR>0 FOR WAVE TO GRID, IDIR<0 FOR GRID TO WAVE)
C>
C> SUBPROGRAMS CALLED:
C>  - SPSYNTH      SYNTHESIZE FOURIER FROM SPECTRAL
C>  - SPANALY      ANALYZE SPECTRAL FROM FOURIER
C>  - SPFFTE       PERFORM FAST FOURIER TRANSFORM
      SUBROUTINE sptranf1(IROMB,MAXWV,IDRT,IMAX,JMAX,JB,JE,
     &                    EPS,EPSTOP,ENN1,ELONN1,EON,EONTOP,
     &                    AFFT,CLAT,SLAT,WLAT,PLN,PLNTOP,MP,
     &                    W,WTOP,G,IDIR)
 
      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(8) AFFT(50000+4*IMAX)
      REAL CLAT(JB:JE),SLAT(JB:JE),WLAT(JB:JE)
      REAL PLN((MAXWV+1)*((IROMB+1)*MAXWV+2)/2,JB:JE)
      REAL PLNTOP(MAXWV+1,JB:JE)
      REAL W((MAXWV+1)*((IROMB+1)*MAXWV+2))
      REAL WTOP(2*(MAXWV+1))
      REAL G(IMAX,2,JB:JE)
      REAL F(IMAX+2,2)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!      write(0,*) 'sptranf1 top'
      kw=(maxwv+1)*((iromb+1)*maxwv+2)
      kwtop=2*(maxwv+1)
      IF(idir.GT.0) THEN
        DO j=jb,je
          CALL spsynth(iromb,maxwv,imax,imax+2,kw,kwtop,1,
     &                 clat(j),pln(1,j),plntop(1,j),mp,
     &                 w,wtop,f)
          CALL spffte(imax,(imax+2)/2,imax,2,f,g(1,1,j),+1,afft)
        ENDDO
      ELSE
        DO j=jb,je
          CALL spffte(imax,(imax+2)/2,imax,2,f,g(1,1,j),-1,afft)
          CALL spanaly(iromb,maxwv,imax,imax+2,kw,kwtop,1,
     &                 wlat(j),clat(j),pln(1,j),plntop(1,j),mp,
     &                 f,w,wtop)
        ENDDO
!      write(0,*) 'sptranf1 end'
      ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      END