spuv2dz.f

Go to the documentation of this file.

C> @file
C>
C> Compute divergence and vorticity from winds
C> @author IREDELL @date 92-10-31
 
C> Computes the divergence and vorticity from wind components
C> in spectral space.
C> SUBPROGRAM SPEPS SHOULD BE CALLED ALREADY.
C> IF L IS THE ZONAL WAVENUMBER, N IS THE TOTAL WAVENUMBER,
C> EPS(L,N)=SQRT((N**2-L**2)/(4*N**2-1)) AND A IS EARTH RADIUS,
C> THEN THE DIVERGENCE D IS COMPUTED AS
C> <pre>
C> D(L,N)=I*L*A*U(L,N)
C> +EPS(L,N+1)*N*A*V(L,N+1)-EPS(L,N)*(N+1)*A*V(L,N-1)
C> </pre>
C> AND THE VORTICITY Z IS COMPUTED AS
C> <pre>
C> Z(L,N)=I*L*A*V(L,N)
C> -EPS(L,N+1)*N*A*U(L,N+1)+EPS(L,N)*(N+1)*A*U(L,N-1)
C> </pre>
C> WHERE U IS THE ZONAL WIND AND V IS THE MERIDIONAL WIND.
C> U AND V ARE WEIGHTED BY THE SECANT OF LATITUDE.
C> EXTRA TERMS ARE USED OVER TOP OF THE SPECTRAL DOMAIN.
C> ADVANTAGE IS TAKEN OF THE FACT THAT EPS(L,L)=0
C> IN ORDER TO VECTORIZE OVER THE ENTIRE SPECTRAL DOMAIN.
C>
C> @param I        - INTEGER SPECTRAL DOMAIN SHAPE
C>                (0 FOR TRIANGULAR, 1 FOR RHOMBOIDAL)
C> @param M        - INTEGER SPECTRAL TRUNCATION
C> @param ENN1     - REAL ((M+1)*((I+1)*M+2)/2) N*(N+1)/A**2
C> @param ELONN1   - REAL ((M+1)*((I+1)*M+2)/2) L/(N*(N+1))*A
C> @param EON      - REAL ((M+1)*((I+1)*M+2)/2) EPSILON/N*A
C> @param EONTOP   - REAL (M+1) EPSILON/N*A OVER TOP
C> @param U        - REAL ((M+1)*((I+1)*M+2)) ZONAL WIND (OVER COSLAT)
C> @param V        - REAL ((M+1)*((I+1)*M+2)) MERID WIND (OVER COSLAT)
C> @param UTOP     - REAL (2*(M+1)) ZONAL WIND (OVER COSLAT) OVER TOP
C> @param VTOP     - REAL (2*(M+1)) MERID WIND (OVER COSLAT) OVER TOP
C> @param D        - REAL ((M+1)*((I+1)*M+2)) DIVERGENCE
C> @param Z        - REAL ((M+1)*((I+1)*M+2)) VORTICITY
      SUBROUTINE spuv2dz(I,M,ENN1,ELONN1,EON,EONTOP,U,V,UTOP,VTOP,D,Z)
      REAL ENN1((M+1)*((I+1)*M+2)/2),ELONN1((M+1)*((I+1)*M+2)/2)
      REAL EON((M+1)*((I+1)*M+2)/2),EONTOP(M+1)
      REAL U((M+1)*((I+1)*M+2)),V((M+1)*((I+1)*M+2))
      REAL UTOP(2*(M+1)),VTOP(2*(M+1))
      REAL D((M+1)*((I+1)*M+2)),Z((M+1)*((I+1)*M+2))
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  COMPUTE TERMS FROM THE SPECTRAL DOMAIN
      k=1
      d(2*k-1)=0.
      d(2*k)=0.
      z(2*k-1)=0.
      z(2*k)=0.
      DO k=2,(m+1)*((i+1)*m+2)/2-1
        d(2*k-1)=-elonn1(k)*u(2*k)+eon(k+1)*v(2*k+1)-eon(k)*v(2*k-3)
        d(2*k)=elonn1(k)*u(2*k-1)+eon(k+1)*v(2*k+2)-eon(k)*v(2*k-2)
        z(2*k-1)=-elonn1(k)*v(2*k)-eon(k+1)*u(2*k+1)+eon(k)*u(2*k-3)
        z(2*k)=elonn1(k)*v(2*k-1)-eon(k+1)*u(2*k+2)+eon(k)*u(2*k-2)
      ENDDO
      k=(m+1)*((i+1)*m+2)/2
      d(2*k-1)=-elonn1(k)*u(2*k)-eon(k)*v(2*k-3)
      d(2*k)=elonn1(k)*u(2*k-1)-eon(k)*v(2*k-2)
      z(2*k-1)=-elonn1(k)*v(2*k)+eon(k)*u(2*k-3)
      z(2*k)=elonn1(k)*v(2*k-1)+eon(k)*u(2*k-2)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  COMPUTE TERMS FROM OVER TOP OF THE SPECTRAL DOMAIN
CDIR$ IVDEP
      DO l=0,m
        k=l*(2*m+(i-1)*(l-1))/2+i*l+m+1
        d(2*k-1)=d(2*k-1)+eontop(l+1)*vtop(2*l+1)
        d(2*k)=d(2*k)+eontop(l+1)*vtop(2*l+2)
        z(2*k-1)=z(2*k-1)-eontop(l+1)*utop(2*l+1)
        z(2*k)=z(2*k)-eontop(l+1)*utop(2*l+2)
      ENDDO
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  MULTIPLY BY LAPLACIAN TERM
      DO k=2,(m+1)*((i+1)*m+2)/2
        d(2*k-1)=d(2*k-1)*enn1(k)
        d(2*k)=d(2*k)*enn1(k)
        z(2*k-1)=z(2*k-1)*enn1(k)
        z(2*k)=z(2*k)*enn1(k)
      ENDDO
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      RETURN
      END