spanaly.f

Go to the documentation of this file.

C> @file
C> Analyze spectral from fourier
C> @author IREDELL @date 92-10-31
 
C> @name SPANALY Analyzes spectral coefficients from fourier coefficients
C> for a latitude pair (northern and southern hemispheres).
C> Vector components are multiplied by cosine of latitude.
C>
C> PROGRAM HISTORY LOG:
C>  - 91-10-31  MARK IREDELL
C>  - 94-08-01  MARK IREDELL   MOVED ZONAL WAVENUMBER LOOP INSIDE
C>  - 1998-12-15  IREDELL  OPENMP DIRECTIVES INSERTED
C>
C> @param I        - INTEGER SPECTRAL DOMAIN SHAPE
C>               (0 FOR TRIANGULAR, 1 FOR RHOMBOIDAL)
C> @param M        - INTEGER SPECTRAL TRUNCATION
C> @param IM       - INTEGER EVEN NUMBER OF FOURIER COEFFICIENTS
C> @param IX       - INTEGER DIMENSION OF FOURIER COEFFICIENTS (IX>=IM+2)
C> @param NC       - INTEGER DIMENSION OF SPECTRAL COEFFICIENTS
C>               (NC>=(M+1)*((I+1)*M+2))
C> @param NCTOP    - INTEGER DIMENSION OF SPECTRAL COEFFICIENTS OVER TOP
C>               (NCTOP>=2*(M+1))
C> @param KM       - INTEGER NUMBER OF FIELDS
C> @param WGT      - REAL GAUSSIAN WEIGHT
C> @param CLAT     - REAL COSINE OF LATITUDE
C> @param PLN      - REAL ((M+1)*((I+1)*M+2)/2) LEGENDRE POLYNOMIALS
C> @param PLNTOP   - REAL (M+1) LEGENDRE POLYNOMIAL OVER TOP
C> @param MP       - INTEGER (KM) IDENTIFIERS (0 FOR SCALAR, 1 FOR VECTOR)
C> @param F        - REAL (IX,2,KM) FOURIER COEFFICIENTS COMBINED
C> @param SPC      - REAL (NC,KM) SPECTRAL COEFFICIENTS
C> @param SPCTOP   - REAL (NCTOP,KM) SPECTRAL COEFFICIENTS OVER TOP
 
      SUBROUTINE spanaly(I,M,IM,IX,NC,NCTOP,KM,WGT,CLAT,PLN,PLNTOP,MP,
     &                   F,SPC,SPCTOP)
      INTEGER MP(KM)
      REAL PLN((M+1)*((I+1)*M+2)/2),PLNTOP(M+1)
      REAL F(IX,2,KM)
      REAL SPC(NC,KM),SPCTOP(NCTOP,KM)
      REAL FW(2,2)
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C FOR EACH ZONAL WAVENUMBER, ANALYZE TERMS OVER TOTAL WAVENUMBER.
C ANALYZE EVEN AND ODD POLYNOMIALS SEPARATELY.
      lx=min(m,im/2)
!C$OMP PARALLEL DO PRIVATE(L,NT,KS,KP,FW)
      DO k=1,km
        DO l=0,lx
          nt=mod(m+1+(i-1)*l,2)+1
          ks=l*(2*m+(i-1)*(l-1))
          kp=ks/2+1
          IF(mp(k).EQ.0) THEN
            fw(1,1)=wgt*(f(2*l+1,1,k)+f(2*l+1,2,k))
            fw(2,1)=wgt*(f(2*l+2,1,k)+f(2*l+2,2,k))
            fw(1,2)=wgt*(f(2*l+1,1,k)-f(2*l+1,2,k))
            fw(2,2)=wgt*(f(2*l+2,1,k)-f(2*l+2,2,k))
          ELSE
            fw(1,1)=wgt*clat*(f(2*l+1,1,k)+f(2*l+1,2,k))
            fw(2,1)=wgt*clat*(f(2*l+2,1,k)+f(2*l+2,2,k))
            fw(1,2)=wgt*clat*(f(2*l+1,1,k)-f(2*l+1,2,k))
            fw(2,2)=wgt*clat*(f(2*l+2,1,k)-f(2*l+2,2,k))
            spctop(2*l+1,k)=spctop(2*l+1,k)+plntop(l+1)*fw(1,nt)
            spctop(2*l+2,k)=spctop(2*l+2,k)+plntop(l+1)*fw(2,nt)
          ENDIF
          DO n=l,i*l+m,2
            spc(ks+2*n+1,k)=spc(ks+2*n+1,k)+pln(kp+n)*fw(1,1)
            spc(ks+2*n+2,k)=spc(ks+2*n+2,k)+pln(kp+n)*fw(2,1)
          ENDDO
          DO n=l+1,i*l+m,2
            spc(ks+2*n+1,k)=spc(ks+2*n+1,k)+pln(kp+n)*fw(1,2)
            spc(ks+2*n+2,k)=spc(ks+2*n+2,k)+pln(kp+n)*fw(2,2)
          ENDDO
        ENDDO
      ENDDO
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      RETURN
      END