!  . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
!  .                                                             .
!  .                  copyright (c) 1998 by UCAR                 .
!  .                                                             .
!  .       University Corporation for Atmospheric Research       .
!  .                                                             .
!  .                      all rights reserved                    .
!  .                                                             .
!  .                                                             .
!  .                         SPHEREPACK3.0                       .
!  .                                                             .
!  . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
!
!
!
! ... file vtsgc.f
!
!     this file includes documentation and code for
!     subroutines vtsgc and vtsgci
!
! ... files which must be loaded with vtsgc.f
!
!     sphcom.f, hrfft.f, vhagc.f, vhsgc.f,gaqd.f
!
!
!     subroutine vtsgc(nlat,nlon,ityp,nt,vt,wt,idvw,jdvw,br,bi,cr,ci,
!    +                 mdab,ndab,wvts,lwvts,work,lwork,ierror)
!
!     given the vector harmonic analysis br,bi,cr, and ci (computed
!     by subroutine vhagc) of some vector function (v,w), this
!     subroutine computes the vector function (vt,wt) which is
!     the derivative of (v,w) with respect to colatitude theta. vtsgc
!     is similar to vhsgc except the vector harmonics are replaced by
!     their derivative with respect to colatitude with the result that
!     (vt,wt) is computed instead of (v,w). vt(i,j) is the derivative
!     of the colatitudinal component v(i,j) at the gaussian colatitude
!     theta(i) and longitude phi(j) = (j-1)*2*pi/nlon. the spectral
!     representation of (vt,wt) is given below at the definition of
!     output parameters vt,wt.
!
!     input parameters
!
!     nlat   the number of gaussian colatitudinal grid points theta(i)
!            such that 0 < theta(1) <...< theta(nlat) < pi. they are
!            computed by subroutine gaqd which is called by this
!            subroutine. if nlat is odd the equator is
!            theta((nlat+1)/2). if nlat is even the equator lies
!            half way between theta(nlat/2) and theta(nlat/2+1). nlat
!            must be at least 3. note: if (v,w) is symmetric about
!            the equator (see parameter ityp below) the number of
!            colatitudinal grid points 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 synthesis
!                 is performed on the entire sphere. i.e. the arrays
!                 vt(i,j),wt(i,j) are computed for i=1,...,nlat and
!                 j=1,...,nlon.
!
!            = 1  no symmetries exist about the equator however the
!                 the coefficients cr and ci are zero which implies
!                 that the curl of (v,w) is zero. that is,
!                 (d/dtheta (sin(theta) w) - dv/dphi)/sin(theta) = 0.
!                 the calculations are performed on the entire sphere.
!                 i.e. the arrays vt(i,j),wt(i,j) are computed for
!                 i=1,...,nlat and j=1,...,nlon.
!
!            = 2  no symmetries exist about the equator however the
!                 the coefficients br and bi are zero which implies
!                 that the divergence of (v,w) is zero. that is,
!                 (d/dtheta (sin(theta) v) + dw/dphi)/sin(theta) = 0.
!                 the calculations are performed on the entire sphere.
!                 i.e. the arrays vt(i,j),wt(i,j) are computed for
!                 i=1,...,nlat and j=1,...,nlon.
!
!            = 3  vt is odd and wt is even about the equator. the
!                 synthesis is performed on the northern hemisphere
!                 only.  i.e., if nlat is odd the arrays vt(i,j)
!                 and wt(i,j) are computed for i=1,...,(nlat+1)/2
!                 and j=1,...,nlon. if nlat is even the arrays
!                 are computed for i=1,...,nlat/2 and j=1,...,nlon.
!
!            = 4  vt is odd and wt is even about the equator and the
!                 coefficients cr and ci are zero. the synthesis is
!                 performed on the northern hemisphere only. i.e. if
!                 nlat is odd the arrays vt(i,j),wt(i,j) are computed
!                 for i=1,...,(nlat+1)/2 and j=1,...,nlon. if nlat is
!                 even the arrays vt(i,j),wt(i,j) are computed for
!                 i=1,...,nlat/2 and j=1,...,nlon.
!
!            = 5  vt is odd and wt is even about the equator and the
!                 coefficients br and bi are zero. the synthesis is
!                 performed on the northern hemisphere only. i.e. if
!                 nlat is odd the arrays vt(i,j),wt(i,j) are computed
!                 for i=1,...,(nlat+1)/2 and j=1,...,nlon. if nlat is
!                 even the arrays vt(i,j),wt(i,j) are computed for
!                 i=1,...,nlat/2 and j=1,...,nlon.
!
!            = 6  vt is even and wt is odd about the equator. the
!                 synthesis is performed on the northern hemisphere
!                 only.  i.e., if nlat is odd the arrays vt(i,j),wt(i,j)
!                 are computed for i=1,...,(nlat+1)/2 and j=1,...,nlon.
!                 if nlat is even the arrays vt(i,j),wt(i,j) are computed
!                 for i=1,...,nlat/2 and j=1,...,nlon.
!
!            = 7  vt is even and wt is odd about the equator and the
!                 coefficients cr and ci are zero. the synthesis is
!                 performed on the northern hemisphere only. i.e. if
!                 nlat is odd the arrays vt(i,j),wt(i,j) are computed
!                 for i=1,...,(nlat+1)/2 and j=1,...,nlon. if nlat is
!                 even the arrays vt(i,j),wt(i,j) are computed for
!                 i=1,...,nlat/2 and j=1,...,nlon.
!
!            = 8  vt is even and wt is odd about the equator and the
!                 coefficients br and bi are zero. the synthesis is
!                 performed on the northern hemisphere only. i.e. if
!                 nlat is odd the arrays vt(i,j),wt(i,j) are computed
!                 for i=1,...,(nlat+1)/2 and j=1,...,nlon. if nlat is
!                 even the arrays vt(i,j),wt(i,j) are computed for
!                 i=1,...,nlat/2 and j=1,...,nlon.
!
!     nt     the number of syntheses.  in the program that calls vtsgc,
!            the arrays vt,wt,br,bi,cr, and ci can be three dimensional
!            in which case multiple syntheses will be performed.
!            the third index is the synthesis index which assumes the
!            values k=1,...,nt.  for a single synthesis set nt=1. the
!            discription of the remaining parameters is simplified
!            by assuming that nt=1 or that all the arrays are two
!            dimensional.
!
!     idvw   the first dimension of the arrays vt,wt as it appears in
!            the program that calls vtsgc. 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 vt,wt as it appears in
!            the program that calls vtsgc. jdvw must be at least nlon.
!
!     br,bi  two or three dimensional arrays (see input parameter nt)
!     cr,ci  that contain the vector spherical harmonic coefficients
!            of (v,w) as computed by subroutine vhagc.
!
!     mdab   the first dimension of the arrays br,bi,cr, and ci as it
!            appears in the program that calls vtsgc. 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 vtsgc. ndab must be at
!            least nlat.
!
!     wvts   an array which must be initialized by subroutine vtsgci.
!            once initialized, wvts can be used repeatedly by vtsgc
!            as long as nlon and nlat remain unchanged.  wvts must
!            not be altered between calls of vtsgc.
!
!     lwvts  the dimension of the array wvts as it appears in the
!            program that calls vtsgc. 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 lwvts 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 vtsgc. 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
!
!     vt,wt  two or three dimensional arrays (see input parameter nt)
!            in which the derivative of (v,w) with respect to
!            colatitude theta is stored. vt(i,j),wt(i,j) contain the
!            derivatives at gaussian colatitude points theta(i)
!            and longitude phi(j) = (j-1)*2*pi/nlon. the index ranges
!            are defined above at the input parameter ityp. vt and wt
!            are computed from the formulas for v and w given in
!            subroutine vhsgc but with vbar and wbar replaced with
!            their derivatives with respect to colatitude. these
!            derivatives are denoted by vtbar and wtbar.
!
!   in terms of real variables this expansion takes the form
!
!             for i=1,...,nlat and  j=1,...,nlon
!
!     vt(i,j) = the sum from n=1 to n=nlat-1 of
!
!               .5*br(1,n+1)*vtbar(0,n,theta(i))
!
!     plus the sum from m=1 to m=mmax-1 of the sum from n=m to
!     n=nlat-1 of the real part of
!
!       (br(m+1,n+1)*vtbar(m,n,theta(i))
!                   -ci(m+1,n+1)*wtbar(m,n,theta(i)))*cos(m*phi(j))
!      -(bi(m+1,n+1)*vtbar(m,n,theta(i))
!                   +cr(m+1,n+1)*wtbar(m,n,theta(i)))*sin(m*phi(j))
!
!    and for i=1,...,nlat and  j=1,...,nlon
!
!     wt(i,j) = the sum from n=1 to n=nlat-1 of
!
!              -.5*cr(1,n+1)*vtbar(0,n,theta(i))
!
!     plus the sum from m=1 to m=mmax-1 of the sum from n=m to
!     n=nlat-1 of the real part of
!
!      -(cr(m+1,n+1)*vtbar(m,n,theta(i))
!                   +bi(m+1,n+1)*wtbar(m,n,theta(i)))*cos(m*phi(j))
!      +(ci(m+1,n+1)*vtbar(m,n,theta(i))
!                   -br(m+1,n+1)*wtbar(m,n,theta(i)))*sin(m*phi(j))
!
!
!      br(m+1,nlat),bi(m+1,nlat),cr(m+1,nlat), and ci(m+1,nlat) are
!      assumed zero for m even.
!
!
!     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 lwvts
!            = 10 error in the specification of lwork
!
!
! *******************************************************************
!
!     subroutine vtsgci(nlat,nlon,wvts,lwvts,dwork,ldwork,ierror)
!
!     subroutine vtsgci initializes the array wvts which can then be
!     used repeatedly by subroutine vtsgc until nlat or nlon is changed.
!
!     input parameters
!
!     nlat   the number of gaussian colatitudinal grid points theta(i)
!            such that 0 < theta(1) <...< theta(nlat) < pi. they are
!            computed by subroutine gaqd which is called by this
!            subroutine. if nlat is odd the equator is
!            theta((nlat+1)/2). if nlat is even the equator lies
!            half way between theta(nlat/2) and theta(nlat/2+1). nlat
!            must be at least 3. note: if (v,w) is symmetric about
!            the equator (see parameter ityp below) the number of
!            colatitudinal grid points 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.
!
!     lwvts  the dimension of the array wvts as it appears in the
!            program that calls vtsgc. 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 lwvts 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 vtsgc. ldwork must be at least
!            nlat*(nlat+4)
!
!     **************************************************************
!
!     output parameters
!
!     wvts   an array which is initialized for use by subroutine vtsgc.
!            once initialized, wvts can be used repeatedly by vtsgc
!            as long as nlat or nlon remain unchanged.  wvts must not
!            be altered between calls of vtsgc.
!
!
!     ierror = 0  no errors
!            = 1  error in the specification of nlat
!            = 2  error in the specification of nlon
!            = 3  error in the specification of lwvts
!            = 4  error in the specification of lwork
!
!
!
! **********************************************************************
!
      SUBROUTINE VTSGC(Nlat,Nlon,Ityp,Nt,Vt,Wt,Idvw,Jdvw,Br,Bi,Cr,Ci,   &
                     & Mdab,Ndab,Wvts,Lwvts,Work,Lwork,Ierror)
      IMPLICIT NONE
      REAL Bi , Br , Ci , Cr , Vt , Work , Wt , Wvts
      INTEGER idv , Idvw , Ierror , imid , ist , Ityp , iw1 , iw2 ,     &
            & iw3 , iw4 , iw5 , Jdvw , jw1 , jw2 , labc , lnl , Lwork , &
            & Lwvts , lwzvin , lzz1
      INTEGER Mdab , mmax , Ndab , Nlat , Nlon , Nt

      DIMENSION Vt(Idvw,Jdvw,1) , Wt(Idvw,Jdvw,1) , Br(Mdab,Ndab,1) ,   &
              & Bi(Mdab,Ndab,1) , Cr(Mdab,Ndab,1) , Ci(Mdab,Ndab,1) ,   &
              & Work(1) , Wvts(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 ( Lwvts<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
      lzz1 = 2*Nlat*imid
      labc = 3*(MAX0(mmax-2,0)*(Nlat+Nlat-mmax-1))/2
      lwzvin = lzz1 + labc
      jw1 = lwzvin + 1
      jw2 = jw1 + lwzvin
      CALL VTSGC1(Nlat,Nlon,Ityp,Nt,imid,Idvw,Jdvw,Vt,Wt,Mdab,Ndab,Br,  &
                & Bi,Cr,Ci,idv,Work,Work(iw1),Work(iw2),Work(iw3),      &
                & Work(iw4),Work(iw5),Wvts,Wvts(jw1),Wvts(jw2))
    END SUBROUTINE VTSGC

    
    SUBROUTINE VTSGC1(Nlat,Nlon,Ityp,Nt,Imid,Idvw,Jdvw,Vt,Wt,Mdab,    &
         & Ndab,Br,Bi,Cr,Ci,Idv,Vte,Vto,Wte,Wto,Vb,Wb,     &
         & Wvbin,Wwbin,Wrfft)
      IMPLICIT NONE
      REAL Bi , Br , Ci , Cr , Vb , Vt , Vte , Vto , Wb , Wrfft , Wt ,  &
         & Wte , Wto , Wvbin , Wwbin
      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 Vt(Idvw,Jdvw,1) , Wt(Idvw,Jdvw,1) , Br(Mdab,Ndab,1) ,   &
              & Bi(Mdab,Ndab,1) , Cr(Mdab,Ndab,1) , Ci(Mdab,Ndab,1) ,   &
              & Vte(Idv,Nlon,1) , Vto(Idv,Nlon,1) , Wte(Idv,Nlon,1) ,   &
              & Wto(Idv,Nlon,1) , Wvbin(1) , Wwbin(1) , Wrfft(1) ,      &
              & Vb(Imid,Nlat,3) , Wb(Imid,Nlat,3)
      nlp1 = Nlat + 1
      mlat = MOD(Nlat,2)
      mlon = MOD(Nlon,2)
      mmax = MIN0(Nlat,(Nlon+1)/2)
      imm1 = Imid
      IF ( mlat/=0 ) imm1 = Imid - 1
      DO k = 1 , Nt
         DO j = 1 , Nlon
            DO i = 1 , Idv
               Vte(i,j,k) = 0.
               Wte(i,j,k) = 0.
            ENDDO
         ENDDO
      ENDDO
      ndo1 = Nlat
      ndo2 = Nlat
      IF ( mlat/=0 ) ndo1 = Nlat - 1
      IF ( mlat==0 ) ndo2 = Nlat - 1
      itypp = Ityp + 1
      IF ( itypp==2 ) THEN
!
!     case ityp=1   no symmetries,  cr and ci equal zero
!
         CALL VBIN(0,Nlat,Nlon,0,Vb,iv,Wvbin)
!
!     case m = 0
!
         DO k = 1 , Nt
            DO np1 = 2 , ndo2 , 2
               DO i = 1 , imm1
                  Vto(i,1,k) = Vto(i,1,k) + Br(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
         DO k = 1 , Nt
            DO np1 = 3 , ndo1 , 2
               DO i = 1 , Imid
                  Vte(i,1,k) = Vte(i,1,k) + Br(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax>=2 ) THEN
            DO mp1 = 2 , mmax
               m = mp1 - 1
               mp2 = mp1 + 1
               CALL VBIN(0,Nlat,Nlon,m,Vb,iv,Wvbin)
               CALL WBIN(0,Nlat,Nlon,m,Wb,iw,Wwbin)
               IF ( mp1<=ndo1 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp1 , ndo1 , 2
                        DO i = 1 , imm1
                           Vte(i,2*mp1-2,k) = Vte(i,2*mp1-2,k)          &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Vte(i,2*mp1-1,k) = Vte(i,2*mp1-1,k)          &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           Wto(i,2*mp1-2,k) = Wto(i,2*mp1-2,k)          &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           Wto(i,2*mp1-1,k) = Wto(i,2*mp1-1,k)          &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Vte(Imid,2*mp1-2,k) = Vte(Imid,2*mp1-2,k)    &
                            & + Br(mp1,np1,k)*Vb(Imid,np1,iv)
                           Vte(Imid,2*mp1-1,k) = Vte(Imid,2*mp1-1,k)    &
                            & + Bi(mp1,np1,k)*Vb(Imid,np1,iv)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
               IF ( mp2<=ndo2 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        DO i = 1 , imm1
                           Vto(i,2*mp1-2,k) = Vto(i,2*mp1-2,k)          &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Vto(i,2*mp1-1,k) = Vto(i,2*mp1-1,k)          &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           Wte(i,2*mp1-2,k) = Wte(i,2*mp1-2,k)          &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           Wte(i,2*mp1-1,k) = Wte(i,2*mp1-1,k)          &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Wte(Imid,2*mp1-2,k) = Wte(Imid,2*mp1-2,k)    &
                            & - Bi(mp1,np1,k)*Wb(Imid,np1,iw)
                           Wte(Imid,2*mp1-1,k) = Wte(Imid,2*mp1-1,k)    &
                            & + Br(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSEIF ( itypp==3 ) THEN
!
!     case ityp=2   no symmetries,  br and bi are equal to zero
!
         CALL VBIN(0,Nlat,Nlon,0,Vb,iv,Wvbin)
!
!     case m = 0
!
         DO k = 1 , Nt
            DO np1 = 2 , ndo2 , 2
               DO i = 1 , imm1
                  Wto(i,1,k) = Wto(i,1,k) - Cr(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
         DO k = 1 , Nt
            DO np1 = 3 , ndo1 , 2
               DO i = 1 , Imid
                  Wte(i,1,k) = Wte(i,1,k) - Cr(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax>=2 ) THEN
            DO mp1 = 2 , mmax
               m = mp1 - 1
               mp2 = mp1 + 1
               CALL VBIN(0,Nlat,Nlon,m,Vb,iv,Wvbin)
               CALL WBIN(0,Nlat,Nlon,m,Wb,iw,Wwbin)
               IF ( mp1<=ndo1 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp1 , ndo1 , 2
                        DO i = 1 , imm1
                           Vto(i,2*mp1-2,k) = Vto(i,2*mp1-2,k)          &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Vto(i,2*mp1-1,k) = Vto(i,2*mp1-1,k)          &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           Wte(i,2*mp1-2,k) = Wte(i,2*mp1-2,k)          &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           Wte(i,2*mp1-1,k) = Wte(i,2*mp1-1,k)          &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Wte(Imid,2*mp1-2,k) = Wte(Imid,2*mp1-2,k)    &
                            & - Cr(mp1,np1,k)*Vb(Imid,np1,iv)
                           Wte(Imid,2*mp1-1,k) = Wte(Imid,2*mp1-1,k)    &
                            & - Ci(mp1,np1,k)*Vb(Imid,np1,iv)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
               IF ( mp2<=ndo2 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        DO i = 1 , imm1
                           Vte(i,2*mp1-2,k) = Vte(i,2*mp1-2,k)          &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Vte(i,2*mp1-1,k) = Vte(i,2*mp1-1,k)          &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           Wto(i,2*mp1-2,k) = Wto(i,2*mp1-2,k)          &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           Wto(i,2*mp1-1,k) = Wto(i,2*mp1-1,k)          &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Vte(Imid,2*mp1-2,k) = Vte(Imid,2*mp1-2,k)    &
                            & - Ci(mp1,np1,k)*Wb(Imid,np1,iw)
                           Vte(Imid,2*mp1-1,k) = Vte(Imid,2*mp1-1,k)    &
                            & + Cr(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSEIF ( itypp==4 ) THEN
!
!     case ityp=3   v odd,  w even
!
         CALL VBIN(0,Nlat,Nlon,0,Vb,iv,Wvbin)
!
!     case m = 0
!
         DO k = 1 , Nt
            DO np1 = 2 , ndo2 , 2
               DO i = 1 , imm1
                  Vto(i,1,k) = Vto(i,1,k) + Br(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
         DO k = 1 , Nt
            DO np1 = 3 , ndo1 , 2
               DO i = 1 , Imid
                  Wte(i,1,k) = Wte(i,1,k) - Cr(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax>=2 ) THEN
            DO mp1 = 2 , mmax
               m = mp1 - 1
               mp2 = mp1 + 1
               CALL VBIN(0,Nlat,Nlon,m,Vb,iv,Wvbin)
               CALL WBIN(0,Nlat,Nlon,m,Wb,iw,Wwbin)
               IF ( mp1<=ndo1 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp1 , ndo1 , 2
                        DO i = 1 , imm1
                           Vto(i,2*mp1-2,k) = Vto(i,2*mp1-2,k)          &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Vto(i,2*mp1-1,k) = Vto(i,2*mp1-1,k)          &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           Wte(i,2*mp1-2,k) = Wte(i,2*mp1-2,k)          &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           Wte(i,2*mp1-1,k) = Wte(i,2*mp1-1,k)          &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Wte(Imid,2*mp1-2,k) = Wte(Imid,2*mp1-2,k)    &
                            & - Cr(mp1,np1,k)*Vb(Imid,np1,iv)
                           Wte(Imid,2*mp1-1,k) = Wte(Imid,2*mp1-1,k)    &
                            & - Ci(mp1,np1,k)*Vb(Imid,np1,iv)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
               IF ( mp2<=ndo2 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        DO i = 1 , imm1
                           Vto(i,2*mp1-2,k) = Vto(i,2*mp1-2,k)          &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Vto(i,2*mp1-1,k) = Vto(i,2*mp1-1,k)          &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           Wte(i,2*mp1-2,k) = Wte(i,2*mp1-2,k)          &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           Wte(i,2*mp1-1,k) = Wte(i,2*mp1-1,k)          &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Wte(Imid,2*mp1-2,k) = Wte(Imid,2*mp1-2,k)    &
                            & - Bi(mp1,np1,k)*Wb(Imid,np1,iw)
                           Wte(Imid,2*mp1-1,k) = Wte(Imid,2*mp1-1,k)    &
                            & + Br(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSEIF ( itypp==5 ) THEN
!
!     case ityp=4   v odd,  w even, and both cr and ci equal zero
!
         CALL VBIN(1,Nlat,Nlon,0,Vb,iv,Wvbin)
!
!     case m = 0
!
         DO k = 1 , Nt
            DO np1 = 2 , ndo2 , 2
               DO i = 1 , imm1
                  Vto(i,1,k) = Vto(i,1,k) + Br(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax>=2 ) THEN
            DO mp1 = 2 , mmax
               m = mp1 - 1
               mp2 = mp1 + 1
               CALL VBIN(1,Nlat,Nlon,m,Vb,iv,Wvbin)
               CALL WBIN(1,Nlat,Nlon,m,Wb,iw,Wwbin)
               IF ( mp2<=ndo2 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        DO i = 1 , imm1
                           Vto(i,2*mp1-2,k) = Vto(i,2*mp1-2,k)          &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Vto(i,2*mp1-1,k) = Vto(i,2*mp1-1,k)          &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           Wte(i,2*mp1-2,k) = Wte(i,2*mp1-2,k)          &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           Wte(i,2*mp1-1,k) = Wte(i,2*mp1-1,k)          &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Wte(Imid,2*mp1-2,k) = Wte(Imid,2*mp1-2,k)    &
                            & - Bi(mp1,np1,k)*Wb(Imid,np1,iw)
                           Wte(Imid,2*mp1-1,k) = Wte(Imid,2*mp1-1,k)    &
                            & + Br(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSEIF ( itypp==6 ) THEN
!
!     case ityp=5   v odd,  w even,     br and bi equal zero
!
         CALL VBIN(2,Nlat,Nlon,0,Vb,iv,Wvbin)
!
!     case m = 0
!
         DO k = 1 , Nt
            DO np1 = 3 , ndo1 , 2
               DO i = 1 , Imid
                  Wte(i,1,k) = Wte(i,1,k) - Cr(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax>=2 ) THEN
            DO mp1 = 2 , mmax
               m = mp1 - 1
               mp2 = mp1 + 1
               CALL VBIN(2,Nlat,Nlon,m,Vb,iv,Wvbin)
               CALL WBIN(2,Nlat,Nlon,m,Wb,iw,Wwbin)
               IF ( mp1<=ndo1 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp1 , ndo1 , 2
                        DO i = 1 , imm1
                           Vto(i,2*mp1-2,k) = Vto(i,2*mp1-2,k)          &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Vto(i,2*mp1-1,k) = Vto(i,2*mp1-1,k)          &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           Wte(i,2*mp1-2,k) = Wte(i,2*mp1-2,k)          &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           Wte(i,2*mp1-1,k) = Wte(i,2*mp1-1,k)          &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Wte(Imid,2*mp1-2,k) = Wte(Imid,2*mp1-2,k)    &
                            & - Cr(mp1,np1,k)*Vb(Imid,np1,iv)
                           Wte(Imid,2*mp1-1,k) = Wte(Imid,2*mp1-1,k)    &
                            & - Ci(mp1,np1,k)*Vb(Imid,np1,iv)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSEIF ( itypp==7 ) THEN
!
!     case ityp=6   v even  ,  w odd
!
         CALL VBIN(0,Nlat,Nlon,0,Vb,iv,Wvbin)
!
!     case m = 0
!
         DO k = 1 , Nt
            DO np1 = 2 , ndo2 , 2
               DO i = 1 , imm1
                  Wto(i,1,k) = Wto(i,1,k) - Cr(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
         DO k = 1 , Nt
            DO np1 = 3 , ndo1 , 2
               DO i = 1 , Imid
                  Vte(i,1,k) = Vte(i,1,k) + Br(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax>=2 ) THEN
            DO mp1 = 2 , mmax
               m = mp1 - 1
               mp2 = mp1 + 1
               CALL VBIN(0,Nlat,Nlon,m,Vb,iv,Wvbin)
               CALL WBIN(0,Nlat,Nlon,m,Wb,iw,Wwbin)
               IF ( mp1<=ndo1 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp1 , ndo1 , 2
                        DO i = 1 , imm1
                           Vte(i,2*mp1-2,k) = Vte(i,2*mp1-2,k)          &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Vte(i,2*mp1-1,k) = Vte(i,2*mp1-1,k)          &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           Wto(i,2*mp1-2,k) = Wto(i,2*mp1-2,k)          &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           Wto(i,2*mp1-1,k) = Wto(i,2*mp1-1,k)          &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Vte(Imid,2*mp1-2,k) = Vte(Imid,2*mp1-2,k)    &
                            & + Br(mp1,np1,k)*Vb(Imid,np1,iv)
                           Vte(Imid,2*mp1-1,k) = Vte(Imid,2*mp1-1,k)    &
                            & + Bi(mp1,np1,k)*Vb(Imid,np1,iv)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
               IF ( mp2<=ndo2 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        DO i = 1 , imm1
                           Vte(i,2*mp1-2,k) = Vte(i,2*mp1-2,k)          &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Vte(i,2*mp1-1,k) = Vte(i,2*mp1-1,k)          &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           Wto(i,2*mp1-2,k) = Wto(i,2*mp1-2,k)          &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           Wto(i,2*mp1-1,k) = Wto(i,2*mp1-1,k)          &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Vte(Imid,2*mp1-2,k) = Vte(Imid,2*mp1-2,k)    &
                            & - Ci(mp1,np1,k)*Wb(Imid,np1,iw)
                           Vte(Imid,2*mp1-1,k) = Vte(Imid,2*mp1-1,k)    &
                            & + Cr(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSEIF ( itypp==8 ) THEN
!
!     case ityp=7   v even, w odd   cr and ci equal zero
!
         CALL VBIN(2,Nlat,Nlon,0,Vb,iv,Wvbin)
!
!     case m = 0
!
         DO k = 1 , Nt
            DO np1 = 3 , ndo1 , 2
               DO i = 1 , Imid
                  Vte(i,1,k) = Vte(i,1,k) + Br(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax>=2 ) THEN
            DO mp1 = 2 , mmax
               m = mp1 - 1
               mp2 = mp1 + 1
               CALL VBIN(2,Nlat,Nlon,m,Vb,iv,Wvbin)
               CALL WBIN(2,Nlat,Nlon,m,Wb,iw,Wwbin)
               IF ( mp1<=ndo1 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp1 , ndo1 , 2
                        DO i = 1 , imm1
                           Vte(i,2*mp1-2,k) = Vte(i,2*mp1-2,k)          &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Vte(i,2*mp1-1,k) = Vte(i,2*mp1-1,k)          &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           Wto(i,2*mp1-2,k) = Wto(i,2*mp1-2,k)          &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           Wto(i,2*mp1-1,k) = Wto(i,2*mp1-1,k)          &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Vte(Imid,2*mp1-2,k) = Vte(Imid,2*mp1-2,k)    &
                            & + Br(mp1,np1,k)*Vb(Imid,np1,iv)
                           Vte(Imid,2*mp1-1,k) = Vte(Imid,2*mp1-1,k)    &
                            & + Bi(mp1,np1,k)*Vb(Imid,np1,iv)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSEIF ( itypp==9 ) THEN
!
!     case ityp=8   v even,  w odd   br and bi equal zero
!
         CALL VBIN(1,Nlat,Nlon,0,Vb,iv,Wvbin)
!
!     case m = 0
!
         DO k = 1 , Nt
            DO np1 = 2 , ndo2 , 2
               DO i = 1 , imm1
                  Wto(i,1,k) = Wto(i,1,k) - Cr(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax>=2 ) THEN
            DO mp1 = 2 , mmax
               m = mp1 - 1
               mp2 = mp1 + 1
               CALL VBIN(1,Nlat,Nlon,m,Vb,iv,Wvbin)
               CALL WBIN(1,Nlat,Nlon,m,Wb,iw,Wwbin)
               IF ( mp2<=ndo2 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        DO i = 1 , imm1
                           Vte(i,2*mp1-2,k) = Vte(i,2*mp1-2,k)          &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Vte(i,2*mp1-1,k) = Vte(i,2*mp1-1,k)          &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           Wto(i,2*mp1-2,k) = Wto(i,2*mp1-2,k)          &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           Wto(i,2*mp1-1,k) = Wto(i,2*mp1-1,k)          &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Vte(Imid,2*mp1-2,k) = Vte(Imid,2*mp1-2,k)    &
                            & - Ci(mp1,np1,k)*Wb(Imid,np1,iw)
                           Vte(Imid,2*mp1-1,k) = Vte(Imid,2*mp1-1,k)    &
                            & + Cr(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSE
!
!     case ityp=0   no symmetries
!
         CALL VBIN(0,Nlat,Nlon,0,Vb,iv,Wvbin)
!
!     case m = 0
!
         DO k = 1 , Nt
            DO np1 = 2 , ndo2 , 2
               DO i = 1 , imm1
                  Vto(i,1,k) = Vto(i,1,k) + Br(1,np1,k)*Vb(i,np1,iv)
                  Wto(i,1,k) = Wto(i,1,k) - Cr(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
         DO k = 1 , Nt
            DO np1 = 3 , ndo1 , 2
               DO i = 1 , Imid
                  Vte(i,1,k) = Vte(i,1,k) + Br(1,np1,k)*Vb(i,np1,iv)
                  Wte(i,1,k) = Wte(i,1,k) - Cr(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax>=2 ) THEN
            DO mp1 = 2 , mmax
               m = mp1 - 1
               mp2 = mp1 + 1
               CALL VBIN(0,Nlat,Nlon,m,Vb,iv,Wvbin)
               CALL WBIN(0,Nlat,Nlon,m,Wb,iw,Wwbin)
               IF ( mp1<=ndo1 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp1 , ndo1 , 2
                        DO i = 1 , imm1
                           Vte(i,2*mp1-2,k) = Vte(i,2*mp1-2,k)          &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Vto(i,2*mp1-2,k) = Vto(i,2*mp1-2,k)          &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Vte(i,2*mp1-1,k) = Vte(i,2*mp1-1,k)          &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           Vto(i,2*mp1-1,k) = Vto(i,2*mp1-1,k)          &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           Wte(i,2*mp1-2,k) = Wte(i,2*mp1-2,k)          &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           Wto(i,2*mp1-2,k) = Wto(i,2*mp1-2,k)          &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           Wte(i,2*mp1-1,k) = Wte(i,2*mp1-1,k)          &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                           Wto(i,2*mp1-1,k) = Wto(i,2*mp1-1,k)          &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Vte(Imid,2*mp1-2,k) = Vte(Imid,2*mp1-2,k)    &
                            & + Br(mp1,np1,k)*Vb(Imid,np1,iv)
                           Vte(Imid,2*mp1-1,k) = Vte(Imid,2*mp1-1,k)    &
                            & + Bi(mp1,np1,k)*Vb(Imid,np1,iv)
                           Wte(Imid,2*mp1-2,k) = Wte(Imid,2*mp1-2,k)    &
                            & - Cr(mp1,np1,k)*Vb(Imid,np1,iv)
                           Wte(Imid,2*mp1-1,k) = Wte(Imid,2*mp1-1,k)    &
                            & - Ci(mp1,np1,k)*Vb(Imid,np1,iv)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
               IF ( mp2<=ndo2 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        DO i = 1 , imm1
                           Vto(i,2*mp1-2,k) = Vto(i,2*mp1-2,k)          &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Vte(i,2*mp1-2,k) = Vte(i,2*mp1-2,k)          &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Vto(i,2*mp1-1,k) = Vto(i,2*mp1-1,k)          &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           Vte(i,2*mp1-1,k) = Vte(i,2*mp1-1,k)          &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           Wto(i,2*mp1-2,k) = Wto(i,2*mp1-2,k)          &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           Wte(i,2*mp1-2,k) = Wte(i,2*mp1-2,k)          &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           Wto(i,2*mp1-1,k) = Wto(i,2*mp1-1,k)          &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                           Wte(i,2*mp1-1,k) = Wte(i,2*mp1-1,k)          &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Vte(Imid,2*mp1-2,k) = Vte(Imid,2*mp1-2,k)    &
                            & - Ci(mp1,np1,k)*Wb(Imid,np1,iw)
                           Vte(Imid,2*mp1-1,k) = Vte(Imid,2*mp1-1,k)    &
                            & + Cr(mp1,np1,k)*Wb(Imid,np1,iw)
                           Wte(Imid,2*mp1-2,k) = Wte(Imid,2*mp1-2,k)    &
                            & - Bi(mp1,np1,k)*Wb(Imid,np1,iw)
                           Wte(Imid,2*mp1-1,k) = Wte(Imid,2*mp1-1,k)    &
                            & + Br(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ENDIF
      DO k = 1 , Nt
         CALL HRFFTB(Idv,Nlon,Vte(1,1,k),Idv,Wrfft,Vb)
         CALL HRFFTB(Idv,Nlon,Wte(1,1,k),Idv,Wrfft,Vb)
      ENDDO
      IF ( Ityp>2 ) THEN
         DO k = 1 , Nt
            DO j = 1 , Nlon
               DO i = 1 , imm1
                  Vt(i,j,k) = .5*Vte(i,j,k)
                  Wt(i,j,k) = .5*Wte(i,j,k)
               ENDDO
            ENDDO
         ENDDO
      ELSE
         DO k = 1 , Nt
            DO j = 1 , Nlon
               DO i = 1 , imm1
                  Vt(i,j,k) = .5*(Vte(i,j,k)+Vto(i,j,k))
                  Wt(i,j,k) = .5*(Wte(i,j,k)+Wto(i,j,k))
                  Vt(nlp1-i,j,k) = .5*(Vte(i,j,k)-Vto(i,j,k))
                  Wt(nlp1-i,j,k) = .5*(Wte(i,j,k)-Wto(i,j,k))
               ENDDO
            ENDDO
         ENDDO
      ENDIF
      IF ( mlat==0 ) RETURN
      DO k = 1 , Nt
         DO j = 1 , Nlon
            Vt(Imid,j,k) = .5*Vte(Imid,j,k)
            Wt(Imid,j,k) = .5*Wte(Imid,j,k)
         ENDDO
      ENDDO
      END SUBROUTINE VTSGC1


      SUBROUTINE VTSGCI(Nlat,Nlon,Wvts,Lwvts,Dwork,Ldwork,Ierror)
      IMPLICIT NONE
      INTEGER ierr , Ierror , imid , iw1 , iw2 , labc , ldwk , Ldwork , &
            & lwvbin , Lwvts , lzz1 , mmax , Nlat , Nlon
      REAL Wvts
      DIMENSION Wvts(Lwvts)
      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 ( Lwvts<2*(lzz1+labc)+Nlon+15 ) RETURN
      Ierror = 4
!     if(lwork .lt. 2*nlat*(nlat+2)) return
      IF ( Ldwork<Nlat*(Nlat+4) ) RETURN
!     call gaqd(nlat,work,work(2*nlat+1),work(4*nlat+1),lwork,ierr)
      ldwk = Ldwork - 2*Nlat
      CALL GAQD(Nlat,Dwork,Dwork(Nlat+1),Dwork(2*Nlat+1),ldwk,ierr)
      Ierror = 5
      IF ( ierr/=0 ) RETURN
      Ierror = 0
!     call vtgint (nlat,nlon,work,wvts,work(4*nlat+1))
      CALL VTGINT(Nlat,Nlon,Dwork,Wvts,Dwork(2*Nlat+1))
      lwvbin = lzz1 + labc
      iw1 = lwvbin + 1
!     call wtgint (nlat,nlon,work,wvts(iw1),work(4*nlat+1))
      CALL WTGINT(Nlat,Nlon,Dwork,Wvts(iw1),Dwork(2*Nlat+1))
      iw2 = iw1 + lwvbin
      CALL HRFFTI(Nlon,Wvts(iw2))
      END SUBROUTINE VTSGCI


      SUBROUTINE DVTSGC(Nlat,Nlon,Ityp,Nt,Vt,Wt,Idvw,Jdvw,Br,Bi,Cr,Ci,   &
                     & Mdab,Ndab,Wvts,Lwvts,Work,Lwork,Ierror)
      IMPLICIT NONE
      DOUBLE PRECISION Bi , Br , Ci , Cr , Vt , Work , Wt , Wvts
      INTEGER idv , Idvw , Ierror , imid , ist , Ityp , iw1 , iw2 ,     &
            & iw3 , iw4 , iw5 , Jdvw , jw1 , jw2 , labc , lnl , Lwork , &
            & Lwvts , lwzvin , lzz1
      INTEGER Mdab , mmax , Ndab , Nlat , Nlon , Nt

      DIMENSION Vt(Idvw,Jdvw,1) , Wt(Idvw,Jdvw,1) , Br(Mdab,Ndab,1) ,   &
              & Bi(Mdab,Ndab,1) , Cr(Mdab,Ndab,1) , Ci(Mdab,Ndab,1) ,   &
              & Work(1) , Wvts(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 ( Lwvts<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
      lzz1 = 2*Nlat*imid
      labc = 3*(MAX0(mmax-2,0)*(Nlat+Nlat-mmax-1))/2
      lwzvin = lzz1 + labc
      jw1 = lwzvin + 1
      jw2 = jw1 + lwzvin
      CALL DVTSGC1(Nlat,Nlon,Ityp,Nt,imid,Idvw,Jdvw,Vt,Wt,Mdab,Ndab,Br,  &
                & Bi,Cr,Ci,idv,Work,Work(iw1),Work(iw2),Work(iw3),      &
                & Work(iw4),Work(iw5),Wvts,Wvts(jw1),Wvts(jw2))
    END SUBROUTINE DVTSGC

    
    SUBROUTINE DVTSGC1(Nlat,Nlon,Ityp,Nt,Imid,Idvw,Jdvw,Vt,Wt,Mdab,    &
         & Ndab,Br,Bi,Cr,Ci,Idv,Vte,Vto,Wte,Wto,Vb,Wb,     &
         & Wvbin,Wwbin,Wrfft)
      IMPLICIT NONE
      DOUBLE PRECISION Bi , Br , Ci , Cr , Vb , Vt , Vte , Vto , Wb , Wrfft , Wt ,  &
         & Wte , Wto , Wvbin , Wwbin
      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 Vt(Idvw,Jdvw,1) , Wt(Idvw,Jdvw,1) , Br(Mdab,Ndab,1) ,   &
              & Bi(Mdab,Ndab,1) , Cr(Mdab,Ndab,1) , Ci(Mdab,Ndab,1) ,   &
              & Vte(Idv,Nlon,1) , Vto(Idv,Nlon,1) , Wte(Idv,Nlon,1) ,   &
              & Wto(Idv,Nlon,1) , Wvbin(1) , Wwbin(1) , Wrfft(1) ,      &
              & Vb(Imid,Nlat,3) , Wb(Imid,Nlat,3)
      nlp1 = Nlat + 1
      mlat = MOD(Nlat,2)
      mlon = MOD(Nlon,2)
      mmax = MIN0(Nlat,(Nlon+1)/2)
      imm1 = Imid
      IF ( mlat/=0 ) imm1 = Imid - 1
      DO k = 1 , Nt
         DO j = 1 , Nlon
            DO i = 1 , Idv
               Vte(i,j,k) = 0.
               Wte(i,j,k) = 0.
            ENDDO
         ENDDO
      ENDDO
      ndo1 = Nlat
      ndo2 = Nlat
      IF ( mlat/=0 ) ndo1 = Nlat - 1
      IF ( mlat==0 ) ndo2 = Nlat - 1
      itypp = Ityp + 1
      IF ( itypp==2 ) THEN
!
!     case ityp=1   no symmetries,  cr and ci equal zero
!
         CALL DVBIN(0,Nlat,Nlon,0,Vb,iv,Wvbin)
!
!     case m = 0
!
         DO k = 1 , Nt
            DO np1 = 2 , ndo2 , 2
               DO i = 1 , imm1
                  Vto(i,1,k) = Vto(i,1,k) + Br(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
         DO k = 1 , Nt
            DO np1 = 3 , ndo1 , 2
               DO i = 1 , Imid
                  Vte(i,1,k) = Vte(i,1,k) + Br(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax>=2 ) THEN
            DO mp1 = 2 , mmax
               m = mp1 - 1
               mp2 = mp1 + 1
               CALL DVBIN(0,Nlat,Nlon,m,Vb,iv,Wvbin)
               CALL DWBIN(0,Nlat,Nlon,m,Wb,iw,Wwbin)
               IF ( mp1<=ndo1 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp1 , ndo1 , 2
                        DO i = 1 , imm1
                           Vte(i,2*mp1-2,k) = Vte(i,2*mp1-2,k)          &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Vte(i,2*mp1-1,k) = Vte(i,2*mp1-1,k)          &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           Wto(i,2*mp1-2,k) = Wto(i,2*mp1-2,k)          &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           Wto(i,2*mp1-1,k) = Wto(i,2*mp1-1,k)          &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Vte(Imid,2*mp1-2,k) = Vte(Imid,2*mp1-2,k)    &
                            & + Br(mp1,np1,k)*Vb(Imid,np1,iv)
                           Vte(Imid,2*mp1-1,k) = Vte(Imid,2*mp1-1,k)    &
                            & + Bi(mp1,np1,k)*Vb(Imid,np1,iv)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
               IF ( mp2<=ndo2 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        DO i = 1 , imm1
                           Vto(i,2*mp1-2,k) = Vto(i,2*mp1-2,k)          &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Vto(i,2*mp1-1,k) = Vto(i,2*mp1-1,k)          &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           Wte(i,2*mp1-2,k) = Wte(i,2*mp1-2,k)          &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           Wte(i,2*mp1-1,k) = Wte(i,2*mp1-1,k)          &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Wte(Imid,2*mp1-2,k) = Wte(Imid,2*mp1-2,k)    &
                            & - Bi(mp1,np1,k)*Wb(Imid,np1,iw)
                           Wte(Imid,2*mp1-1,k) = Wte(Imid,2*mp1-1,k)    &
                            & + Br(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSEIF ( itypp==3 ) THEN
!
!     case ityp=2   no symmetries,  br and bi are equal to zero
!
         CALL DVBIN(0,Nlat,Nlon,0,Vb,iv,Wvbin)
!
!     case m = 0
!
         DO k = 1 , Nt
            DO np1 = 2 , ndo2 , 2
               DO i = 1 , imm1
                  Wto(i,1,k) = Wto(i,1,k) - Cr(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
         DO k = 1 , Nt
            DO np1 = 3 , ndo1 , 2
               DO i = 1 , Imid
                  Wte(i,1,k) = Wte(i,1,k) - Cr(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax>=2 ) THEN
            DO mp1 = 2 , mmax
               m = mp1 - 1
               mp2 = mp1 + 1
               CALL DVBIN(0,Nlat,Nlon,m,Vb,iv,Wvbin)
               CALL DWBIN(0,Nlat,Nlon,m,Wb,iw,Wwbin)
               IF ( mp1<=ndo1 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp1 , ndo1 , 2
                        DO i = 1 , imm1
                           Vto(i,2*mp1-2,k) = Vto(i,2*mp1-2,k)          &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Vto(i,2*mp1-1,k) = Vto(i,2*mp1-1,k)          &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           Wte(i,2*mp1-2,k) = Wte(i,2*mp1-2,k)          &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           Wte(i,2*mp1-1,k) = Wte(i,2*mp1-1,k)          &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Wte(Imid,2*mp1-2,k) = Wte(Imid,2*mp1-2,k)    &
                            & - Cr(mp1,np1,k)*Vb(Imid,np1,iv)
                           Wte(Imid,2*mp1-1,k) = Wte(Imid,2*mp1-1,k)    &
                            & - Ci(mp1,np1,k)*Vb(Imid,np1,iv)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
               IF ( mp2<=ndo2 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        DO i = 1 , imm1
                           Vte(i,2*mp1-2,k) = Vte(i,2*mp1-2,k)          &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Vte(i,2*mp1-1,k) = Vte(i,2*mp1-1,k)          &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           Wto(i,2*mp1-2,k) = Wto(i,2*mp1-2,k)          &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           Wto(i,2*mp1-1,k) = Wto(i,2*mp1-1,k)          &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Vte(Imid,2*mp1-2,k) = Vte(Imid,2*mp1-2,k)    &
                            & - Ci(mp1,np1,k)*Wb(Imid,np1,iw)
                           Vte(Imid,2*mp1-1,k) = Vte(Imid,2*mp1-1,k)    &
                            & + Cr(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSEIF ( itypp==4 ) THEN
!
!     case ityp=3   v odd,  w even
!
         CALL DVBIN(0,Nlat,Nlon,0,Vb,iv,Wvbin)
!
!     case m = 0
!
         DO k = 1 , Nt
            DO np1 = 2 , ndo2 , 2
               DO i = 1 , imm1
                  Vto(i,1,k) = Vto(i,1,k) + Br(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
         DO k = 1 , Nt
            DO np1 = 3 , ndo1 , 2
               DO i = 1 , Imid
                  Wte(i,1,k) = Wte(i,1,k) - Cr(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax>=2 ) THEN
            DO mp1 = 2 , mmax
               m = mp1 - 1
               mp2 = mp1 + 1
               CALL DVBIN(0,Nlat,Nlon,m,Vb,iv,Wvbin)
               CALL DWBIN(0,Nlat,Nlon,m,Wb,iw,Wwbin)
               IF ( mp1<=ndo1 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp1 , ndo1 , 2
                        DO i = 1 , imm1
                           Vto(i,2*mp1-2,k) = Vto(i,2*mp1-2,k)          &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Vto(i,2*mp1-1,k) = Vto(i,2*mp1-1,k)          &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           Wte(i,2*mp1-2,k) = Wte(i,2*mp1-2,k)          &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           Wte(i,2*mp1-1,k) = Wte(i,2*mp1-1,k)          &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Wte(Imid,2*mp1-2,k) = Wte(Imid,2*mp1-2,k)    &
                            & - Cr(mp1,np1,k)*Vb(Imid,np1,iv)
                           Wte(Imid,2*mp1-1,k) = Wte(Imid,2*mp1-1,k)    &
                            & - Ci(mp1,np1,k)*Vb(Imid,np1,iv)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
               IF ( mp2<=ndo2 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        DO i = 1 , imm1
                           Vto(i,2*mp1-2,k) = Vto(i,2*mp1-2,k)          &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Vto(i,2*mp1-1,k) = Vto(i,2*mp1-1,k)          &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           Wte(i,2*mp1-2,k) = Wte(i,2*mp1-2,k)          &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           Wte(i,2*mp1-1,k) = Wte(i,2*mp1-1,k)          &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Wte(Imid,2*mp1-2,k) = Wte(Imid,2*mp1-2,k)    &
                            & - Bi(mp1,np1,k)*Wb(Imid,np1,iw)
                           Wte(Imid,2*mp1-1,k) = Wte(Imid,2*mp1-1,k)    &
                            & + Br(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSEIF ( itypp==5 ) THEN
!
!     case ityp=4   v odd,  w even, and both cr and ci equal zero
!
         CALL DVBIN(1,Nlat,Nlon,0,Vb,iv,Wvbin)
!
!     case m = 0
!
         DO k = 1 , Nt
            DO np1 = 2 , ndo2 , 2
               DO i = 1 , imm1
                  Vto(i,1,k) = Vto(i,1,k) + Br(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax>=2 ) THEN
            DO mp1 = 2 , mmax
               m = mp1 - 1
               mp2 = mp1 + 1
               CALL DVBIN(1,Nlat,Nlon,m,Vb,iv,Wvbin)
               CALL DWBIN(1,Nlat,Nlon,m,Wb,iw,Wwbin)
               IF ( mp2<=ndo2 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        DO i = 1 , imm1
                           Vto(i,2*mp1-2,k) = Vto(i,2*mp1-2,k)          &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Vto(i,2*mp1-1,k) = Vto(i,2*mp1-1,k)          &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           Wte(i,2*mp1-2,k) = Wte(i,2*mp1-2,k)          &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           Wte(i,2*mp1-1,k) = Wte(i,2*mp1-1,k)          &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Wte(Imid,2*mp1-2,k) = Wte(Imid,2*mp1-2,k)    &
                            & - Bi(mp1,np1,k)*Wb(Imid,np1,iw)
                           Wte(Imid,2*mp1-1,k) = Wte(Imid,2*mp1-1,k)    &
                            & + Br(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSEIF ( itypp==6 ) THEN
!
!     case ityp=5   v odd,  w even,     br and bi equal zero
!
         CALL DVBIN(2,Nlat,Nlon,0,Vb,iv,Wvbin)
!
!     case m = 0
!
         DO k = 1 , Nt
            DO np1 = 3 , ndo1 , 2
               DO i = 1 , Imid
                  Wte(i,1,k) = Wte(i,1,k) - Cr(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax>=2 ) THEN
            DO mp1 = 2 , mmax
               m = mp1 - 1
               mp2 = mp1 + 1
               CALL DVBIN(2,Nlat,Nlon,m,Vb,iv,Wvbin)
               CALL DWBIN(2,Nlat,Nlon,m,Wb,iw,Wwbin)
               IF ( mp1<=ndo1 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp1 , ndo1 , 2
                        DO i = 1 , imm1
                           Vto(i,2*mp1-2,k) = Vto(i,2*mp1-2,k)          &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Vto(i,2*mp1-1,k) = Vto(i,2*mp1-1,k)          &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           Wte(i,2*mp1-2,k) = Wte(i,2*mp1-2,k)          &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           Wte(i,2*mp1-1,k) = Wte(i,2*mp1-1,k)          &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Wte(Imid,2*mp1-2,k) = Wte(Imid,2*mp1-2,k)    &
                            & - Cr(mp1,np1,k)*Vb(Imid,np1,iv)
                           Wte(Imid,2*mp1-1,k) = Wte(Imid,2*mp1-1,k)    &
                            & - Ci(mp1,np1,k)*Vb(Imid,np1,iv)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSEIF ( itypp==7 ) THEN
!
!     case ityp=6   v even  ,  w odd
!
         CALL DVBIN(0,Nlat,Nlon,0,Vb,iv,Wvbin)
!
!     case m = 0
!
         DO k = 1 , Nt
            DO np1 = 2 , ndo2 , 2
               DO i = 1 , imm1
                  Wto(i,1,k) = Wto(i,1,k) - Cr(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
         DO k = 1 , Nt
            DO np1 = 3 , ndo1 , 2
               DO i = 1 , Imid
                  Vte(i,1,k) = Vte(i,1,k) + Br(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax>=2 ) THEN
            DO mp1 = 2 , mmax
               m = mp1 - 1
               mp2 = mp1 + 1
               CALL DVBIN(0,Nlat,Nlon,m,Vb,iv,Wvbin)
               CALL DWBIN(0,Nlat,Nlon,m,Wb,iw,Wwbin)
               IF ( mp1<=ndo1 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp1 , ndo1 , 2
                        DO i = 1 , imm1
                           Vte(i,2*mp1-2,k) = Vte(i,2*mp1-2,k)          &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Vte(i,2*mp1-1,k) = Vte(i,2*mp1-1,k)          &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           Wto(i,2*mp1-2,k) = Wto(i,2*mp1-2,k)          &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           Wto(i,2*mp1-1,k) = Wto(i,2*mp1-1,k)          &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Vte(Imid,2*mp1-2,k) = Vte(Imid,2*mp1-2,k)    &
                            & + Br(mp1,np1,k)*Vb(Imid,np1,iv)
                           Vte(Imid,2*mp1-1,k) = Vte(Imid,2*mp1-1,k)    &
                            & + Bi(mp1,np1,k)*Vb(Imid,np1,iv)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
               IF ( mp2<=ndo2 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        DO i = 1 , imm1
                           Vte(i,2*mp1-2,k) = Vte(i,2*mp1-2,k)          &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Vte(i,2*mp1-1,k) = Vte(i,2*mp1-1,k)          &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           Wto(i,2*mp1-2,k) = Wto(i,2*mp1-2,k)          &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           Wto(i,2*mp1-1,k) = Wto(i,2*mp1-1,k)          &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Vte(Imid,2*mp1-2,k) = Vte(Imid,2*mp1-2,k)    &
                            & - Ci(mp1,np1,k)*Wb(Imid,np1,iw)
                           Vte(Imid,2*mp1-1,k) = Vte(Imid,2*mp1-1,k)    &
                            & + Cr(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSEIF ( itypp==8 ) THEN
!
!     case ityp=7   v even, w odd   cr and ci equal zero
!
         CALL DVBIN(2,Nlat,Nlon,0,Vb,iv,Wvbin)
!
!     case m = 0
!
         DO k = 1 , Nt
            DO np1 = 3 , ndo1 , 2
               DO i = 1 , Imid
                  Vte(i,1,k) = Vte(i,1,k) + Br(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax>=2 ) THEN
            DO mp1 = 2 , mmax
               m = mp1 - 1
               mp2 = mp1 + 1
               CALL DVBIN(2,Nlat,Nlon,m,Vb,iv,Wvbin)
               CALL DWBIN(2,Nlat,Nlon,m,Wb,iw,Wwbin)
               IF ( mp1<=ndo1 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp1 , ndo1 , 2
                        DO i = 1 , imm1
                           Vte(i,2*mp1-2,k) = Vte(i,2*mp1-2,k)          &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Vte(i,2*mp1-1,k) = Vte(i,2*mp1-1,k)          &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           Wto(i,2*mp1-2,k) = Wto(i,2*mp1-2,k)          &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           Wto(i,2*mp1-1,k) = Wto(i,2*mp1-1,k)          &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Vte(Imid,2*mp1-2,k) = Vte(Imid,2*mp1-2,k)    &
                            & + Br(mp1,np1,k)*Vb(Imid,np1,iv)
                           Vte(Imid,2*mp1-1,k) = Vte(Imid,2*mp1-1,k)    &
                            & + Bi(mp1,np1,k)*Vb(Imid,np1,iv)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSEIF ( itypp==9 ) THEN
!
!     case ityp=8   v even,  w odd   br and bi equal zero
!
         CALL DVBIN(1,Nlat,Nlon,0,Vb,iv,Wvbin)
!
!     case m = 0
!
         DO k = 1 , Nt
            DO np1 = 2 , ndo2 , 2
               DO i = 1 , imm1
                  Wto(i,1,k) = Wto(i,1,k) - Cr(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax>=2 ) THEN
            DO mp1 = 2 , mmax
               m = mp1 - 1
               mp2 = mp1 + 1
               CALL DVBIN(1,Nlat,Nlon,m,Vb,iv,Wvbin)
               CALL DWBIN(1,Nlat,Nlon,m,Wb,iw,Wwbin)
               IF ( mp2<=ndo2 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        DO i = 1 , imm1
                           Vte(i,2*mp1-2,k) = Vte(i,2*mp1-2,k)          &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Vte(i,2*mp1-1,k) = Vte(i,2*mp1-1,k)          &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           Wto(i,2*mp1-2,k) = Wto(i,2*mp1-2,k)          &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           Wto(i,2*mp1-1,k) = Wto(i,2*mp1-1,k)          &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Vte(Imid,2*mp1-2,k) = Vte(Imid,2*mp1-2,k)    &
                            & - Ci(mp1,np1,k)*Wb(Imid,np1,iw)
                           Vte(Imid,2*mp1-1,k) = Vte(Imid,2*mp1-1,k)    &
                            & + Cr(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSE
!
!     case ityp=0   no symmetries
!
         CALL DVBIN(0,Nlat,Nlon,0,Vb,iv,Wvbin)
!
!     case m = 0
!
         DO k = 1 , Nt
            DO np1 = 2 , ndo2 , 2
               DO i = 1 , imm1
                  Vto(i,1,k) = Vto(i,1,k) + Br(1,np1,k)*Vb(i,np1,iv)
                  Wto(i,1,k) = Wto(i,1,k) - Cr(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
         DO k = 1 , Nt
            DO np1 = 3 , ndo1 , 2
               DO i = 1 , Imid
                  Vte(i,1,k) = Vte(i,1,k) + Br(1,np1,k)*Vb(i,np1,iv)
                  Wte(i,1,k) = Wte(i,1,k) - Cr(1,np1,k)*Vb(i,np1,iv)
               ENDDO
            ENDDO
         ENDDO
!
!     case m = 1 through nlat-1
!
         IF ( mmax>=2 ) THEN
            DO mp1 = 2 , mmax
               m = mp1 - 1
               mp2 = mp1 + 1
               CALL DVBIN(0,Nlat,Nlon,m,Vb,iv,Wvbin)
               CALL DWBIN(0,Nlat,Nlon,m,Wb,iw,Wwbin)
               IF ( mp1<=ndo1 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp1 , ndo1 , 2
                        DO i = 1 , imm1
                           Vte(i,2*mp1-2,k) = Vte(i,2*mp1-2,k)          &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Vto(i,2*mp1-2,k) = Vto(i,2*mp1-2,k)          &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Vte(i,2*mp1-1,k) = Vte(i,2*mp1-1,k)          &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           Vto(i,2*mp1-1,k) = Vto(i,2*mp1-1,k)          &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           Wte(i,2*mp1-2,k) = Wte(i,2*mp1-2,k)          &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           Wto(i,2*mp1-2,k) = Wto(i,2*mp1-2,k)          &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           Wte(i,2*mp1-1,k) = Wte(i,2*mp1-1,k)          &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                           Wto(i,2*mp1-1,k) = Wto(i,2*mp1-1,k)          &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Vte(Imid,2*mp1-2,k) = Vte(Imid,2*mp1-2,k)    &
                            & + Br(mp1,np1,k)*Vb(Imid,np1,iv)
                           Vte(Imid,2*mp1-1,k) = Vte(Imid,2*mp1-1,k)    &
                            & + Bi(mp1,np1,k)*Vb(Imid,np1,iv)
                           Wte(Imid,2*mp1-2,k) = Wte(Imid,2*mp1-2,k)    &
                            & - Cr(mp1,np1,k)*Vb(Imid,np1,iv)
                           Wte(Imid,2*mp1-1,k) = Wte(Imid,2*mp1-1,k)    &
                            & - Ci(mp1,np1,k)*Vb(Imid,np1,iv)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
               IF ( mp2<=ndo2 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        DO i = 1 , imm1
                           Vto(i,2*mp1-2,k) = Vto(i,2*mp1-2,k)          &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Vte(i,2*mp1-2,k) = Vte(i,2*mp1-2,k)          &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Vto(i,2*mp1-1,k) = Vto(i,2*mp1-1,k)          &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           Vte(i,2*mp1-1,k) = Vte(i,2*mp1-1,k)          &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           Wto(i,2*mp1-2,k) = Wto(i,2*mp1-2,k)          &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           Wte(i,2*mp1-2,k) = Wte(i,2*mp1-2,k)          &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           Wto(i,2*mp1-1,k) = Wto(i,2*mp1-1,k)          &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                           Wte(i,2*mp1-1,k) = Wte(i,2*mp1-1,k)          &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Vte(Imid,2*mp1-2,k) = Vte(Imid,2*mp1-2,k)    &
                            & - Ci(mp1,np1,k)*Wb(Imid,np1,iw)
                           Vte(Imid,2*mp1-1,k) = Vte(Imid,2*mp1-1,k)    &
                            & + Cr(mp1,np1,k)*Wb(Imid,np1,iw)
                           Wte(Imid,2*mp1-2,k) = Wte(Imid,2*mp1-2,k)    &
                            & - Bi(mp1,np1,k)*Wb(Imid,np1,iw)
                           Wte(Imid,2*mp1-1,k) = Wte(Imid,2*mp1-1,k)    &
                            & + Br(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ENDIF
      DO k = 1 , Nt
         CALL DHRFFTB(Idv,Nlon,Vte(1,1,k),Idv,Wrfft,Vb)
         CALL DHRFFTB(Idv,Nlon,Wte(1,1,k),Idv,Wrfft,Vb)
      ENDDO
      IF ( Ityp>2 ) THEN
         DO k = 1 , Nt
            DO j = 1 , Nlon
               DO i = 1 , imm1
                  Vt(i,j,k) = .5*Vte(i,j,k)
                  Wt(i,j,k) = .5*Wte(i,j,k)
               ENDDO
            ENDDO
         ENDDO
      ELSE
         DO k = 1 , Nt
            DO j = 1 , Nlon
               DO i = 1 , imm1
                  Vt(i,j,k) = .5*(Vte(i,j,k)+Vto(i,j,k))
                  Wt(i,j,k) = .5*(Wte(i,j,k)+Wto(i,j,k))
                  Vt(nlp1-i,j,k) = .5*(Vte(i,j,k)-Vto(i,j,k))
                  Wt(nlp1-i,j,k) = .5*(Wte(i,j,k)-Wto(i,j,k))
               ENDDO
            ENDDO
         ENDDO
      ENDIF
      IF ( mlat==0 ) RETURN
      DO k = 1 , Nt
         DO j = 1 , Nlon
            Vt(Imid,j,k) = .5*Vte(Imid,j,k)
            Wt(Imid,j,k) = .5*Wte(Imid,j,k)
         ENDDO
      ENDDO
      END SUBROUTINE DVTSGC1


      SUBROUTINE DVTSGCI(Nlat,Nlon,Wvts,Lwvts,Dwork,Ldwork,Ierror)
      IMPLICIT NONE
      INTEGER ierr , Ierror , imid , iw1 , iw2 , labc , ldwk , Ldwork , &
            & lwvbin , Lwvts , lzz1 , mmax , Nlat , Nlon
      DOUBLE PRECISION Wvts
      DIMENSION Wvts(Lwvts)
      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 ( Lwvts<2*(lzz1+labc)+Nlon+15 ) RETURN
      Ierror = 4
!     if(lwork .lt. 2*nlat*(nlat+2)) return
      IF ( Ldwork<Nlat*(Nlat+4) ) RETURN
!     call gaqd(nlat,work,work(2*nlat+1),work(4*nlat+1),lwork,ierr)
      ldwk = Ldwork - 2*Nlat
      CALL DGAQD(Nlat,Dwork,Dwork(Nlat+1),Dwork(2*Nlat+1),ldwk,ierr)
      Ierror = 5
      IF ( ierr/=0 ) RETURN
      Ierror = 0
!     call vtgint (nlat,nlon,work,wvts,work(4*nlat+1))
      CALL DVTGINT(Nlat,Nlon,Dwork,Wvts,Dwork(2*Nlat+1))
      lwvbin = lzz1 + labc
      iw1 = lwvbin + 1
!     call wtgint (nlat,nlon,work,wvts(iw1),work(4*nlat+1))
      CALL DWTGINT(Nlat,Nlon,Dwork,Wvts(iw1),Dwork(2*Nlat+1))
      iw2 = iw1 + lwvbin
      CALL DHRFFTI(Nlon,Wvts(iw2))
      END SUBROUTINE DVTSGCI
