!  . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
!  .                                                             .
!  .                  copyright (c) 1998 by ucar                 .
!  .                                                             .
!  .       university corporation for atmospheric research       .
!  .                                                             .
!  .                      all rights reserved                    .
!  .                                                             .
!  .                                                             .
!  .                         spherepack3.0                       .
!  .                                                             .
!  . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
!
!
!
! ... file vhaec.f
!
!     this file contains code and documentation for subroutines
!     vhaec and vhaeci
!
! ... files which must be loaded with vhaec.f
!
!     sphcom.f, hrfft.f
!
!
!     subroutine vhaec(nlat,nlon,ityp,nt,v,w,idvw,jdvw,br,bi,cr,ci,
!    +                 mdab,ndab,wvhaec,lvhaec,work,lwork,ierror)
!
!     subroutine vhaec performs the vector spherical harmonic analysis
!     on the vector field (v,w) and stores the result in the arrays
!     br, bi, cr, and ci. v(i,j) and w(i,j) are the colatitudinal
!     (measured from the north pole) and east longitudinal components
!     respectively, located at colatitude theta(i) = (i-1)*pi/(nlat-1)
!     and longitude phi(j) = (j-1)*2*pi/nlon. the spectral
!     representation of (v,w) is given at output parameters v,w in
!     subroutine vhsec.
!
!     input parameters
!
!     nlat   the number of colatitudes on the full sphere including the
!            poles. for example, nlat = 37 for a five degree grid.
!            nlat determines the grid increment in colatitude as
!            pi/(nlat-1).  if nlat is odd the equator is located at
!            grid point i=(nlat+1)/2. if nlat is even the equator is
!            located half way between points i=nlat/2 and i=nlat/2+1.
!            nlat must be at least 3. note: on the half sphere, the
!            number of grid points in the colatitudinal direction is
!            nlat/2 if nlat is even or (nlat+1)/2 if nlat is odd.
!
!     nlon   the number of distinct londitude points.  nlon determines
!            the grid increment in longitude as 2*pi/nlon. for example
!            nlon = 72 for a five degree grid. nlon must be greater
!            than zero. the axisymmetric case corresponds to nlon=1.
!            the efficiency of the computation is improved when nlon
!            is a product of small prime numbers.
!
!     ityp   = 0  no symmetries exist about the equator. the analysis
!                 is performed on the entire sphere.  i.e. on the
!                 arrays v(i,j),w(i,j) for i=1,...,nlat and
!                 j=1,...,nlon.
!
!            = 1  no symmetries exist about the equator. the analysis
!                 is performed on the entire sphere.  i.e. on the
!                 arrays v(i,j),w(i,j) for i=1,...,nlat and
!                 j=1,...,nlon. the curl of (v,w) is zero. that is,
!                 (d/dtheta (sin(theta) w) - dv/dphi)/sin(theta) = 0.
!                 the coefficients cr and ci are zero.
!
!            = 2  no symmetries exist about the equator. the analysis
!                 is performed on the entire sphere.  i.e. on the
!                 arrays v(i,j),w(i,j) for i=1,...,nlat and
!                 j=1,...,nlon. the divergence of (v,w) is zero. i.e.,
!                 (d/dtheta (sin(theta) v) + dw/dphi)/sin(theta) = 0.
!                 the coefficients br and bi are zero.
!
!            = 3  v is symmetric and w is antisymmetric about the
!                 equator. the analysis is performed on the northern
!                 hemisphere only.  i.e., if nlat is odd the analysis
!                 is performed on the arrays v(i,j),w(i,j) for
!                 i=1,...,(nlat+1)/2 and j=1,...,nlon. if nlat is
!                 even the analysis is performed on the the arrays
!                 v(i,j),w(i,j) for i=1,...,nlat/2 and j=1,...,nlon.
!
!            = 4  v is symmetric and w is antisymmetric about the
!                 equator. the analysis is performed on the northern
!                 hemisphere only.  i.e., if nlat is odd the analysis
!                 is performed on the arrays v(i,j),w(i,j) for
!                 i=1,...,(nlat+1)/2 and j=1,...,nlon. if nlat is
!                 even the analysis is performed on the the arrays
!                 v(i,j),w(i,j) for i=1,...,nlat/2 and j=1,...,nlon.
!                 the curl of (v,w) is zero. that is,
!                 (d/dtheta (sin(theta) w) - dv/dphi)/sin(theta) = 0.
!                 the coefficients cr and ci are zero.
!
!            = 5  v is symmetric and w is antisymmetric about the
!                 equator. the analysis is performed on the northern
!                 hemisphere only.  i.e., if nlat is odd the analysis
!                 is performed on the arrays v(i,j),w(i,j) for
!                 i=1,...,(nlat+1)/2 and j=1,...,nlon. if nlat is
!                 even the analysis is performed on the the arrays
!                 v(i,j),w(i,j) for i=1,...,nlat/2 and j=1,...,nlon.
!                 the divergence of (v,w) is zero. i.e.,
!                 (d/dtheta (sin(theta) v) + dw/dphi)/sin(theta) = 0.
!                 the coefficients br and bi are zero.
!
!            = 6  v is antisymmetric and w is symmetric about the
!                 equator. the analysis is performed on the northern
!                 hemisphere only.  i.e., if nlat is odd the analysis
!                 is performed on the arrays v(i,j),w(i,j) for
!                 i=1,...,(nlat+1)/2 and j=1,...,nlon. if nlat is
!                 even the analysis is performed on the the arrays
!                 v(i,j),w(i,j) for i=1,...,nlat/2 and j=1,...,nlon.
!
!            = 7  v is antisymmetric and w is symmetric about the
!                 equator. the analysis is performed on the northern
!                 hemisphere only.  i.e., if nlat is odd the analysis
!                 is performed on the arrays v(i,j),w(i,j) for
!                 i=1,...,(nlat+1)/2 and j=1,...,nlon. if nlat is
!                 even the analysis is performed on the the arrays
!                 v(i,j),w(i,j) for i=1,...,nlat/2 and j=1,...,nlon.
!                 the curl of (v,w) is zero. that is,
!                 (d/dtheta (sin(theta) w) - dv/dphi)/sin(theta) = 0.
!                 the coefficients cr and ci are zero.
!
!            = 8  v is antisymmetric and w is symmetric about the
!                 equator. the analysis is performed on the northern
!                 hemisphere only.  i.e., if nlat is odd the analysis
!                 is performed on the arrays v(i,j),w(i,j) for
!                 i=1,...,(nlat+1)/2 and j=1,...,nlon. if nlat is
!                 even the analysis is performed on the the arrays
!                 v(i,j),w(i,j) for i=1,...,nlat/2 and j=1,...,nlon.
!                 the divergence of (v,w) is zero. i.e.,
!                 (d/dtheta (sin(theta) v) + dw/dphi)/sin(theta) = 0.
!                 the coefficients br and bi are zero.
!
!
!     nt     the number of analyses.  in the program that calls vhaec,
!            the arrays v,w,br,bi,cr, and ci can be three dimensional
!            in which case multiple analyses will be performed.
!            the third index is the analysis index which assumes the
!            values k=1,...,nt.  for a single analysis set nt=1. the
!            discription of the remaining parameters is simplified
!            by assuming that nt=1 or that all the arrays are two
!            dimensional.
!
!     v,w    two or three dimensional arrays (see input parameter nt)
!            that contain the vector function to be analyzed.
!            v is the colatitudnal component and w is the east
!            longitudinal component. v(i,j),w(i,j) contain the
!            components at colatitude theta(i) = (i-1)*pi/(nlat-1)
!            and longitude phi(j) = (j-1)*2*pi/nlon. the index ranges
!            are defined above at the input parameter ityp.
!
!     idvw   the first dimension of the arrays v,w as it appears in
!            the program that calls vhaec. if ityp .le. 2 then idvw
!            must be at least nlat.  if ityp .gt. 2 and nlat is
!            even then idvw must be at least nlat/2. if ityp .gt. 2
!            and nlat is odd then idvw must be at least (nlat+1)/2.
!
!     jdvw   the second dimension of the arrays v,w as it appears in
!            the program that calls vhaec. jdvw must be at least nlon.
!
!     mdab   the first dimension of the arrays br,bi,cr, and ci as it
!            appears in the program that calls vhaec. mdab must be at
!            least min0(nlat,nlon/2) if nlon is even or at least
!            min0(nlat,(nlon+1)/2) if nlon is odd.
!
!     ndab   the second dimension of the arrays br,bi,cr, and ci as it
!            appears in the program that calls vhaec. ndab must be at
!            least nlat.
!
!     wvhaec an array which must be initialized by subroutine vhaeci.
!            once initialized, wvhaec can be used repeatedly by vhaec
!            as long as nlon and nlat remain unchanged.  wvhaec must
!            not be altered between calls of vhaec.
!
!     lvhaec the dimension of the array wvhaec as it appears in the
!            program that calls vhaec. define
!
!               l1 = min0(nlat,nlon/2) if nlon is even or
!               l1 = min0(nlat,(nlon+1)/2) if nlon is odd
!
!            and
!
!               l2 = nlat/2        if nlat is even or
!               l2 = (nlat+1)/2    if nlat is odd
!
!            then lvhaec must be at least
!
!            4*nlat*l2+3*max0(l1-2,0)*(nlat+nlat-l1-1)+nlon+15
!
!
!     work   a work array that does not have to be saved.
!
!     lwork  the dimension of the array work as it appears in the
!            program that calls vhaec. define
!
!               l2 = nlat/2        if nlat is even or
!               l2 = (nlat+1)/2    if nlat is odd
!
!            if ityp .le. 2 then lwork must be at least
!
!                    nlat*(2*nt*nlon+max0(6*l2,nlon))
!
!            if ityp .gt. 2 then lwork must be at least
!
!                    l2*(2*nt*nlon+max0(6*nlat,nlon))
!
!     **************************************************************
!
!     output parameters
!
!     br,bi  two or three dimensional arrays (see input parameter nt)
!     cr,ci  that contain the vector spherical harmonic coefficients
!            in the spectral representation of v(i,j) and w(i,j) given
!            in the discription of subroutine vhsec. br(mp1,np1),
!            bi(mp1,np1),cr(mp1,np1), and ci(mp1,np1) are computed
!            for mp1=1,...,mmax and np1=mp1,...,nlat except for np1=nlat
!            and odd mp1. mmax=min0(nlat,nlon/2) if nlon is even or
!            mmax=min0(nlat,(nlon+1)/2) if nlon is odd.
!
!     ierror = 0  no errors
!            = 1  error in the specification of nlat
!            = 2  error in the specification of nlon
!            = 3  error in the specification of ityp
!            = 4  error in the specification of nt
!            = 5  error in the specification of idvw
!            = 6  error in the specification of jdvw
!            = 7  error in the specification of mdab
!            = 8  error in the specification of ndab
!            = 9  error in the specification of lvhaec
!            = 10 error in the specification of lwork
!
!
! *******************************************************************
!
!     subroutine vhaeci(nlat,nlon,wvhaec,lvhaec,dwork,ldwork,ierror)
!
!     subroutine vhaeci initializes the array wvhaec which can then be
!     used repeatedly by subroutine vhaec until nlat or nlon is changed.
!
!     input parameters
!
!     nlat   the number of colatitudes on the full sphere including the
!            poles. for example, nlat = 37 for a five degree grid.
!            nlat determines the grid increment in colatitude as
!            pi/(nlat-1).  if nlat is odd the equator is located at
!            grid point i=(nlat+1)/2. if nlat is even the equator is
!            located half way between points i=nlat/2 and i=nlat/2+1.
!            nlat must be at least 3. note: on the half sphere, the
!            number of grid points in the colatitudinal direction is
!            nlat/2 if nlat is even or (nlat+1)/2 if nlat is odd.
!
!     nlon   the number of distinct londitude points.  nlon determines
!            the grid increment in longitude as 2*pi/nlon. for example
!            nlon = 72 for a five degree grid. nlon must be greater
!            than zero. the axisymmetric case corresponds to nlon=1.
!            the efficiency of the computation is improved when nlon
!            is a product of small prime numbers.
!
!     lvhaec the dimension of the array wvhaec as it appears in the
!            program that calls vhaec. define
!
!               l1 = min0(nlat,nlon/2) if nlon is even or
!               l1 = min0(nlat,(nlon+1)/2) if nlon is odd
!
!            and
!
!               l2 = nlat/2        if nlat is even or
!               l2 = (nlat+1)/2    if nlat is odd
!
!            then lvhaec must be at least
!
!            4*nlat*l2+3*max0(l1-2,0)*(nlat+nlat-l1-1)+nlon+15
!
!
!     dwork  a double precision work array that does not have to be saved.
!
!     ldwork the dimension of the array dwork as it appears in the
!            program that calls vhaec. ldwork must be at least
!            2*(nlat+2)
!
!
!     **************************************************************
!
!     output parameters
!
!     wvhaec an array which is initialized for use by subroutine vhaec.
!            once initialized, wvhaec can be used repeatedly by vhaec
!            as long as nlat or nlon remain unchanged.  wvhaec must not
!            be altered between calls of vhaec.
!
!
!     ierror = 0  no errors
!            = 1  error in the specification of nlat
!            = 2  error in the specification of nlon
!            = 3  error in the specification of lvhaec
!            = 4  error in the specification of ldwork
!
!
! **********************************************************************
      SUBROUTINE VHAEC(Nlat,Nlon,Ityp,Nt,V,W,Idvw,Jdvw,Br,Bi,Cr,Ci,Mdab,&
                     & Ndab,Wvhaec,Lvhaec,Work,Lwork,Ierror)
      IMPLICIT NONE
      REAL Bi , Br , Ci , Cr , V , W , Work , Wvhaec
      INTEGER idv , Idvw , Ierror , imid , ist , Ityp , iw1 , iw2 ,     &
            & iw3 , iw4 , iw5 , Jdvw , jw1 , jw2 , labc , lnl , Lvhaec ,&
            & Lwork , lwzvin , lzz1
      INTEGER Mdab , mmax , Ndab , Nlat , Nlon , Nt
      DIMENSION V(Idvw,Jdvw,1) , W(Idvw,Jdvw,1) , Br(Mdab,Ndab,1) ,     &
              & Bi(Mdab,Ndab,1) , Cr(Mdab,Ndab,1) , Ci(Mdab,Ndab,1) ,   &
              & Work(1) , Wvhaec(1)
      Ierror = 1
      IF ( Nlat<3 ) RETURN
      Ierror = 2
      IF ( Nlon<1 ) RETURN
      Ierror = 3
      IF ( Ityp<0 .OR. Ityp>8 ) RETURN
      Ierror = 4
      IF ( Nt<0 ) RETURN
      Ierror = 5
      imid = (Nlat+1)/2
      IF ( (Ityp<=2 .AND. Idvw<Nlat) .OR. (Ityp>2 .AND. Idvw<imid) )    &
         & RETURN
      Ierror = 6
      IF ( Jdvw<Nlon ) RETURN
      Ierror = 7
      mmax = MIN0(Nlat,(Nlon+1)/2)
      IF ( Mdab<mmax ) RETURN
      Ierror = 8
      IF ( Ndab<Nlat ) RETURN
      Ierror = 9
      lzz1 = 2*Nlat*imid
      labc = 3*(MAX0(mmax-2,0)*(Nlat+Nlat-mmax-1))/2
      IF ( Lvhaec<2*(lzz1+labc)+Nlon+15 ) RETURN
      Ierror = 10
      IF ( Ityp<=2 .AND. Lwork<Nlat*(2*Nt*Nlon+MAX0(6*imid,Nlon)) )     &
         & RETURN
      IF ( Ityp>2 .AND. Lwork<imid*(2*Nt*Nlon+MAX0(6*Nlat,Nlon)) )      &
         & RETURN
      Ierror = 0
      idv = Nlat
      IF ( Ityp>2 ) idv = imid
      lnl = Nt*idv*Nlon
      ist = 0
      IF ( Ityp<=2 ) ist = imid
      iw1 = ist + 1
      iw2 = lnl + 1
      iw3 = iw2 + ist
      iw4 = iw2 + lnl
      iw5 = iw4 + 3*imid*Nlat
      lwzvin = lzz1 + labc
      jw1 = lwzvin + 1
      jw2 = jw1 + lwzvin
      CALL VHAEC1(Nlat,Nlon,Ityp,Nt,imid,Idvw,Jdvw,V,W,Mdab,Ndab,Br,Bi, &
                & Cr,Ci,idv,Work,Work(iw1),Work(iw2),Work(iw3),Work(iw4)&
                & ,Work(iw5),Wvhaec,Wvhaec(jw1),Wvhaec(jw2))
      END SUBROUTINE VHAEC


      SUBROUTINE VHAEC1(Nlat,Nlon,Ityp,Nt,Imid,Idvw,Jdvw,V,W,Mdab,Ndab, &
                      & Br,Bi,Cr,Ci,Idv,Ve,Vo,We,Wo,Zv,Zw,Wzvin,Wzwin,  &
                      & Wrfft)
      IMPLICIT NONE
      REAL Bi , Br , Ci , Cr , fsn , tsn , V , Ve , Vo , W , We , Wo ,  &
         & Wrfft , Wzvin , Wzwin , Zv , Zw
      INTEGER i , Idv , Idvw , Imid , imm1 , Ityp , itypp , iv , iw ,   &
            & j , Jdvw , k , m , Mdab , mlat , mlon , mmax , mp1 , mp2 ,&
            & Ndab
      INTEGER ndo1 , ndo2 , Nlat , Nlon , nlp1 , np1 , Nt
      DIMENSION V(Idvw,Jdvw,1) , W(Idvw,Jdvw,1) , Br(Mdab,Ndab,1) ,     &
              & Bi(Mdab,Ndab,1) , Cr(Mdab,Ndab,1) , Ci(Mdab,Ndab,1) ,   &
              & Ve(Idv,Nlon,1) , Vo(Idv,Nlon,1) , We(Idv,Nlon,1) ,      &
              & Wo(Idv,Nlon,1) , Wzvin(1) , Wzwin(1) , Wrfft(1) ,       &
              & Zv(Imid,Nlat,3) , Zw(Imid,Nlat,3)
      nlp1 = Nlat + 1
      tsn = 2./Nlon
      fsn = 4./Nlon
      mlat = MOD(Nlat,2)
      mlon = MOD(Nlon,2)
      mmax = MIN0(Nlat,(Nlon+1)/2)
      imm1 = Imid
      IF ( mlat/=0 ) imm1 = Imid - 1
      IF ( Ityp>2 ) THEN
         DO k = 1 , Nt
            DO i = 1 , imm1
               DO j = 1 , Nlon
                  Ve(i,j,k) = fsn*V(i,j,k)
                  Vo(i,j,k) = fsn*V(i,j,k)
                  We(i,j,k) = fsn*W(i,j,k)
                  Wo(i,j,k) = fsn*W(i,j,k)
               ENDDO
            ENDDO
         ENDDO
      ELSE
         DO k = 1 , Nt
            DO i = 1 , imm1
               DO j = 1 , Nlon
                  Ve(i,j,k) = tsn*(V(i,j,k)+V(nlp1-i,j,k))
                  Vo(i,j,k) = tsn*(V(i,j,k)-V(nlp1-i,j,k))
                  We(i,j,k) = tsn*(W(i,j,k)+W(nlp1-i,j,k))
                  Wo(i,j,k) = tsn*(W(i,j,k)-W(nlp1-i,j,k))
               ENDDO
            ENDDO
         ENDDO
      ENDIF
      IF ( mlat/=0 ) THEN
         DO k = 1 , Nt
            DO j = 1 , Nlon
               Ve(Imid,j,k) = tsn*V(Imid,j,k)
               We(Imid,j,k) = tsn*W(Imid,j,k)
            ENDDO
         ENDDO
      ENDIF
      DO k = 1 , Nt
         CALL HRFFTF(Idv,Nlon,Ve(1,1,k),Idv,Wrfft,Zv)
         CALL HRFFTF(Idv,Nlon,We(1,1,k),Idv,Wrfft,Zv)
      ENDDO
      ndo1 = Nlat
      ndo2 = Nlat
      IF ( mlat/=0 ) ndo1 = Nlat - 1
      IF ( mlat==0 ) ndo2 = Nlat - 1
      IF ( Ityp/=2 .AND. Ityp/=5 .AND. Ityp/=8 ) THEN
         DO k = 1 , Nt
            DO mp1 = 1 , mmax
               DO np1 = mp1 , Nlat
                  Br(mp1,np1,k) = 0.
                  Bi(mp1,np1,k) = 0.
               ENDDO
            ENDDO
         ENDDO
      ENDIF
      IF ( Ityp/=1 .AND. Ityp/=4 .AND. Ityp/=7 ) THEN
         DO k = 1 , Nt
            DO mp1 = 1 , mmax
               DO np1 = mp1 , Nlat
                  Cr(mp1,np1,k) = 0.
                  Ci(mp1,np1,k) = 0.
               ENDDO
            ENDDO
         ENDDO
      ENDIF
      itypp = Ityp + 1
      IF ( itypp==2 ) THEN
!
!     case ityp=1 ,  no symmetries but cr and ci equal zero
!
         CALL ZVIN(0,Nlat,Nlon,0,Zv,iv,Wzvin)
!
!     case m=0
!
         DO k = 1 , Nt
            DO i = 1 , Imid
               DO np1 = 2 , ndo2 , 2
                  Br(1,np1,k) = Br(1,np1,k) + Zv(i,np1,iv)*Ve(i,1,k)
               ENDDO
            ENDDO
         ENDDO
         DO k = 1 , Nt
            DO i = 1 , imm1
               DO np1 = 3 , ndo1 , 2
                  Br(1,np1,k) = Br(1,np1,k) + Zv(i,np1,iv)*Vo(i,1,k)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax<2 ) RETURN
         DO mp1 = 2 , mmax
            m = mp1 - 1
            mp2 = mp1 + 1
            CALL ZVIN(0,Nlat,Nlon,m,Zv,iv,Wzvin)
            CALL ZWIN(0,Nlat,Nlon,m,Zw,iw,Wzwin)
            IF ( mp1<=ndo1 ) THEN
               DO k = 1 , Nt
                  DO i = 1 , imm1
                     DO np1 = mp1 , ndo1 , 2
                        Br(mp1,np1,k) = Br(mp1,np1,k) + Zv(i,np1,iv)    &
                                      & *Vo(i,2*mp1-2,k) + Zw(i,np1,iw) &
                                      & *We(i,2*mp1-1,k)
                        Bi(mp1,np1,k) = Bi(mp1,np1,k) + Zv(i,np1,iv)    &
                                      & *Vo(i,2*mp1-1,k) - Zw(i,np1,iw) &
                                      & *We(i,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDDO
               IF ( mlat/=0 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp1 , ndo1 , 2
                        Br(mp1,np1,k) = Br(mp1,np1,k) + Zw(Imid,np1,iw) &
                                      & *We(Imid,2*mp1-1,k)
                        Bi(mp1,np1,k) = Bi(mp1,np1,k) - Zw(Imid,np1,iw) &
                                      & *We(Imid,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDIF
            ENDIF
            IF ( mp2<=ndo2 ) THEN
               DO k = 1 , Nt
                  DO i = 1 , imm1
                     DO np1 = mp2 , ndo2 , 2
                        Br(mp1,np1,k) = Br(mp1,np1,k) + Zv(i,np1,iv)    &
                                      & *Ve(i,2*mp1-2,k) + Zw(i,np1,iw) &
                                      & *Wo(i,2*mp1-1,k)
                        Bi(mp1,np1,k) = Bi(mp1,np1,k) + Zv(i,np1,iv)    &
                                      & *Ve(i,2*mp1-1,k) - Zw(i,np1,iw) &
                                      & *Wo(i,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDDO
               IF ( mlat/=0 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        Br(mp1,np1,k) = Br(mp1,np1,k) + Zv(Imid,np1,iv) &
                                      & *Ve(Imid,2*mp1-2,k)
                        Bi(mp1,np1,k) = Bi(mp1,np1,k) + Zv(Imid,np1,iv) &
                                      & *Ve(Imid,2*mp1-1,k)
                     ENDDO
                  ENDDO
               ENDIF
            ENDIF
         ENDDO
         RETURN
      ELSEIF ( itypp==3 ) THEN
!
!     case ityp=2 ,  no symmetries but br and bi equal zero
!
         CALL ZVIN(0,Nlat,Nlon,0,Zv,iv,Wzvin)
!
!     case m=0
!
         DO k = 1 , Nt
            DO i = 1 , Imid
               DO np1 = 2 , ndo2 , 2
                  Cr(1,np1,k) = Cr(1,np1,k) - Zv(i,np1,iv)*We(i,1,k)
               ENDDO
            ENDDO
         ENDDO
         DO k = 1 , Nt
            DO i = 1 , imm1
               DO np1 = 3 , ndo1 , 2
                  Cr(1,np1,k) = Cr(1,np1,k) - Zv(i,np1,iv)*Wo(i,1,k)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax<2 ) RETURN
         DO mp1 = 2 , mmax
            m = mp1 - 1
            mp2 = mp1 + 1
            CALL ZVIN(0,Nlat,Nlon,m,Zv,iv,Wzvin)
            CALL ZWIN(0,Nlat,Nlon,m,Zw,iw,Wzwin)
            IF ( mp1<=ndo1 ) THEN
               DO k = 1 , Nt
                  DO i = 1 , imm1
                     DO np1 = mp1 , ndo1 , 2
                        Cr(mp1,np1,k) = Cr(mp1,np1,k) - Zv(i,np1,iv)    &
                                      & *Wo(i,2*mp1-2,k) + Zw(i,np1,iw) &
                                      & *Ve(i,2*mp1-1,k)
                        Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zv(i,np1,iv)    &
                                      & *Wo(i,2*mp1-1,k) - Zw(i,np1,iw) &
                                      & *Ve(i,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDDO
               IF ( mlat/=0 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp1 , ndo1 , 2
                        Cr(mp1,np1,k) = Cr(mp1,np1,k) + Zw(Imid,np1,iw) &
                                      & *Ve(Imid,2*mp1-1,k)
                        Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zw(Imid,np1,iw) &
                                      & *Ve(Imid,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDIF
            ENDIF
            IF ( mp2<=ndo2 ) THEN
               DO k = 1 , Nt
                  DO i = 1 , imm1
                     DO np1 = mp2 , ndo2 , 2
                        Cr(mp1,np1,k) = Cr(mp1,np1,k) - Zv(i,np1,iv)    &
                                      & *We(i,2*mp1-2,k) + Zw(i,np1,iw) &
                                      & *Vo(i,2*mp1-1,k)
                        Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zv(i,np1,iv)    &
                                      & *We(i,2*mp1-1,k) - Zw(i,np1,iw) &
                                      & *Vo(i,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDDO
               IF ( mlat/=0 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        Cr(mp1,np1,k) = Cr(mp1,np1,k) - Zv(Imid,np1,iv) &
                                      & *We(Imid,2*mp1-2,k)
                        Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zv(Imid,np1,iv) &
                                      & *We(Imid,2*mp1-1,k)
                     ENDDO
                  ENDDO
               ENDIF
            ENDIF
         ENDDO
         RETURN
      ELSEIF ( itypp==4 ) THEN
!
!     case ityp=3 ,  v even , w odd
!
         CALL ZVIN(0,Nlat,Nlon,0,Zv,iv,Wzvin)
!
!     case m=0
!
         DO k = 1 , Nt
            DO i = 1 , Imid
               DO np1 = 2 , ndo2 , 2
                  Br(1,np1,k) = Br(1,np1,k) + Zv(i,np1,iv)*Ve(i,1,k)
               ENDDO
            ENDDO
         ENDDO
         DO k = 1 , Nt
            DO i = 1 , imm1
               DO np1 = 3 , ndo1 , 2
                  Cr(1,np1,k) = Cr(1,np1,k) - Zv(i,np1,iv)*Wo(i,1,k)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax<2 ) RETURN
         DO mp1 = 2 , mmax
            m = mp1 - 1
            mp2 = mp1 + 1
            CALL ZVIN(0,Nlat,Nlon,m,Zv,iv,Wzvin)
            CALL ZWIN(0,Nlat,Nlon,m,Zw,iw,Wzwin)
            IF ( mp1<=ndo1 ) THEN
               DO k = 1 , Nt
                  DO i = 1 , imm1
                     DO np1 = mp1 , ndo1 , 2
                        Cr(mp1,np1,k) = Cr(mp1,np1,k) - Zv(i,np1,iv)    &
                                      & *Wo(i,2*mp1-2,k) + Zw(i,np1,iw) &
                                      & *Ve(i,2*mp1-1,k)
                        Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zv(i,np1,iv)    &
                                      & *Wo(i,2*mp1-1,k) - Zw(i,np1,iw) &
                                      & *Ve(i,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDDO
               IF ( mlat/=0 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp1 , ndo1 , 2
                        Cr(mp1,np1,k) = Cr(mp1,np1,k) + Zw(Imid,np1,iw) &
                                      & *Ve(Imid,2*mp1-1,k)
                        Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zw(Imid,np1,iw) &
                                      & *Ve(Imid,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDIF
            ENDIF
            IF ( mp2<=ndo2 ) THEN
               DO k = 1 , Nt
                  DO i = 1 , imm1
                     DO np1 = mp2 , ndo2 , 2
                        Br(mp1,np1,k) = Br(mp1,np1,k) + Zv(i,np1,iv)    &
                                      & *Ve(i,2*mp1-2,k) + Zw(i,np1,iw) &
                                      & *Wo(i,2*mp1-1,k)
                        Bi(mp1,np1,k) = Bi(mp1,np1,k) + Zv(i,np1,iv)    &
                                      & *Ve(i,2*mp1-1,k) - Zw(i,np1,iw) &
                                      & *Wo(i,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDDO
               IF ( mlat/=0 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        Br(mp1,np1,k) = Br(mp1,np1,k) + Zv(Imid,np1,iv) &
                                      & *Ve(Imid,2*mp1-2,k)
                        Bi(mp1,np1,k) = Bi(mp1,np1,k) + Zv(Imid,np1,iv) &
                                      & *Ve(Imid,2*mp1-1,k)
                     ENDDO
                  ENDDO
               ENDIF
            ENDIF
         ENDDO
         RETURN
      ELSEIF ( itypp==5 ) THEN
!
!     case ityp=4 ,  v even, w odd, and cr and ci equal 0.
!
         CALL ZVIN(1,Nlat,Nlon,0,Zv,iv,Wzvin)
!
!     case m=0
!
         DO k = 1 , Nt
            DO i = 1 , Imid
               DO np1 = 2 , ndo2 , 2
                  Br(1,np1,k) = Br(1,np1,k) + Zv(i,np1,iv)*Ve(i,1,k)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax<2 ) RETURN
         DO mp1 = 2 , mmax
            m = mp1 - 1
            mp2 = mp1 + 1
            CALL ZVIN(1,Nlat,Nlon,m,Zv,iv,Wzvin)
            CALL ZWIN(1,Nlat,Nlon,m,Zw,iw,Wzwin)
            IF ( mp2<=ndo2 ) THEN
               DO k = 1 , Nt
                  DO i = 1 , imm1
                     DO np1 = mp2 , ndo2 , 2
                        Br(mp1,np1,k) = Br(mp1,np1,k) + Zv(i,np1,iv)    &
                                      & *Ve(i,2*mp1-2,k) + Zw(i,np1,iw) &
                                      & *Wo(i,2*mp1-1,k)
                        Bi(mp1,np1,k) = Bi(mp1,np1,k) + Zv(i,np1,iv)    &
                                      & *Ve(i,2*mp1-1,k) - Zw(i,np1,iw) &
                                      & *Wo(i,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDDO
               IF ( mlat/=0 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        Br(mp1,np1,k) = Br(mp1,np1,k) + Zv(Imid,np1,iv) &
                                      & *Ve(Imid,2*mp1-2,k)
                        Bi(mp1,np1,k) = Bi(mp1,np1,k) + Zv(Imid,np1,iv) &
                                      & *Ve(Imid,2*mp1-1,k)
                     ENDDO
                  ENDDO
               ENDIF
            ENDIF
         ENDDO
         RETURN
      ELSEIF ( itypp==6 ) THEN
!
!     case ityp=5   v even, w odd, and br and bi equal zero
!
         CALL ZVIN(2,Nlat,Nlon,0,Zv,iv,Wzvin)
!
!     case m=0
!
         DO k = 1 , Nt
            DO i = 1 , imm1
               DO np1 = 3 , ndo1 , 2
                  Cr(1,np1,k) = Cr(1,np1,k) - Zv(i,np1,iv)*Wo(i,1,k)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax<2 ) RETURN
         DO mp1 = 2 , mmax
            m = mp1 - 1
            mp2 = mp1 + 1
            CALL ZVIN(2,Nlat,Nlon,m,Zv,iv,Wzvin)
            CALL ZWIN(2,Nlat,Nlon,m,Zw,iw,Wzwin)
            IF ( mp1<=ndo1 ) THEN
               DO k = 1 , Nt
                  DO i = 1 , imm1
                     DO np1 = mp1 , ndo1 , 2
                        Cr(mp1,np1,k) = Cr(mp1,np1,k) - Zv(i,np1,iv)    &
                                      & *Wo(i,2*mp1-2,k) + Zw(i,np1,iw) &
                                      & *Ve(i,2*mp1-1,k)
                        Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zv(i,np1,iv)    &
                                      & *Wo(i,2*mp1-1,k) - Zw(i,np1,iw) &
                                      & *Ve(i,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDDO
               IF ( mlat/=0 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp1 , ndo1 , 2
                        Cr(mp1,np1,k) = Cr(mp1,np1,k) + Zw(Imid,np1,iw) &
                                      & *Ve(Imid,2*mp1-1,k)
                        Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zw(Imid,np1,iw) &
                                      & *Ve(Imid,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDIF
            ENDIF
         ENDDO
         RETURN
      ELSEIF ( itypp==7 ) THEN
!
!     case ityp=6 ,  v odd , w even
!
         CALL ZVIN(0,Nlat,Nlon,0,Zv,iv,Wzvin)
!
!     case m=0
!
         DO k = 1 , Nt
            DO i = 1 , Imid
               DO np1 = 2 , ndo2 , 2
                  Cr(1,np1,k) = Cr(1,np1,k) - Zv(i,np1,iv)*We(i,1,k)
               ENDDO
            ENDDO
         ENDDO
         DO k = 1 , Nt
            DO i = 1 , imm1
               DO np1 = 3 , ndo1 , 2
                  Br(1,np1,k) = Br(1,np1,k) + Zv(i,np1,iv)*Vo(i,1,k)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax<2 ) RETURN
         DO mp1 = 2 , mmax
            m = mp1 - 1
            mp2 = mp1 + 1
            CALL ZVIN(0,Nlat,Nlon,m,Zv,iv,Wzvin)
            CALL ZWIN(0,Nlat,Nlon,m,Zw,iw,Wzwin)
            IF ( mp1<=ndo1 ) THEN
               DO k = 1 , Nt
                  DO i = 1 , imm1
                     DO np1 = mp1 , ndo1 , 2
                        Br(mp1,np1,k) = Br(mp1,np1,k) + Zv(i,np1,iv)    &
                                      & *Vo(i,2*mp1-2,k) + Zw(i,np1,iw) &
                                      & *We(i,2*mp1-1,k)
                        Bi(mp1,np1,k) = Bi(mp1,np1,k) + Zv(i,np1,iv)    &
                                      & *Vo(i,2*mp1-1,k) - Zw(i,np1,iw) &
                                      & *We(i,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDDO
               IF ( mlat/=0 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp1 , ndo1 , 2
                        Br(mp1,np1,k) = Br(mp1,np1,k) + Zw(Imid,np1,iw) &
                                      & *We(Imid,2*mp1-1,k)
                        Bi(mp1,np1,k) = Bi(mp1,np1,k) - Zw(Imid,np1,iw) &
                                      & *We(Imid,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDIF
            ENDIF
            IF ( mp2<=ndo2 ) THEN
               DO k = 1 , Nt
                  DO i = 1 , imm1
                     DO np1 = mp2 , ndo2 , 2
                        Cr(mp1,np1,k) = Cr(mp1,np1,k) - Zv(i,np1,iv)    &
                                      & *We(i,2*mp1-2,k) + Zw(i,np1,iw) &
                                      & *Vo(i,2*mp1-1,k)
                        Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zv(i,np1,iv)    &
                                      & *We(i,2*mp1-1,k) - Zw(i,np1,iw) &
                                      & *Vo(i,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDDO
               IF ( mlat/=0 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        Cr(mp1,np1,k) = Cr(mp1,np1,k) - Zv(Imid,np1,iv) &
                                      & *We(Imid,2*mp1-2,k)
                        Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zv(Imid,np1,iv) &
                                      & *We(Imid,2*mp1-1,k)
                     ENDDO
                  ENDDO
               ENDIF
            ENDIF
         ENDDO
         RETURN
      ELSEIF ( itypp==8 ) THEN
!
!     case ityp=7   v odd, w even, and cr and ci equal zero
!
         CALL ZVIN(2,Nlat,Nlon,0,Zv,iv,Wzvin)
!
!     case m=0
!
         DO k = 1 , Nt
            DO i = 1 , imm1
               DO np1 = 3 , ndo1 , 2
                  Br(1,np1,k) = Br(1,np1,k) + Zv(i,np1,iv)*Vo(i,1,k)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax<2 ) RETURN
         DO mp1 = 2 , mmax
            m = mp1 - 1
            mp2 = mp1 + 1
            CALL ZVIN(2,Nlat,Nlon,m,Zv,iv,Wzvin)
            CALL ZWIN(2,Nlat,Nlon,m,Zw,iw,Wzwin)
            IF ( mp1<=ndo1 ) THEN
               DO k = 1 , Nt
                  DO i = 1 , imm1
                     DO np1 = mp1 , ndo1 , 2
                        Br(mp1,np1,k) = Br(mp1,np1,k) + Zv(i,np1,iv)    &
                                      & *Vo(i,2*mp1-2,k) + Zw(i,np1,iw) &
                                      & *We(i,2*mp1-1,k)
                        Bi(mp1,np1,k) = Bi(mp1,np1,k) + Zv(i,np1,iv)    &
                                      & *Vo(i,2*mp1-1,k) - Zw(i,np1,iw) &
                                      & *We(i,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDDO
               IF ( mlat/=0 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp1 , ndo1 , 2
                        Br(mp1,np1,k) = Br(mp1,np1,k) + Zw(Imid,np1,iw) &
                                      & *We(Imid,2*mp1-1,k)
                        Bi(mp1,np1,k) = Bi(mp1,np1,k) - Zw(Imid,np1,iw) &
                                      & *We(Imid,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDIF
            ENDIF
         ENDDO
         RETURN
      ELSEIF ( itypp==9 ) THEN
!
!     case ityp=8   v odd, w even, and both br and bi equal zero
!
         CALL ZVIN(1,Nlat,Nlon,0,Zv,iv,Wzvin)
!
!     case m=0
!
         DO k = 1 , Nt
            DO i = 1 , Imid
               DO np1 = 2 , ndo2 , 2
                  Cr(1,np1,k) = Cr(1,np1,k) - Zv(i,np1,iv)*We(i,1,k)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax<2 ) RETURN
         DO mp1 = 2 , mmax
            m = mp1 - 1
            mp2 = mp1 + 1
            CALL ZVIN(1,Nlat,Nlon,m,Zv,iv,Wzvin)
            CALL ZWIN(1,Nlat,Nlon,m,Zw,iw,Wzwin)
            IF ( mp2<=ndo2 ) THEN
               DO k = 1 , Nt
                  DO i = 1 , imm1
                     DO np1 = mp2 , ndo2 , 2
                        Cr(mp1,np1,k) = Cr(mp1,np1,k) - Zv(i,np1,iv)    &
                                      & *We(i,2*mp1-2,k) + Zw(i,np1,iw) &
                                      & *Vo(i,2*mp1-1,k)
                        Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zv(i,np1,iv)    &
                                      & *We(i,2*mp1-1,k) - Zw(i,np1,iw) &
                                      & *Vo(i,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDDO
               IF ( mlat/=0 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        Cr(mp1,np1,k) = Cr(mp1,np1,k) - Zv(Imid,np1,iv) &
                                      & *We(Imid,2*mp1-2,k)
                        Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zv(Imid,np1,iv) &
                                      & *We(Imid,2*mp1-1,k)
                     ENDDO
                  ENDDO
               ENDIF
            ENDIF
         ENDDO
         GOTO 99999
      ENDIF
!
!     case ityp=0 ,  no symmetries
!
      CALL ZVIN(0,Nlat,Nlon,0,Zv,iv,Wzvin)
!
!     case m=0
!
      DO k = 1 , Nt
         DO i = 1 , Imid
            DO np1 = 2 , ndo2 , 2
               Br(1,np1,k) = Br(1,np1,k) + Zv(i,np1,iv)*Ve(i,1,k)
               Cr(1,np1,k) = Cr(1,np1,k) - Zv(i,np1,iv)*We(i,1,k)
            ENDDO
         ENDDO
      ENDDO
      DO k = 1 , Nt
         DO i = 1 , imm1
            DO np1 = 3 , ndo1 , 2
               Br(1,np1,k) = Br(1,np1,k) + Zv(i,np1,iv)*Vo(i,1,k)
               Cr(1,np1,k) = Cr(1,np1,k) - Zv(i,np1,iv)*Wo(i,1,k)
            ENDDO
         ENDDO
      ENDDO
!
!     case m = 1 through nlat-1
!
      IF ( mmax<2 ) RETURN
      DO mp1 = 2 , mmax
         m = mp1 - 1
         mp2 = mp1 + 1
         CALL ZVIN(0,Nlat,Nlon,m,Zv,iv,Wzvin)
         CALL ZWIN(0,Nlat,Nlon,m,Zw,iw,Wzwin)
         IF ( mp1<=ndo1 ) THEN
            DO k = 1 , Nt
               DO i = 1 , imm1
                  DO np1 = mp1 , ndo1 , 2
                     Br(mp1,np1,k) = Br(mp1,np1,k) + Zv(i,np1,iv)       &
                                   & *Vo(i,2*mp1-2,k) + Zw(i,np1,iw)    &
                                   & *We(i,2*mp1-1,k)
                     Bi(mp1,np1,k) = Bi(mp1,np1,k) + Zv(i,np1,iv)       &
                                   & *Vo(i,2*mp1-1,k) - Zw(i,np1,iw)    &
                                   & *We(i,2*mp1-2,k)
                     Cr(mp1,np1,k) = Cr(mp1,np1,k) - Zv(i,np1,iv)       &
                                   & *Wo(i,2*mp1-2,k) + Zw(i,np1,iw)    &
                                   & *Ve(i,2*mp1-1,k)
                     Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zv(i,np1,iv)       &
                                   & *Wo(i,2*mp1-1,k) - Zw(i,np1,iw)    &
                                   & *Ve(i,2*mp1-2,k)
                  ENDDO
               ENDDO
            ENDDO
            IF ( mlat/=0 ) THEN
               DO k = 1 , Nt
                  DO np1 = mp1 , ndo1 , 2
                     Br(mp1,np1,k) = Br(mp1,np1,k) + Zw(Imid,np1,iw)    &
                                   & *We(Imid,2*mp1-1,k)
                     Bi(mp1,np1,k) = Bi(mp1,np1,k) - Zw(Imid,np1,iw)    &
                                   & *We(Imid,2*mp1-2,k)
                     Cr(mp1,np1,k) = Cr(mp1,np1,k) + Zw(Imid,np1,iw)    &
                                   & *Ve(Imid,2*mp1-1,k)
                     Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zw(Imid,np1,iw)    &
                                   & *Ve(Imid,2*mp1-2,k)
                  ENDDO
               ENDDO
            ENDIF
         ENDIF
         IF ( mp2<=ndo2 ) THEN
            DO k = 1 , Nt
               DO i = 1 , imm1
                  DO np1 = mp2 , ndo2 , 2
                     Br(mp1,np1,k) = Br(mp1,np1,k) + Zv(i,np1,iv)       &
                                   & *Ve(i,2*mp1-2,k) + Zw(i,np1,iw)    &
                                   & *Wo(i,2*mp1-1,k)
                     Bi(mp1,np1,k) = Bi(mp1,np1,k) + Zv(i,np1,iv)       &
                                   & *Ve(i,2*mp1-1,k) - Zw(i,np1,iw)    &
                                   & *Wo(i,2*mp1-2,k)
                     Cr(mp1,np1,k) = Cr(mp1,np1,k) - Zv(i,np1,iv)       &
                                   & *We(i,2*mp1-2,k) + Zw(i,np1,iw)    &
                                   & *Vo(i,2*mp1-1,k)
                     Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zv(i,np1,iv)       &
                                   & *We(i,2*mp1-1,k) - Zw(i,np1,iw)    &
                                   & *Vo(i,2*mp1-2,k)
                  ENDDO
               ENDDO
            ENDDO
            IF ( mlat/=0 ) THEN
               DO k = 1 , Nt
                  DO np1 = mp2 , ndo2 , 2
                     Br(mp1,np1,k) = Br(mp1,np1,k) + Zv(Imid,np1,iv)    &
                                   & *Ve(Imid,2*mp1-2,k)
                     Bi(mp1,np1,k) = Bi(mp1,np1,k) + Zv(Imid,np1,iv)    &
                                   & *Ve(Imid,2*mp1-1,k)
                     Cr(mp1,np1,k) = Cr(mp1,np1,k) - Zv(Imid,np1,iv)    &
                                   & *We(Imid,2*mp1-2,k)
                     Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zv(Imid,np1,iv)    &
                                   & *We(Imid,2*mp1-1,k)
                  ENDDO
               ENDDO
            ENDIF
         ENDIF
      ENDDO
      RETURN
99999 END SUBROUTINE VHAEC1


      SUBROUTINE VHAECI(Nlat,Nlon,Wvhaec,Lvhaec,Dwork,Ldwork,Ierror)
      IMPLICIT NONE
      INTEGER Ierror , imid , iw1 , iw2 , labc , Ldwork , Lvhaec ,      &
            & lwzvin , lzz1 , mmax , Nlat , Nlon
      REAL Wvhaec
      DIMENSION Wvhaec(Lvhaec)
      DOUBLE PRECISION Dwork(Ldwork)
      Ierror = 1
      IF ( Nlat<3 ) RETURN
      Ierror = 2
      IF ( Nlon<1 ) RETURN
      Ierror = 3
      imid = (Nlat+1)/2
      lzz1 = 2*Nlat*imid
      mmax = MIN0(Nlat,(Nlon+1)/2)
      labc = 3*(MAX0(mmax-2,0)*(Nlat+Nlat-mmax-1))/2
      IF ( Lvhaec<2*(lzz1+labc)+Nlon+15 ) RETURN
      Ierror = 4
      IF ( Ldwork<2*Nlat+2 ) RETURN
      Ierror = 0
      CALL ZVINIT(Nlat,Nlon,Wvhaec,Dwork)
      lwzvin = lzz1 + labc
      iw1 = lwzvin + 1
      CALL ZWINIT(Nlat,Nlon,Wvhaec(iw1),Dwork)
      iw2 = iw1 + lwzvin
      CALL HRFFTI(Nlon,Wvhaec(iw2))
      END SUBROUTINE VHAECI


      SUBROUTINE DVHAEC(Nlat,Nlon,Ityp,Nt,V,W,Idvw,Jdvw,Br,Bi,Cr,Ci,Mdab,&
                     & Ndab,Wvhaec,Lvhaec,Work,Lwork,Ierror)
      IMPLICIT NONE
      DOUBLE PRECISION Bi , Br , Ci , Cr , V , W , Work , Wvhaec
      INTEGER idv , Idvw , Ierror , imid , ist , Ityp , iw1 , iw2 ,     &
            & iw3 , iw4 , iw5 , Jdvw , jw1 , jw2 , labc , lnl , Lvhaec ,&
            & Lwork , lwzvin , lzz1
      INTEGER Mdab , mmax , Ndab , Nlat , Nlon , Nt
      DIMENSION V(Idvw,Jdvw,1) , W(Idvw,Jdvw,1) , Br(Mdab,Ndab,1) ,     &
              & Bi(Mdab,Ndab,1) , Cr(Mdab,Ndab,1) , Ci(Mdab,Ndab,1) ,   &
              & Work(1) , Wvhaec(1)
      Ierror = 1
      IF ( Nlat<3 ) RETURN
      Ierror = 2
      IF ( Nlon<1 ) RETURN
      Ierror = 3
      IF ( Ityp<0 .OR. Ityp>8 ) RETURN
      Ierror = 4
      IF ( Nt<0 ) RETURN
      Ierror = 5
      imid = (Nlat+1)/2
      IF ( (Ityp<=2 .AND. Idvw<Nlat) .OR. (Ityp>2 .AND. Idvw<imid) )    &
         & RETURN
      Ierror = 6
      IF ( Jdvw<Nlon ) RETURN
      Ierror = 7
      mmax = MIN0(Nlat,(Nlon+1)/2)
      IF ( Mdab<mmax ) RETURN
      Ierror = 8
      IF ( Ndab<Nlat ) RETURN
      Ierror = 9
      lzz1 = 2*Nlat*imid
      labc = 3*(MAX0(mmax-2,0)*(Nlat+Nlat-mmax-1))/2
      IF ( Lvhaec<2*(lzz1+labc)+Nlon+15 ) RETURN
      Ierror = 10
      IF ( Ityp<=2 .AND. Lwork<Nlat*(2*Nt*Nlon+MAX0(6*imid,Nlon)) )     &
         & RETURN
      IF ( Ityp>2 .AND. Lwork<imid*(2*Nt*Nlon+MAX0(6*Nlat,Nlon)) )      &
         & RETURN
      Ierror = 0
      idv = Nlat
      IF ( Ityp>2 ) idv = imid
      lnl = Nt*idv*Nlon
      ist = 0
      IF ( Ityp<=2 ) ist = imid
      iw1 = ist + 1
      iw2 = lnl + 1
      iw3 = iw2 + ist
      iw4 = iw2 + lnl
      iw5 = iw4 + 3*imid*Nlat
      lwzvin = lzz1 + labc
      jw1 = lwzvin + 1
      jw2 = jw1 + lwzvin
      CALL DVHAEC1(Nlat,Nlon,Ityp,Nt,imid,Idvw,Jdvw,V,W,Mdab,Ndab,Br,Bi, &
                & Cr,Ci,idv,Work,Work(iw1),Work(iw2),Work(iw3),Work(iw4)&
                & ,Work(iw5),Wvhaec,Wvhaec(jw1),Wvhaec(jw2))
      END SUBROUTINE DVHAEC


      SUBROUTINE DVHAEC1(Nlat,Nlon,Ityp,Nt,Imid,Idvw,Jdvw,V,W,Mdab,Ndab, &
                      & Br,Bi,Cr,Ci,Idv,Ve,Vo,We,Wo,Zv,Zw,Wzvin,Wzwin,  &
                      & Wrfft)
      IMPLICIT NONE
      DOUBLE PRECISION Bi , Br , Ci , Cr , fsn , tsn , V , Ve , Vo , W , We , Wo ,  &
         & Wrfft , Wzvin , Wzwin , Zv , Zw
      INTEGER i , Idv , Idvw , Imid , imm1 , Ityp , itypp , iv , iw ,   &
            & j , Jdvw , k , m , Mdab , mlat , mlon , mmax , mp1 , mp2 ,&
            & Ndab
      INTEGER ndo1 , ndo2 , Nlat , Nlon , nlp1 , np1 , Nt
      DIMENSION V(Idvw,Jdvw,1) , W(Idvw,Jdvw,1) , Br(Mdab,Ndab,1) ,     &
              & Bi(Mdab,Ndab,1) , Cr(Mdab,Ndab,1) , Ci(Mdab,Ndab,1) ,   &
              & Ve(Idv,Nlon,1) , Vo(Idv,Nlon,1) , We(Idv,Nlon,1) ,      &
              & Wo(Idv,Nlon,1) , Wzvin(1) , Wzwin(1) , Wrfft(1) ,       &
              & Zv(Imid,Nlat,3) , Zw(Imid,Nlat,3)
      nlp1 = Nlat + 1
      tsn = 2./Nlon
      fsn = 4./Nlon
      mlat = MOD(Nlat,2)
      mlon = MOD(Nlon,2)
      mmax = MIN0(Nlat,(Nlon+1)/2)
      imm1 = Imid
      IF ( mlat/=0 ) imm1 = Imid - 1
      IF ( Ityp>2 ) THEN
         DO k = 1 , Nt
            DO i = 1 , imm1
               DO j = 1 , Nlon
                  Ve(i,j,k) = fsn*V(i,j,k)
                  Vo(i,j,k) = fsn*V(i,j,k)
                  We(i,j,k) = fsn*W(i,j,k)
                  Wo(i,j,k) = fsn*W(i,j,k)
               ENDDO
            ENDDO
         ENDDO
      ELSE
         DO k = 1 , Nt
            DO i = 1 , imm1
               DO j = 1 , Nlon
                  Ve(i,j,k) = tsn*(V(i,j,k)+V(nlp1-i,j,k))
                  Vo(i,j,k) = tsn*(V(i,j,k)-V(nlp1-i,j,k))
                  We(i,j,k) = tsn*(W(i,j,k)+W(nlp1-i,j,k))
                  Wo(i,j,k) = tsn*(W(i,j,k)-W(nlp1-i,j,k))
               ENDDO
            ENDDO
         ENDDO
      ENDIF
      IF ( mlat/=0 ) THEN
         DO k = 1 , Nt
            DO j = 1 , Nlon
               Ve(Imid,j,k) = tsn*V(Imid,j,k)
               We(Imid,j,k) = tsn*W(Imid,j,k)
            ENDDO
         ENDDO
      ENDIF
      DO k = 1 , Nt
         CALL DHRFFTF(Idv,Nlon,Ve(1,1,k),Idv,Wrfft,Zv)
         CALL DHRFFTF(Idv,Nlon,We(1,1,k),Idv,Wrfft,Zv)
      ENDDO
      ndo1 = Nlat
      ndo2 = Nlat
      IF ( mlat/=0 ) ndo1 = Nlat - 1
      IF ( mlat==0 ) ndo2 = Nlat - 1
      IF ( Ityp/=2 .AND. Ityp/=5 .AND. Ityp/=8 ) THEN
         DO k = 1 , Nt
            DO mp1 = 1 , mmax
               DO np1 = mp1 , Nlat
                  Br(mp1,np1,k) = 0.
                  Bi(mp1,np1,k) = 0.
               ENDDO
            ENDDO
         ENDDO
      ENDIF
      IF ( Ityp/=1 .AND. Ityp/=4 .AND. Ityp/=7 ) THEN
         DO k = 1 , Nt
            DO mp1 = 1 , mmax
               DO np1 = mp1 , Nlat
                  Cr(mp1,np1,k) = 0.
                  Ci(mp1,np1,k) = 0.
               ENDDO
            ENDDO
         ENDDO
      ENDIF
      itypp = Ityp + 1
      IF ( itypp==2 ) THEN
!
!     case ityp=1 ,  no symmetries but cr and ci equal zero
!
         CALL DZVIN(0,Nlat,Nlon,0,Zv,iv,Wzvin)
!
!     case m=0
!
         DO k = 1 , Nt
            DO i = 1 , Imid
               DO np1 = 2 , ndo2 , 2
                  Br(1,np1,k) = Br(1,np1,k) + Zv(i,np1,iv)*Ve(i,1,k)
               ENDDO
            ENDDO
         ENDDO
         DO k = 1 , Nt
            DO i = 1 , imm1
               DO np1 = 3 , ndo1 , 2
                  Br(1,np1,k) = Br(1,np1,k) + Zv(i,np1,iv)*Vo(i,1,k)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax<2 ) RETURN
         DO mp1 = 2 , mmax
            m = mp1 - 1
            mp2 = mp1 + 1
            CALL DZVIN(0,Nlat,Nlon,m,Zv,iv,Wzvin)
            CALL DZWIN(0,Nlat,Nlon,m,Zw,iw,Wzwin)
            IF ( mp1<=ndo1 ) THEN
               DO k = 1 , Nt
                  DO i = 1 , imm1
                     DO np1 = mp1 , ndo1 , 2
                        Br(mp1,np1,k) = Br(mp1,np1,k) + Zv(i,np1,iv)    &
                                      & *Vo(i,2*mp1-2,k) + Zw(i,np1,iw) &
                                      & *We(i,2*mp1-1,k)
                        Bi(mp1,np1,k) = Bi(mp1,np1,k) + Zv(i,np1,iv)    &
                                      & *Vo(i,2*mp1-1,k) - Zw(i,np1,iw) &
                                      & *We(i,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDDO
               IF ( mlat/=0 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp1 , ndo1 , 2
                        Br(mp1,np1,k) = Br(mp1,np1,k) + Zw(Imid,np1,iw) &
                                      & *We(Imid,2*mp1-1,k)
                        Bi(mp1,np1,k) = Bi(mp1,np1,k) - Zw(Imid,np1,iw) &
                                      & *We(Imid,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDIF
            ENDIF
            IF ( mp2<=ndo2 ) THEN
               DO k = 1 , Nt
                  DO i = 1 , imm1
                     DO np1 = mp2 , ndo2 , 2
                        Br(mp1,np1,k) = Br(mp1,np1,k) + Zv(i,np1,iv)    &
                                      & *Ve(i,2*mp1-2,k) + Zw(i,np1,iw) &
                                      & *Wo(i,2*mp1-1,k)
                        Bi(mp1,np1,k) = Bi(mp1,np1,k) + Zv(i,np1,iv)    &
                                      & *Ve(i,2*mp1-1,k) - Zw(i,np1,iw) &
                                      & *Wo(i,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDDO
               IF ( mlat/=0 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        Br(mp1,np1,k) = Br(mp1,np1,k) + Zv(Imid,np1,iv) &
                                      & *Ve(Imid,2*mp1-2,k)
                        Bi(mp1,np1,k) = Bi(mp1,np1,k) + Zv(Imid,np1,iv) &
                                      & *Ve(Imid,2*mp1-1,k)
                     ENDDO
                  ENDDO
               ENDIF
            ENDIF
         ENDDO
         RETURN
      ELSEIF ( itypp==3 ) THEN
!
!     case ityp=2 ,  no symmetries but br and bi equal zero
!
         CALL DZVIN(0,Nlat,Nlon,0,Zv,iv,Wzvin)
!
!     case m=0
!
         DO k = 1 , Nt
            DO i = 1 , Imid
               DO np1 = 2 , ndo2 , 2
                  Cr(1,np1,k) = Cr(1,np1,k) - Zv(i,np1,iv)*We(i,1,k)
               ENDDO
            ENDDO
         ENDDO
         DO k = 1 , Nt
            DO i = 1 , imm1
               DO np1 = 3 , ndo1 , 2
                  Cr(1,np1,k) = Cr(1,np1,k) - Zv(i,np1,iv)*Wo(i,1,k)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax<2 ) RETURN
         DO mp1 = 2 , mmax
            m = mp1 - 1
            mp2 = mp1 + 1
            CALL DZVIN(0,Nlat,Nlon,m,Zv,iv,Wzvin)
            CALL DZWIN(0,Nlat,Nlon,m,Zw,iw,Wzwin)
            IF ( mp1<=ndo1 ) THEN
               DO k = 1 , Nt
                  DO i = 1 , imm1
                     DO np1 = mp1 , ndo1 , 2
                        Cr(mp1,np1,k) = Cr(mp1,np1,k) - Zv(i,np1,iv)    &
                                      & *Wo(i,2*mp1-2,k) + Zw(i,np1,iw) &
                                      & *Ve(i,2*mp1-1,k)
                        Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zv(i,np1,iv)    &
                                      & *Wo(i,2*mp1-1,k) - Zw(i,np1,iw) &
                                      & *Ve(i,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDDO
               IF ( mlat/=0 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp1 , ndo1 , 2
                        Cr(mp1,np1,k) = Cr(mp1,np1,k) + Zw(Imid,np1,iw) &
                                      & *Ve(Imid,2*mp1-1,k)
                        Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zw(Imid,np1,iw) &
                                      & *Ve(Imid,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDIF
            ENDIF
            IF ( mp2<=ndo2 ) THEN
               DO k = 1 , Nt
                  DO i = 1 , imm1
                     DO np1 = mp2 , ndo2 , 2
                        Cr(mp1,np1,k) = Cr(mp1,np1,k) - Zv(i,np1,iv)    &
                                      & *We(i,2*mp1-2,k) + Zw(i,np1,iw) &
                                      & *Vo(i,2*mp1-1,k)
                        Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zv(i,np1,iv)    &
                                      & *We(i,2*mp1-1,k) - Zw(i,np1,iw) &
                                      & *Vo(i,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDDO
               IF ( mlat/=0 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        Cr(mp1,np1,k) = Cr(mp1,np1,k) - Zv(Imid,np1,iv) &
                                      & *We(Imid,2*mp1-2,k)
                        Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zv(Imid,np1,iv) &
                                      & *We(Imid,2*mp1-1,k)
                     ENDDO
                  ENDDO
               ENDIF
            ENDIF
         ENDDO
         RETURN
      ELSEIF ( itypp==4 ) THEN
!
!     case ityp=3 ,  v even , w odd
!
         CALL DZVIN(0,Nlat,Nlon,0,Zv,iv,Wzvin)
!
!     case m=0
!
         DO k = 1 , Nt
            DO i = 1 , Imid
               DO np1 = 2 , ndo2 , 2
                  Br(1,np1,k) = Br(1,np1,k) + Zv(i,np1,iv)*Ve(i,1,k)
               ENDDO
            ENDDO
         ENDDO
         DO k = 1 , Nt
            DO i = 1 , imm1
               DO np1 = 3 , ndo1 , 2
                  Cr(1,np1,k) = Cr(1,np1,k) - Zv(i,np1,iv)*Wo(i,1,k)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax<2 ) RETURN
         DO mp1 = 2 , mmax
            m = mp1 - 1
            mp2 = mp1 + 1
            CALL DZVIN(0,Nlat,Nlon,m,Zv,iv,Wzvin)
            CALL DZWIN(0,Nlat,Nlon,m,Zw,iw,Wzwin)
            IF ( mp1<=ndo1 ) THEN
               DO k = 1 , Nt
                  DO i = 1 , imm1
                     DO np1 = mp1 , ndo1 , 2
                        Cr(mp1,np1,k) = Cr(mp1,np1,k) - Zv(i,np1,iv)    &
                                      & *Wo(i,2*mp1-2,k) + Zw(i,np1,iw) &
                                      & *Ve(i,2*mp1-1,k)
                        Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zv(i,np1,iv)    &
                                      & *Wo(i,2*mp1-1,k) - Zw(i,np1,iw) &
                                      & *Ve(i,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDDO
               IF ( mlat/=0 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp1 , ndo1 , 2
                        Cr(mp1,np1,k) = Cr(mp1,np1,k) + Zw(Imid,np1,iw) &
                                      & *Ve(Imid,2*mp1-1,k)
                        Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zw(Imid,np1,iw) &
                                      & *Ve(Imid,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDIF
            ENDIF
            IF ( mp2<=ndo2 ) THEN
               DO k = 1 , Nt
                  DO i = 1 , imm1
                     DO np1 = mp2 , ndo2 , 2
                        Br(mp1,np1,k) = Br(mp1,np1,k) + Zv(i,np1,iv)    &
                                      & *Ve(i,2*mp1-2,k) + Zw(i,np1,iw) &
                                      & *Wo(i,2*mp1-1,k)
                        Bi(mp1,np1,k) = Bi(mp1,np1,k) + Zv(i,np1,iv)    &
                                      & *Ve(i,2*mp1-1,k) - Zw(i,np1,iw) &
                                      & *Wo(i,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDDO
               IF ( mlat/=0 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        Br(mp1,np1,k) = Br(mp1,np1,k) + Zv(Imid,np1,iv) &
                                      & *Ve(Imid,2*mp1-2,k)
                        Bi(mp1,np1,k) = Bi(mp1,np1,k) + Zv(Imid,np1,iv) &
                                      & *Ve(Imid,2*mp1-1,k)
                     ENDDO
                  ENDDO
               ENDIF
            ENDIF
         ENDDO
         RETURN
      ELSEIF ( itypp==5 ) THEN
!
!     case ityp=4 ,  v even, w odd, and cr and ci equal 0.
!
         CALL DZVIN(1,Nlat,Nlon,0,Zv,iv,Wzvin)
!
!     case m=0
!
         DO k = 1 , Nt
            DO i = 1 , Imid
               DO np1 = 2 , ndo2 , 2
                  Br(1,np1,k) = Br(1,np1,k) + Zv(i,np1,iv)*Ve(i,1,k)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax<2 ) RETURN
         DO mp1 = 2 , mmax
            m = mp1 - 1
            mp2 = mp1 + 1
            CALL DZVIN(1,Nlat,Nlon,m,Zv,iv,Wzvin)
            CALL DZWIN(1,Nlat,Nlon,m,Zw,iw,Wzwin)
            IF ( mp2<=ndo2 ) THEN
               DO k = 1 , Nt
                  DO i = 1 , imm1
                     DO np1 = mp2 , ndo2 , 2
                        Br(mp1,np1,k) = Br(mp1,np1,k) + Zv(i,np1,iv)    &
                                      & *Ve(i,2*mp1-2,k) + Zw(i,np1,iw) &
                                      & *Wo(i,2*mp1-1,k)
                        Bi(mp1,np1,k) = Bi(mp1,np1,k) + Zv(i,np1,iv)    &
                                      & *Ve(i,2*mp1-1,k) - Zw(i,np1,iw) &
                                      & *Wo(i,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDDO
               IF ( mlat/=0 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        Br(mp1,np1,k) = Br(mp1,np1,k) + Zv(Imid,np1,iv) &
                                      & *Ve(Imid,2*mp1-2,k)
                        Bi(mp1,np1,k) = Bi(mp1,np1,k) + Zv(Imid,np1,iv) &
                                      & *Ve(Imid,2*mp1-1,k)
                     ENDDO
                  ENDDO
               ENDIF
            ENDIF
         ENDDO
         RETURN
      ELSEIF ( itypp==6 ) THEN
!
!     case ityp=5   v even, w odd, and br and bi equal zero
!
         CALL DZVIN(2,Nlat,Nlon,0,Zv,iv,Wzvin)
!
!     case m=0
!
         DO k = 1 , Nt
            DO i = 1 , imm1
               DO np1 = 3 , ndo1 , 2
                  Cr(1,np1,k) = Cr(1,np1,k) - Zv(i,np1,iv)*Wo(i,1,k)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax<2 ) RETURN
         DO mp1 = 2 , mmax
            m = mp1 - 1
            mp2 = mp1 + 1
            CALL DZVIN(2,Nlat,Nlon,m,Zv,iv,Wzvin)
            CALL DZWIN(2,Nlat,Nlon,m,Zw,iw,Wzwin)
            IF ( mp1<=ndo1 ) THEN
               DO k = 1 , Nt
                  DO i = 1 , imm1
                     DO np1 = mp1 , ndo1 , 2
                        Cr(mp1,np1,k) = Cr(mp1,np1,k) - Zv(i,np1,iv)    &
                                      & *Wo(i,2*mp1-2,k) + Zw(i,np1,iw) &
                                      & *Ve(i,2*mp1-1,k)
                        Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zv(i,np1,iv)    &
                                      & *Wo(i,2*mp1-1,k) - Zw(i,np1,iw) &
                                      & *Ve(i,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDDO
               IF ( mlat/=0 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp1 , ndo1 , 2
                        Cr(mp1,np1,k) = Cr(mp1,np1,k) + Zw(Imid,np1,iw) &
                                      & *Ve(Imid,2*mp1-1,k)
                        Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zw(Imid,np1,iw) &
                                      & *Ve(Imid,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDIF
            ENDIF
         ENDDO
         RETURN
      ELSEIF ( itypp==7 ) THEN
!
!     case ityp=6 ,  v odd , w even
!
         CALL DZVIN(0,Nlat,Nlon,0,Zv,iv,Wzvin)
!
!     case m=0
!
         DO k = 1 , Nt
            DO i = 1 , Imid
               DO np1 = 2 , ndo2 , 2
                  Cr(1,np1,k) = Cr(1,np1,k) - Zv(i,np1,iv)*We(i,1,k)
               ENDDO
            ENDDO
         ENDDO
         DO k = 1 , Nt
            DO i = 1 , imm1
               DO np1 = 3 , ndo1 , 2
                  Br(1,np1,k) = Br(1,np1,k) + Zv(i,np1,iv)*Vo(i,1,k)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax<2 ) RETURN
         DO mp1 = 2 , mmax
            m = mp1 - 1
            mp2 = mp1 + 1
            CALL DZVIN(0,Nlat,Nlon,m,Zv,iv,Wzvin)
            CALL DZWIN(0,Nlat,Nlon,m,Zw,iw,Wzwin)
            IF ( mp1<=ndo1 ) THEN
               DO k = 1 , Nt
                  DO i = 1 , imm1
                     DO np1 = mp1 , ndo1 , 2
                        Br(mp1,np1,k) = Br(mp1,np1,k) + Zv(i,np1,iv)    &
                                      & *Vo(i,2*mp1-2,k) + Zw(i,np1,iw) &
                                      & *We(i,2*mp1-1,k)
                        Bi(mp1,np1,k) = Bi(mp1,np1,k) + Zv(i,np1,iv)    &
                                      & *Vo(i,2*mp1-1,k) - Zw(i,np1,iw) &
                                      & *We(i,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDDO
               IF ( mlat/=0 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp1 , ndo1 , 2
                        Br(mp1,np1,k) = Br(mp1,np1,k) + Zw(Imid,np1,iw) &
                                      & *We(Imid,2*mp1-1,k)
                        Bi(mp1,np1,k) = Bi(mp1,np1,k) - Zw(Imid,np1,iw) &
                                      & *We(Imid,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDIF
            ENDIF
            IF ( mp2<=ndo2 ) THEN
               DO k = 1 , Nt
                  DO i = 1 , imm1
                     DO np1 = mp2 , ndo2 , 2
                        Cr(mp1,np1,k) = Cr(mp1,np1,k) - Zv(i,np1,iv)    &
                                      & *We(i,2*mp1-2,k) + Zw(i,np1,iw) &
                                      & *Vo(i,2*mp1-1,k)
                        Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zv(i,np1,iv)    &
                                      & *We(i,2*mp1-1,k) - Zw(i,np1,iw) &
                                      & *Vo(i,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDDO
               IF ( mlat/=0 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        Cr(mp1,np1,k) = Cr(mp1,np1,k) - Zv(Imid,np1,iv) &
                                      & *We(Imid,2*mp1-2,k)
                        Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zv(Imid,np1,iv) &
                                      & *We(Imid,2*mp1-1,k)
                     ENDDO
                  ENDDO
               ENDIF
            ENDIF
         ENDDO
         RETURN
      ELSEIF ( itypp==8 ) THEN
!
!     case ityp=7   v odd, w even, and cr and ci equal zero
!
         CALL DZVIN(2,Nlat,Nlon,0,Zv,iv,Wzvin)
!
!     case m=0
!
         DO k = 1 , Nt
            DO i = 1 , imm1
               DO np1 = 3 , ndo1 , 2
                  Br(1,np1,k) = Br(1,np1,k) + Zv(i,np1,iv)*Vo(i,1,k)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax<2 ) RETURN
         DO mp1 = 2 , mmax
            m = mp1 - 1
            mp2 = mp1 + 1
            CALL DZVIN(2,Nlat,Nlon,m,Zv,iv,Wzvin)
            CALL DZWIN(2,Nlat,Nlon,m,Zw,iw,Wzwin)
            IF ( mp1<=ndo1 ) THEN
               DO k = 1 , Nt
                  DO i = 1 , imm1
                     DO np1 = mp1 , ndo1 , 2
                        Br(mp1,np1,k) = Br(mp1,np1,k) + Zv(i,np1,iv)    &
                                      & *Vo(i,2*mp1-2,k) + Zw(i,np1,iw) &
                                      & *We(i,2*mp1-1,k)
                        Bi(mp1,np1,k) = Bi(mp1,np1,k) + Zv(i,np1,iv)    &
                                      & *Vo(i,2*mp1-1,k) - Zw(i,np1,iw) &
                                      & *We(i,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDDO
               IF ( mlat/=0 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp1 , ndo1 , 2
                        Br(mp1,np1,k) = Br(mp1,np1,k) + Zw(Imid,np1,iw) &
                                      & *We(Imid,2*mp1-1,k)
                        Bi(mp1,np1,k) = Bi(mp1,np1,k) - Zw(Imid,np1,iw) &
                                      & *We(Imid,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDIF
            ENDIF
         ENDDO
         RETURN
      ELSEIF ( itypp==9 ) THEN
!
!     case ityp=8   v odd, w even, and both br and bi equal zero
!
         CALL DZVIN(1,Nlat,Nlon,0,Zv,iv,Wzvin)
!
!     case m=0
!
         DO k = 1 , Nt
            DO i = 1 , Imid
               DO np1 = 2 , ndo2 , 2
                  Cr(1,np1,k) = Cr(1,np1,k) - Zv(i,np1,iv)*We(i,1,k)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax<2 ) RETURN
         DO mp1 = 2 , mmax
            m = mp1 - 1
            mp2 = mp1 + 1
            CALL DZVIN(1,Nlat,Nlon,m,Zv,iv,Wzvin)
            CALL DZWIN(1,Nlat,Nlon,m,Zw,iw,Wzwin)
            IF ( mp2<=ndo2 ) THEN
               DO k = 1 , Nt
                  DO i = 1 , imm1
                     DO np1 = mp2 , ndo2 , 2
                        Cr(mp1,np1,k) = Cr(mp1,np1,k) - Zv(i,np1,iv)    &
                                      & *We(i,2*mp1-2,k) + Zw(i,np1,iw) &
                                      & *Vo(i,2*mp1-1,k)
                        Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zv(i,np1,iv)    &
                                      & *We(i,2*mp1-1,k) - Zw(i,np1,iw) &
                                      & *Vo(i,2*mp1-2,k)
                     ENDDO
                  ENDDO
               ENDDO
               IF ( mlat/=0 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        Cr(mp1,np1,k) = Cr(mp1,np1,k) - Zv(Imid,np1,iv) &
                                      & *We(Imid,2*mp1-2,k)
                        Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zv(Imid,np1,iv) &
                                      & *We(Imid,2*mp1-1,k)
                     ENDDO
                  ENDDO
               ENDIF
            ENDIF
         ENDDO
         GOTO 99999
      ENDIF
!
!     case ityp=0 ,  no symmetries
!
      CALL DZVIN(0,Nlat,Nlon,0,Zv,iv,Wzvin)
!
!     case m=0
!
      DO k = 1 , Nt
         DO i = 1 , Imid
            DO np1 = 2 , ndo2 , 2
               Br(1,np1,k) = Br(1,np1,k) + Zv(i,np1,iv)*Ve(i,1,k)
               Cr(1,np1,k) = Cr(1,np1,k) - Zv(i,np1,iv)*We(i,1,k)
            ENDDO
         ENDDO
      ENDDO
      DO k = 1 , Nt
         DO i = 1 , imm1
            DO np1 = 3 , ndo1 , 2
               Br(1,np1,k) = Br(1,np1,k) + Zv(i,np1,iv)*Vo(i,1,k)
               Cr(1,np1,k) = Cr(1,np1,k) - Zv(i,np1,iv)*Wo(i,1,k)
            ENDDO
         ENDDO
      ENDDO
!
!     case m = 1 through nlat-1
!
      IF ( mmax<2 ) RETURN
      DO mp1 = 2 , mmax
         m = mp1 - 1
         mp2 = mp1 + 1
         CALL DZVIN(0,Nlat,Nlon,m,Zv,iv,Wzvin)
         CALL DZWIN(0,Nlat,Nlon,m,Zw,iw,Wzwin)
         IF ( mp1<=ndo1 ) THEN
            DO k = 1 , Nt
               DO i = 1 , imm1
                  DO np1 = mp1 , ndo1 , 2
                     Br(mp1,np1,k) = Br(mp1,np1,k) + Zv(i,np1,iv)       &
                                   & *Vo(i,2*mp1-2,k) + Zw(i,np1,iw)    &
                                   & *We(i,2*mp1-1,k)
                     Bi(mp1,np1,k) = Bi(mp1,np1,k) + Zv(i,np1,iv)       &
                                   & *Vo(i,2*mp1-1,k) - Zw(i,np1,iw)    &
                                   & *We(i,2*mp1-2,k)
                     Cr(mp1,np1,k) = Cr(mp1,np1,k) - Zv(i,np1,iv)       &
                                   & *Wo(i,2*mp1-2,k) + Zw(i,np1,iw)    &
                                   & *Ve(i,2*mp1-1,k)
                     Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zv(i,np1,iv)       &
                                   & *Wo(i,2*mp1-1,k) - Zw(i,np1,iw)    &
                                   & *Ve(i,2*mp1-2,k)
                  ENDDO
               ENDDO
            ENDDO
            IF ( mlat/=0 ) THEN
               DO k = 1 , Nt
                  DO np1 = mp1 , ndo1 , 2
                     Br(mp1,np1,k) = Br(mp1,np1,k) + Zw(Imid,np1,iw)    &
                                   & *We(Imid,2*mp1-1,k)
                     Bi(mp1,np1,k) = Bi(mp1,np1,k) - Zw(Imid,np1,iw)    &
                                   & *We(Imid,2*mp1-2,k)
                     Cr(mp1,np1,k) = Cr(mp1,np1,k) + Zw(Imid,np1,iw)    &
                                   & *Ve(Imid,2*mp1-1,k)
                     Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zw(Imid,np1,iw)    &
                                   & *Ve(Imid,2*mp1-2,k)
                  ENDDO
               ENDDO
            ENDIF
         ENDIF
         IF ( mp2<=ndo2 ) THEN
            DO k = 1 , Nt
               DO i = 1 , imm1
                  DO np1 = mp2 , ndo2 , 2
                     Br(mp1,np1,k) = Br(mp1,np1,k) + Zv(i,np1,iv)       &
                                   & *Ve(i,2*mp1-2,k) + Zw(i,np1,iw)    &
                                   & *Wo(i,2*mp1-1,k)
                     Bi(mp1,np1,k) = Bi(mp1,np1,k) + Zv(i,np1,iv)       &
                                   & *Ve(i,2*mp1-1,k) - Zw(i,np1,iw)    &
                                   & *Wo(i,2*mp1-2,k)
                     Cr(mp1,np1,k) = Cr(mp1,np1,k) - Zv(i,np1,iv)       &
                                   & *We(i,2*mp1-2,k) + Zw(i,np1,iw)    &
                                   & *Vo(i,2*mp1-1,k)
                     Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zv(i,np1,iv)       &
                                   & *We(i,2*mp1-1,k) - Zw(i,np1,iw)    &
                                   & *Vo(i,2*mp1-2,k)
                  ENDDO
               ENDDO
            ENDDO
            IF ( mlat/=0 ) THEN
               DO k = 1 , Nt
                  DO np1 = mp2 , ndo2 , 2
                     Br(mp1,np1,k) = Br(mp1,np1,k) + Zv(Imid,np1,iv)    &
                                   & *Ve(Imid,2*mp1-2,k)
                     Bi(mp1,np1,k) = Bi(mp1,np1,k) + Zv(Imid,np1,iv)    &
                                   & *Ve(Imid,2*mp1-1,k)
                     Cr(mp1,np1,k) = Cr(mp1,np1,k) - Zv(Imid,np1,iv)    &
                                   & *We(Imid,2*mp1-2,k)
                     Ci(mp1,np1,k) = Ci(mp1,np1,k) - Zv(Imid,np1,iv)    &
                                   & *We(Imid,2*mp1-1,k)
                  ENDDO
               ENDDO
            ENDIF
         ENDIF
      ENDDO
      RETURN
99999 END SUBROUTINE DVHAEC1


      SUBROUTINE DVHAECI(Nlat,Nlon,Wvhaec,Lvhaec,Dwork,Ldwork,Ierror)
      IMPLICIT NONE
      INTEGER Ierror , imid , iw1 , iw2 , labc , Ldwork , Lvhaec ,      &
            & lwzvin , lzz1 , mmax , Nlat , Nlon
      DOUBLE PRECISION Wvhaec
      DIMENSION Wvhaec(Lvhaec)
      DOUBLE PRECISION Dwork(Ldwork)
      Ierror = 1
      IF ( Nlat<3 ) RETURN
      Ierror = 2
      IF ( Nlon<1 ) RETURN
      Ierror = 3
      imid = (Nlat+1)/2
      lzz1 = 2*Nlat*imid
      mmax = MIN0(Nlat,(Nlon+1)/2)
      labc = 3*(MAX0(mmax-2,0)*(Nlat+Nlat-mmax-1))/2
      IF ( Lvhaec<2*(lzz1+labc)+Nlon+15 ) RETURN
      Ierror = 4
      IF ( Ldwork<2*Nlat+2 ) RETURN
      Ierror = 0
      CALL DZVINIT(Nlat,Nlon,Wvhaec,Dwork)
      lwzvin = lzz1 + labc
      iw1 = lwzvin + 1
      CALL DZWINIT(Nlat,Nlon,Wvhaec(iw1),Dwork)
      iw2 = iw1 + lwzvin
      CALL DHRFFTI(Nlon,Wvhaec(iw2))
      END SUBROUTINE DVHAECI
