C----------------------------------------------------------------------- SUBROUTINE SPTRANF0(IROMB,MAXWV,IDRT,IMAX,JMAX,JB,JE, & EPS,EPSTOP,ENN1,ELONN1,EON,EONTOP, & AFFT,CLAT,SLAT,WLAT,PLN,PLNTOP) C$$$ SUBPROGRAM DOCUMENTATION BLOCK C C SUBPROGRAM: SPTRANF0 SPTRANF SPECTRAL INITIALIZATION C PRGMMR: IREDELL ORG: W/NMC23 DATE: 96-02-29 C C ABSTRACT: THIS SUBPROGRAM PERFORMS AN INITIALIZATION FOR C SUBPROGRAM SPTRANF. USE THIS SUBPROGRAM OUTSIDE C THE SPTRANF FAMILY CONTEXT AT YOUR OWN RISK. C C PROGRAM HISTORY LOG: C 1998-12-15 IREDELL C C USAGE: CALL SPTRANF0(IROMB,MAXWV,IDRT,IMAX,JMAX,JB,JE, C & EPS,EPSTOP,ENN1,ELONN1,EON,EONTOP, C & AFFT,CLAT,SLAT,WLAT,PLN,PLNTOP) C INPUT ARGUMENTS: C IROMB - INTEGER SPECTRAL DOMAIN SHAPE C (0 FOR TRIANGULAR, 1 FOR RHOMBOIDAL) C MAXWV - INTEGER SPECTRAL TRUNCATION C 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 IMAX - INTEGER EVEN NUMBER OF LONGITUDES C JMAX - INTEGER NUMBER OF LATITUDES C JB - INTEGER LATITUDE INDEX (FROM POLE) TO BEGIN TRANSFORM C JE - INTEGER LATITUDE INDEX (FROM POLE) TO END TRANSFORM C OUTPUT ARGUMENTS: C EPS - REAL ((MAXWV+1)*((IROMB+1)*MAXWV+2)/2) C EPSTOP - REAL (MAXWV+1) C ENN1 - REAL ((MAXWV+1)*((IROMB+1)*MAXWV+2)/2) C ELONN1 - REAL ((MAXWV+1)*((IROMB+1)*MAXWV+2)/2) C EON - REAL ((MAXWV+1)*((IROMB+1)*MAXWV+2)/2) C EONTOP - REAL (MAXWV+1) C AFFT - REAL(8) (50000+4*IMAX) AUXILIARY ARRAY IF IDIR=0 C CLAT - REAL (JB:JE) COSINES OF LATITUDE C SLAT - REAL (JB:JE) SINES OF LATITUDE C WLAT - REAL (JB:JE) GAUSSIAN WEIGHTS C PLN - REAL ((MAXWV+1)*((IROMB+1)*MAXWV+2)/2,JB:JE) C LEGENDRE POLYNOMIALS C PLNTOP - REAL (MAXWV+1,JB:JE) LEGENDRE POLYNOMIAL OVER TOP C C SUBPROGRAMS CALLED: C SPWGET GET WAVE-SPACE CONSTANTS C SPFFTE PERFORM FAST FOURIER TRANSFORM C SPLAT COMPUTE LATITUDE FUNCTIONS C SPLEGEND COMPUTE LEGENDRE POLYNOMIALS C C ATTRIBUTES: C LANGUAGE: FORTRAN 77 C C$$$ 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 SLATX(JMAX),WLATX(JMAX) C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - CALL SPWGET(IROMB,MAXWV,EPS,EPSTOP,ENN1,ELONN1,EON,EONTOP) CALL SPFFTE(IMAX,(IMAX+2)/2,IMAX,2,0.,0.,0,AFFT) CALL SPLAT(IDRT,JMAX,SLATX,WLATX) JHE=(JMAX+1)/2 IF(JHE.GT.JMAX/2) WLATX(JHE)=WLATX(JHE)/2 DO J=JB,JE CLAT(J)=SQRT(1.-SLATX(J)**2) SLAT(J)=SLATX(J) WLAT(J)=WLATX(J) ENDDO C$OMP PARALLEL DO DO J=JB,JE CALL SPLEGEND(IROMB,MAXWV,SLAT(J),CLAT(J),EPS,EPSTOP, & PLN(1,J),PLNTOP(1,J)) ENDDO C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - END