!  . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
!  .                                                             .
!  .                  copyright (c) 1998 by UCAR                 .
!  .                                                             .
!  .       University Corporation for Atmospheric Research       .
!  .                                                             .
!  .                      all rights reserved                    .
!  .                                                             .
!  .                                                             .
!  .                         SPHEREPACK3.0                       .
!  .                                                             .
!  . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
!
!
!
! ... file vhsgc.f
!
!     this file contains code and documentation for subroutines
!     vhsgc and vhsgci
!
! ... files which must be loaded with vhsgc.f
!
!     sphcom.f, hrfft.f, gaqd.f
!
!     subroutine vhsgc(nlat,nlon,ityp,nt,v,w,idvw,jdvw,br,bi,cr,ci,
!    +                 mdab,ndab,wvhsgc,lvhsgc,work,lwork,ierror)
!
!     subroutine vhsgc performs the vector spherical harmonic synthesis
!     of the arrays br, bi, cr, and ci and stores the result in the
!     arrays v and w. v(i,j) and w(i,j) are the colatitudinal
!     (measured from the north pole) and east longitudinal components
!     respectively, located at the gaussian colatitude point theta(i)
!     and longitude phi(j) = (j-1)*2*pi/nlon. the spectral
!     representation of (v,w) is given below at output parameters v,w.
!
!     input parameters
!
!     nlat   the number of points in the gaussian colatitude grid on the
!            full sphere. these lie in the interval (0,pi) and are computed
!            in radians in theta(1) <...< theta(nlat) by subroutine gaqd.
!            if nlat is odd the equator will be included as the grid point
!            theta((nlat+1)/2).  if nlat is even the equator will be
!            excluded as a grid point and will lie half way between
!            theta(nlat/2) and theta(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 synthesis
!                 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 synthesis
!                 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 synthesis
!                 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 synthesis is performed on the northern
!                 hemisphere only.  i.e., if nlat is odd the synthesis
!                 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 synthesis 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 synthesis is performed on the northern
!                 hemisphere only.  i.e., if nlat is odd the synthesis
!                 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 synthesis 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 synthesis is performed on the northern
!                 hemisphere only.  i.e., if nlat is odd the synthesis
!                 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 synthesis 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 synthesis is performed on the northern
!                 hemisphere only.  i.e., if nlat is odd the synthesis
!                 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 synthesis 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 synthesis is performed on the northern
!                 hemisphere only.  i.e., if nlat is odd the synthesis
!                 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 synthesis 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 synthesis is performed on the northern
!                 hemisphere only.  i.e., if nlat is odd the synthesis
!                 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 synthesis 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 syntheses.  in the program that calls vhsgc,
!            the arrays v,w,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 v,w as it appears in
!            the program that calls vhsgc. 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 vhsgc. 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
!            in the spectral representation of v(i,j) and w(i,j) given
!            below at the discription of output parameters v and w.
!
!     mdab   the first dimension of the arrays br,bi,cr, and ci as it
!            appears in the program that calls vhsgc. 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 vhsgc. ndab must be at
!            least nlat.
!
!     wvhsgc an array which must be initialized by subroutine vhsgci.
!            once initialized, wvhsgc can be used repeatedly by vhsgc
!            as long as nlon and nlat remain unchanged.  wvhsgc must
!            not be altered between calls of vhsgc.
!
!     lvhsgc the dimension of the array wvhsgc as it appears in the
!            program that calls vhsgc. 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 lvhsgc must be at least
!
!               4*nlat*l2+3*max0(l1-2,0)*(2*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 vhsgc. 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
!
!     v,w    two or three dimensional arrays (see input parameter nt)
!            in which the synthesis is stored. v is the colatitudinal
!            component and w is the east longitudinal component.
!            v(i,j),w(i,j) contain the components at the gaussian
!            colatitude theta(i) and longitude phi(j) = (j-1)*2*pi/nlon.
!            the index ranges are defined above at the input parameter
!            ityp. v and w are computed from the formulas given below.
!
!     define
!
!     1.  theta is colatitude and phi is east longitude
!
!     2.  the normalized associated legendre funnctions
!
!         pbar(m,n,theta) = sqrt((2*n+1)*factorial(n-m)
!                        /(2*factorial(n+m)))*sin(theta)**m/(2**n*
!                        factorial(n)) times the (n+m)th derivative
!                        of (x**2-1)**n with respect to x=cos(theta)
!
!     3.  vbar(m,n,theta) = the derivative of pbar(m,n,theta) with
!                           respect to theta divided by the square
!                           root of n(n+1).
!
!         vbar(m,n,theta) is more easily computed in the form
!
!         vbar(m,n,theta) = (sqrt((n+m)*(n-m+1))*pbar(m-1,n,theta)
!         -sqrt((n-m)*(n+m+1))*pbar(m+1,n,theta))/(2*sqrt(n*(n+1)))
!
!     4.  wbar(m,n,theta) = m/(sin(theta))*pbar(m,n,theta) divided
!                           by the square root of n(n+1).
!
!         wbar(m,n,theta) is more easily computed in the form
!
!         wbar(m,n,theta) = sqrt((2n+1)/(2n-1))*(sqrt((n+m)*(n+m-1))
!         *pbar(m-1,n-1,theta)+sqrt((n-m)*(n-m-1))*pbar(m+1,n-1,theta))
!         /(2*sqrt(n*(n+1)))
!
!
!    the colatitudnal dependence of the normalized surface vector
!                spherical harmonics are defined by
!
!     5.    bbar(m,n,theta) = (vbar(m,n,theta),i*wbar(m,n,theta))
!
!     6.    cbar(m,n,theta) = (i*wbar(m,n,theta),-vbar(m,n,theta))
!
!
!    the coordinate to index mappings
!
!     7.   phi(j) = (j-1)*2*pi/nlon, theta(i) is the i(th) guassian
!          point (see nlat as an input parameter).
!
!     the maximum (plus one) longitudinal wave number
!
!     8.     mmax = min0(nlat,nlon/2) if nlon is even or
!            mmax = min0(nlat,(nlon+1)/2) if nlon is odd.
!
!    if we further define the output vector as
!
!     9.    h(i,j) = (v(i,j),w(i,j))
!
!    and the complex coefficients
!
!     10.   b(m,n) = cmplx(br(m+1,n+1),bi(m+1,n+1))
!
!     11.   c(m,n) = cmplx(cr(m+1,n+1),ci(m+1,n+1))
!
!
!    then for i=1,...,nlat and  j=1,...,nlon
!
!        the expansion for real h(i,j) takes the form
!
!     h(i,j) = the sum from n=1 to n=nlat-1 of the real part of
!
!         .5*(b(0,n)*bbar(0,n,theta(i))+c(0,n)*cbar(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
!
!              b(m,n)*bbar(m,n,theta(i))*exp(i*m*phi(j))
!             +c(m,n)*cbar(m,n,theta(i))*exp(i*m*phi(j))
!
!   *************************************************************
!
!   in terms of real variables this expansion takes the form
!
!             for i=1,...,nlat and  j=1,...,nlon
!
!     v(i,j) = the sum from n=1 to n=nlat-1 of
!
!               .5*br(1,n+1)*vbar(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)*vbar(m,n,theta(i))-ci(m+1,n+1)*wbar(m,n,theta(i)))
!                                          *cos(m*phi(j))
!      -(bi(m+1,n+1)*vbar(m,n,theta(i))+cr(m+1,n+1)*wbar(m,n,theta(i)))
!                                          *sin(m*phi(j))
!
!    and for i=1,...,nlat and  j=1,...,nlon
!
!     w(i,j) = the sum from n=1 to n=nlat-1 of
!
!              -.5*cr(1,n+1)*vbar(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)*vbar(m,n,theta(i))+bi(m+1,n+1)*wbar(m,n,theta(i)))
!                                          *cos(m*phi(j))
!      +(ci(m+1,n+1)*vbar(m,n,theta(i))-br(m+1,n+1)*wbar(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 lvhsgc
!            = 10 error in the specification of lwork
!
!*************************************************************
!
!     subroutine vhsgci(nlat,nlon,wvhsgc,lvhsgc,dwork,ldwork,ierror)
!
!     subroutine vhsgci initializes the array wvhsgc which can then be
!     used repeatedly by subroutine vhsgc until nlat or nlon is changed.
!
!     input parameters
!
!     nlat   the number of points in the gaussian colatitude grid on the
!            full sphere. these lie in the interval (0,pi) and are computed
!            in radians in theta(1) <...< theta(nlat) by subroutine gaqd.
!            if nlat is odd the equator will be included as the grid point
!            theta((nlat+1)/2).  if nlat is even the equator will be
!            excluded as a grid point and will lie half way between
!            theta(nlat/2) and theta(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.
!
!     lvhsgc the dimension of the array wvhsgc as it appears in the
!            program that calls vhsgc. 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 lvhsgc must be at least
!
!               4*nlat*l2+3*max0(l1-2,0)*(2*nlat-l1-1)+nlon+15
!
!     work  a double precision work space that does not need to be saved
!
!     ldwork the dimension of the array dwork as it appears in the
!            program that calls vhsgsi. ldwork must be at least
!
!               2*nlat*(nlat+1)+1
!
!     **************************************************************
!
!     output parameters
!
!     wvhsgc an array which is initialized for use by subroutine vhsgc.
!            once initialized, wvhsgc can be used repeatedly by vhsgc
!            as long as nlat and nlon remain unchanged.  wvhsgc must not
!            be altered between calls of vhsgc.
!
!
!     ierror = 0  no errors
!            = 1  error in the specification of nlat
!            = 2  error in the specification of nlon
!            = 3  error in the specification of lvhsgc
!            = 4  error in the specification of ldwork
!
      SUBROUTINE VHSGC(Nlat,Nlon,Ityp,Nt,V,W,Idvw,Jdvw,Br,Bi,Cr,Ci,Mdab,&
                     & Ndab,Wvhsgc,Lvhsgc,Work,Lwork,Ierror)
      IMPLICIT NONE
      REAL Bi , Br , Ci , Cr , V , W , Work , Wvhsgc
      INTEGER idv , Idvw , Ierror , imid , ist , Ityp , iw1 , iw2 ,     &
            & iw3 , iw4 , iw5 , Jdvw , jw1 , jw2 , l1 , l2 , labc ,     &
            & lnl , Lvhsgc , lwmin
      INTEGER Lwork , lwzvin , lzz1 , 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) , Wvhsgc(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
!
!     check save work space length
!
      l1 = MIN0(Nlat,(Nlon+1)/2)
      l2 = (Nlat+1)/2
      lwmin = 4*Nlat*l2 + 3*MAX0(l1-2,0)*(2*Nlat-l1-1) + Nlon + 15
      IF ( Lvhsgc<lwmin ) RETURN
 
 
!     if(lvhsgc .lt. 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 VHSGC1(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),Wvhsgc,Wvhsgc(jw1),Wvhsgc(jw2))
      END SUBROUTINE VHSGC


      SUBROUTINE VHSGC1(Nlat,Nlon,Ityp,Nt,Imid,Idvw,Jdvw,V,W,Mdab,Ndab, &
                      & Br,Bi,Cr,Ci,Idv,Ve,Vo,We,Wo,Vb,Wb,Wvbin,Wwbin,  &
                      & Wrfft)
      IMPLICIT NONE
      REAL Bi , Br , Ci , Cr , V , Vb , Ve , Vo , W , Wb , We , Wo ,    &
         & Wrfft , 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 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) , 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
               Ve(i,j,k) = 0.
               We(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 , Imid
                  Ve(i,1,k) = Ve(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 , imm1
                  Vo(i,1,k) = Vo(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
                           Vo(i,2*mp1-2,k) = Vo(i,2*mp1-2,k)            &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Vo(i,2*mp1-1,k) = Vo(i,2*mp1-1,k)            &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           We(i,2*mp1-2,k) = We(i,2*mp1-2,k)            &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           We(i,2*mp1-1,k) = We(i,2*mp1-1,k)            &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           We(Imid,2*mp1-2,k) = We(Imid,2*mp1-2,k)      &
                            & - Bi(mp1,np1,k)*Wb(Imid,np1,iw)
                           We(Imid,2*mp1-1,k) = We(Imid,2*mp1-1,k)      &
                            & + Br(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
               IF ( mp2<=ndo2 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        DO i = 1 , imm1
                           Ve(i,2*mp1-2,k) = Ve(i,2*mp1-2,k)            &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Ve(i,2*mp1-1,k) = Ve(i,2*mp1-1,k)            &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           Wo(i,2*mp1-2,k) = Wo(i,2*mp1-2,k)            &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           Wo(i,2*mp1-1,k) = Wo(i,2*mp1-1,k)            &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Ve(Imid,2*mp1-2,k) = Ve(Imid,2*mp1-2,k)      &
                            & + Br(mp1,np1,k)*Vb(Imid,np1,iv)
                           Ve(Imid,2*mp1-1,k) = Ve(Imid,2*mp1-1,k)      &
                            & + Bi(mp1,np1,k)*Vb(Imid,np1,iv)
                        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 , Imid
                  We(i,1,k) = We(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 , imm1
                  Wo(i,1,k) = Wo(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
                           Ve(i,2*mp1-2,k) = Ve(i,2*mp1-2,k)            &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Ve(i,2*mp1-1,k) = Ve(i,2*mp1-1,k)            &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           Wo(i,2*mp1-2,k) = Wo(i,2*mp1-2,k)            &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           Wo(i,2*mp1-1,k) = Wo(i,2*mp1-1,k)            &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Ve(Imid,2*mp1-2,k) = Ve(Imid,2*mp1-2,k)      &
                            & - Ci(mp1,np1,k)*Wb(Imid,np1,iw)
                           Ve(Imid,2*mp1-1,k) = Ve(Imid,2*mp1-1,k)      &
                            & + Cr(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
               IF ( mp2<=ndo2 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        DO i = 1 , imm1
                           Vo(i,2*mp1-2,k) = Vo(i,2*mp1-2,k)            &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Vo(i,2*mp1-1,k) = Vo(i,2*mp1-1,k)            &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           We(i,2*mp1-2,k) = We(i,2*mp1-2,k)            &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           We(i,2*mp1-1,k) = We(i,2*mp1-1,k)            &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           We(Imid,2*mp1-2,k) = We(Imid,2*mp1-2,k)      &
                            & - Cr(mp1,np1,k)*Vb(Imid,np1,iv)
                           We(Imid,2*mp1-1,k) = We(Imid,2*mp1-1,k)      &
                            & - Ci(mp1,np1,k)*Vb(Imid,np1,iv)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSEIF ( itypp==4 ) THEN
!
!     case ityp=3   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 , Imid
                  Ve(i,1,k) = Ve(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 , imm1
                  Wo(i,1,k) = Wo(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
                           Ve(i,2*mp1-2,k) = Ve(i,2*mp1-2,k)            &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Ve(i,2*mp1-1,k) = Ve(i,2*mp1-1,k)            &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           Wo(i,2*mp1-2,k) = Wo(i,2*mp1-2,k)            &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           Wo(i,2*mp1-1,k) = Wo(i,2*mp1-1,k)            &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Ve(Imid,2*mp1-2,k) = Ve(Imid,2*mp1-2,k)      &
                            & - Ci(mp1,np1,k)*Wb(Imid,np1,iw)
                           Ve(Imid,2*mp1-1,k) = Ve(Imid,2*mp1-1,k)      &
                            & + Cr(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
               IF ( mp2<=ndo2 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        DO i = 1 , imm1
                           Ve(i,2*mp1-2,k) = Ve(i,2*mp1-2,k)            &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Ve(i,2*mp1-1,k) = Ve(i,2*mp1-1,k)            &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           Wo(i,2*mp1-2,k) = Wo(i,2*mp1-2,k)            &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           Wo(i,2*mp1-1,k) = Wo(i,2*mp1-1,k)            &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Ve(Imid,2*mp1-2,k) = Ve(Imid,2*mp1-2,k)      &
                            & + Br(mp1,np1,k)*Vb(Imid,np1,iv)
                           Ve(Imid,2*mp1-1,k) = Ve(Imid,2*mp1-1,k)      &
                            & + Bi(mp1,np1,k)*Vb(Imid,np1,iv)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSEIF ( itypp==5 ) THEN
!
!     case ityp=4   v even,  w odd, 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 , Imid
                  Ve(i,1,k) = Ve(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
                           Ve(i,2*mp1-2,k) = Ve(i,2*mp1-2,k)            &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Ve(i,2*mp1-1,k) = Ve(i,2*mp1-1,k)            &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           Wo(i,2*mp1-2,k) = Wo(i,2*mp1-2,k)            &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           Wo(i,2*mp1-1,k) = Wo(i,2*mp1-1,k)            &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Ve(Imid,2*mp1-2,k) = Ve(Imid,2*mp1-2,k)      &
                            & + Br(mp1,np1,k)*Vb(Imid,np1,iv)
                           Ve(Imid,2*mp1-1,k) = Ve(Imid,2*mp1-1,k)      &
                            & + Bi(mp1,np1,k)*Vb(Imid,np1,iv)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSEIF ( itypp==6 ) THEN
!
!     case ityp=5   v even,  w odd,     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 , imm1
                  Wo(i,1,k) = Wo(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
                           Ve(i,2*mp1-2,k) = Ve(i,2*mp1-2,k)            &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Ve(i,2*mp1-1,k) = Ve(i,2*mp1-1,k)            &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           Wo(i,2*mp1-2,k) = Wo(i,2*mp1-2,k)            &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           Wo(i,2*mp1-1,k) = Wo(i,2*mp1-1,k)            &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Ve(Imid,2*mp1-2,k) = Ve(Imid,2*mp1-2,k)      &
                            & - Ci(mp1,np1,k)*Wb(Imid,np1,iw)
                           Ve(Imid,2*mp1-1,k) = Ve(Imid,2*mp1-1,k)      &
                            & + Cr(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSEIF ( itypp==7 ) THEN
!
!     case ityp=6   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 , Imid
                  We(i,1,k) = We(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 , imm1
                  Vo(i,1,k) = Vo(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
                           Vo(i,2*mp1-2,k) = Vo(i,2*mp1-2,k)            &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Vo(i,2*mp1-1,k) = Vo(i,2*mp1-1,k)            &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           We(i,2*mp1-2,k) = We(i,2*mp1-2,k)            &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           We(i,2*mp1-1,k) = We(i,2*mp1-1,k)            &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           We(Imid,2*mp1-2,k) = We(Imid,2*mp1-2,k)      &
                            & - Bi(mp1,np1,k)*Wb(Imid,np1,iw)
                           We(Imid,2*mp1-1,k) = We(Imid,2*mp1-1,k)      &
                            & + Br(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
               IF ( mp2<=ndo2 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        DO i = 1 , imm1
                           Vo(i,2*mp1-2,k) = Vo(i,2*mp1-2,k)            &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Vo(i,2*mp1-1,k) = Vo(i,2*mp1-1,k)            &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           We(i,2*mp1-2,k) = We(i,2*mp1-2,k)            &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           We(i,2*mp1-1,k) = We(i,2*mp1-1,k)            &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           We(Imid,2*mp1-2,k) = We(Imid,2*mp1-2,k)      &
                            & - Cr(mp1,np1,k)*Vb(Imid,np1,iv)
                           We(Imid,2*mp1-1,k) = We(Imid,2*mp1-1,k)      &
                            & - Ci(mp1,np1,k)*Vb(Imid,np1,iv)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSEIF ( itypp==8 ) THEN
!
!     case ityp=7   v odd, w even   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 , imm1
                  Vo(i,1,k) = Vo(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
                           Vo(i,2*mp1-2,k) = Vo(i,2*mp1-2,k)            &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Vo(i,2*mp1-1,k) = Vo(i,2*mp1-1,k)            &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           We(i,2*mp1-2,k) = We(i,2*mp1-2,k)            &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           We(i,2*mp1-1,k) = We(i,2*mp1-1,k)            &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           We(Imid,2*mp1-2,k) = We(Imid,2*mp1-2,k)      &
                            & - Bi(mp1,np1,k)*Wb(Imid,np1,iw)
                           We(Imid,2*mp1-1,k) = We(Imid,2*mp1-1,k)      &
                            & + Br(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSEIF ( itypp==9 ) THEN
!
!     case ityp=8   v odd,  w even   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 , Imid
                  We(i,1,k) = We(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
                           Vo(i,2*mp1-2,k) = Vo(i,2*mp1-2,k)            &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Vo(i,2*mp1-1,k) = Vo(i,2*mp1-1,k)            &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           We(i,2*mp1-2,k) = We(i,2*mp1-2,k)            &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           We(i,2*mp1-1,k) = We(i,2*mp1-1,k)            &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           We(Imid,2*mp1-2,k) = We(Imid,2*mp1-2,k)      &
                            & - Cr(mp1,np1,k)*Vb(Imid,np1,iv)
                           We(Imid,2*mp1-1,k) = We(Imid,2*mp1-1,k)      &
                            & - Ci(mp1,np1,k)*Vb(Imid,np1,iv)
                        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 , Imid
                  Ve(i,1,k) = Ve(i,1,k) + Br(1,np1,k)*Vb(i,np1,iv)
                  We(i,1,k) = We(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 , imm1
                  Vo(i,1,k) = Vo(i,1,k) + Br(1,np1,k)*Vb(i,np1,iv)
                  Wo(i,1,k) = Wo(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
                           Vo(i,2*mp1-2,k) = Vo(i,2*mp1-2,k)            &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Ve(i,2*mp1-2,k) = Ve(i,2*mp1-2,k)            &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Vo(i,2*mp1-1,k) = Vo(i,2*mp1-1,k)            &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           Ve(i,2*mp1-1,k) = Ve(i,2*mp1-1,k)            &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           Wo(i,2*mp1-2,k) = Wo(i,2*mp1-2,k)            &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           We(i,2*mp1-2,k) = We(i,2*mp1-2,k)            &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           Wo(i,2*mp1-1,k) = Wo(i,2*mp1-1,k)            &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                           We(i,2*mp1-1,k) = We(i,2*mp1-1,k)            &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Ve(Imid,2*mp1-2,k) = Ve(Imid,2*mp1-2,k)      &
                            & - Ci(mp1,np1,k)*Wb(Imid,np1,iw)
                           Ve(Imid,2*mp1-1,k) = Ve(Imid,2*mp1-1,k)      &
                            & + Cr(mp1,np1,k)*Wb(Imid,np1,iw)
                           We(Imid,2*mp1-2,k) = We(Imid,2*mp1-2,k)      &
                            & - Bi(mp1,np1,k)*Wb(Imid,np1,iw)
                           We(Imid,2*mp1-1,k) = We(Imid,2*mp1-1,k)      &
                            & + Br(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
               IF ( mp2<=ndo2 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        DO i = 1 , imm1
                           Ve(i,2*mp1-2,k) = Ve(i,2*mp1-2,k)            &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Vo(i,2*mp1-2,k) = Vo(i,2*mp1-2,k)            &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Ve(i,2*mp1-1,k) = Ve(i,2*mp1-1,k)            &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           Vo(i,2*mp1-1,k) = Vo(i,2*mp1-1,k)            &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           We(i,2*mp1-2,k) = We(i,2*mp1-2,k)            &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           Wo(i,2*mp1-2,k) = Wo(i,2*mp1-2,k)            &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           We(i,2*mp1-1,k) = We(i,2*mp1-1,k)            &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                           Wo(i,2*mp1-1,k) = Wo(i,2*mp1-1,k)            &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Ve(Imid,2*mp1-2,k) = Ve(Imid,2*mp1-2,k)      &
                            & + Br(mp1,np1,k)*Vb(Imid,np1,iv)
                           Ve(Imid,2*mp1-1,k) = Ve(Imid,2*mp1-1,k)      &
                            & + Bi(mp1,np1,k)*Vb(Imid,np1,iv)
                           We(Imid,2*mp1-2,k) = We(Imid,2*mp1-2,k)      &
                            & - Cr(mp1,np1,k)*Vb(Imid,np1,iv)
                           We(Imid,2*mp1-1,k) = We(Imid,2*mp1-1,k)      &
                            & - Ci(mp1,np1,k)*Vb(Imid,np1,iv)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ENDIF
      DO k = 1 , Nt
         CALL HRFFTB(Idv,Nlon,Ve(1,1,k),Idv,Wrfft,Vb)
         CALL HRFFTB(Idv,Nlon,We(1,1,k),Idv,Wrfft,Vb)
      ENDDO
      IF ( Ityp>2 ) THEN
         DO k = 1 , Nt
            DO j = 1 , Nlon
               DO i = 1 , imm1
                  V(i,j,k) = .5*Ve(i,j,k)
                  W(i,j,k) = .5*We(i,j,k)
               ENDDO
            ENDDO
         ENDDO
      ELSE
         DO k = 1 , Nt
            DO j = 1 , Nlon
               DO i = 1 , imm1
                  V(i,j,k) = .5*(Ve(i,j,k)+Vo(i,j,k))
                  W(i,j,k) = .5*(We(i,j,k)+Wo(i,j,k))
                  V(nlp1-i,j,k) = .5*(Ve(i,j,k)-Vo(i,j,k))
                  W(nlp1-i,j,k) = .5*(We(i,j,k)-Wo(i,j,k))
               ENDDO
            ENDDO
         ENDDO
      ENDIF
      IF ( mlat==0 ) RETURN
      DO k = 1 , Nt
         DO j = 1 , Nlon
            V(Imid,j,k) = .5*Ve(Imid,j,k)
            W(Imid,j,k) = .5*We(Imid,j,k)
         ENDDO
      ENDDO
    END SUBROUTINE VHSGC1


      SUBROUTINE VHSGCI(Nlat,Nlon,Wvhsgc,Lvhsgc,Dwork,Ldwork,Ierror)
      IMPLICIT NONE
      INTEGER Ierror , imid , iw1 , iw2 , iwrk , jw1 , jw2 , jw3 ,      &
            & labc , Ldwork , Lvhsgc , lwvbin , lzz1 , mmax , Nlat ,    &
            & Nlon
      REAL Wvhsgc
      DIMENSION Wvhsgc(Lvhsgc)
      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 ( Lvhsgc<2*(lzz1+labc)+Nlon+15 ) RETURN
      Ierror = 4
      IF ( Ldwork<2*Nlat*(Nlat+1)+1 ) RETURN
      Ierror = 0
!
!     compute gaussian points in first nlat+1 words of dwork
!     double precision
!
!     lwk = 2*nlat*(nlat+2)
      jw1 = 1
      jw2 = jw1 + Nlat
      jw3 = jw2 + Nlat
!     jw2 = jw1+nlat+nlat
!     jw3 = jw2+nlat+nlat
      CALL GAQD(Nlat,Dwork(jw1),Dwork(jw2),Dwork(jw3),Ldwork,Ierror)
!     iwrk = nlat+2
      iwrk = (Nlat+1)/2 + 1
      CALL VBGINT(Nlat,Nlon,Dwork,Wvhsgc,Dwork(iwrk))
      lwvbin = lzz1 + labc
      iw1 = lwvbin + 1
      CALL WBGINT(Nlat,Nlon,Dwork,Wvhsgc(iw1),Dwork(iwrk))
      iw2 = iw1 + lwvbin
      CALL HRFFTI(Nlon,Wvhsgc(iw2))
      END SUBROUTINE VHSGCI


      
      SUBROUTINE DVHSGC(Nlat,Nlon,Ityp,Nt,V,W,Idvw,Jdvw,Br,Bi,Cr,Ci,Mdab,&
                     & Ndab,Wvhsgc,Lvhsgc,Work,Lwork,Ierror)
      IMPLICIT NONE
      DOUBLE PRECISION Bi , Br , Ci , Cr , V , W , Work , Wvhsgc
      INTEGER idv , Idvw , Ierror , imid , ist , Ityp , iw1 , iw2 ,     &
            & iw3 , iw4 , iw5 , Jdvw , jw1 , jw2 , l1 , l2 , labc ,     &
            & lnl , Lvhsgc , lwmin
      INTEGER Lwork , lwzvin , lzz1 , 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) , Wvhsgc(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
!
!     check save work space length
!
      l1 = MIN0(Nlat,(Nlon+1)/2)
      l2 = (Nlat+1)/2
      lwmin = 4*Nlat*l2 + 3*MAX0(l1-2,0)*(2*Nlat-l1-1) + Nlon + 15
      IF ( Lvhsgc<lwmin ) RETURN
 
 
!     if(lvhsgc .lt. 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 DVHSGC1(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),Wvhsgc,Wvhsgc(jw1),Wvhsgc(jw2))
      END SUBROUTINE DVHSGC


      SUBROUTINE DVHSGC1(Nlat,Nlon,Ityp,Nt,Imid,Idvw,Jdvw,V,W,Mdab,Ndab, &
                      & Br,Bi,Cr,Ci,Idv,Ve,Vo,We,Wo,Vb,Wb,Wvbin,Wwbin,  &
                      & Wrfft)
      IMPLICIT NONE
      DOUBLE PRECISION Bi , Br , Ci , Cr , V , Vb , Ve , Vo , W , Wb , We , Wo ,    &
         & Wrfft , 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 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) , 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
               Ve(i,j,k) = 0.
               We(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 , Imid
                  Ve(i,1,k) = Ve(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 , imm1
                  Vo(i,1,k) = Vo(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
                           Vo(i,2*mp1-2,k) = Vo(i,2*mp1-2,k)            &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Vo(i,2*mp1-1,k) = Vo(i,2*mp1-1,k)            &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           We(i,2*mp1-2,k) = We(i,2*mp1-2,k)            &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           We(i,2*mp1-1,k) = We(i,2*mp1-1,k)            &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           We(Imid,2*mp1-2,k) = We(Imid,2*mp1-2,k)      &
                            & - Bi(mp1,np1,k)*Wb(Imid,np1,iw)
                           We(Imid,2*mp1-1,k) = We(Imid,2*mp1-1,k)      &
                            & + Br(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
               IF ( mp2<=ndo2 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        DO i = 1 , imm1
                           Ve(i,2*mp1-2,k) = Ve(i,2*mp1-2,k)            &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Ve(i,2*mp1-1,k) = Ve(i,2*mp1-1,k)            &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           Wo(i,2*mp1-2,k) = Wo(i,2*mp1-2,k)            &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           Wo(i,2*mp1-1,k) = Wo(i,2*mp1-1,k)            &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Ve(Imid,2*mp1-2,k) = Ve(Imid,2*mp1-2,k)      &
                            & + Br(mp1,np1,k)*Vb(Imid,np1,iv)
                           Ve(Imid,2*mp1-1,k) = Ve(Imid,2*mp1-1,k)      &
                            & + Bi(mp1,np1,k)*Vb(Imid,np1,iv)
                        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 , Imid
                  We(i,1,k) = We(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 , imm1
                  Wo(i,1,k) = Wo(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
                           Ve(i,2*mp1-2,k) = Ve(i,2*mp1-2,k)            &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Ve(i,2*mp1-1,k) = Ve(i,2*mp1-1,k)            &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           Wo(i,2*mp1-2,k) = Wo(i,2*mp1-2,k)            &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           Wo(i,2*mp1-1,k) = Wo(i,2*mp1-1,k)            &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Ve(Imid,2*mp1-2,k) = Ve(Imid,2*mp1-2,k)      &
                            & - Ci(mp1,np1,k)*Wb(Imid,np1,iw)
                           Ve(Imid,2*mp1-1,k) = Ve(Imid,2*mp1-1,k)      &
                            & + Cr(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
               IF ( mp2<=ndo2 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        DO i = 1 , imm1
                           Vo(i,2*mp1-2,k) = Vo(i,2*mp1-2,k)            &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Vo(i,2*mp1-1,k) = Vo(i,2*mp1-1,k)            &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           We(i,2*mp1-2,k) = We(i,2*mp1-2,k)            &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           We(i,2*mp1-1,k) = We(i,2*mp1-1,k)            &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           We(Imid,2*mp1-2,k) = We(Imid,2*mp1-2,k)      &
                            & - Cr(mp1,np1,k)*Vb(Imid,np1,iv)
                           We(Imid,2*mp1-1,k) = We(Imid,2*mp1-1,k)      &
                            & - Ci(mp1,np1,k)*Vb(Imid,np1,iv)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSEIF ( itypp==4 ) THEN
!
!     case ityp=3   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 , Imid
                  Ve(i,1,k) = Ve(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 , imm1
                  Wo(i,1,k) = Wo(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
                           Ve(i,2*mp1-2,k) = Ve(i,2*mp1-2,k)            &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Ve(i,2*mp1-1,k) = Ve(i,2*mp1-1,k)            &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           Wo(i,2*mp1-2,k) = Wo(i,2*mp1-2,k)            &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           Wo(i,2*mp1-1,k) = Wo(i,2*mp1-1,k)            &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Ve(Imid,2*mp1-2,k) = Ve(Imid,2*mp1-2,k)      &
                            & - Ci(mp1,np1,k)*Wb(Imid,np1,iw)
                           Ve(Imid,2*mp1-1,k) = Ve(Imid,2*mp1-1,k)      &
                            & + Cr(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
               IF ( mp2<=ndo2 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        DO i = 1 , imm1
                           Ve(i,2*mp1-2,k) = Ve(i,2*mp1-2,k)            &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Ve(i,2*mp1-1,k) = Ve(i,2*mp1-1,k)            &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           Wo(i,2*mp1-2,k) = Wo(i,2*mp1-2,k)            &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           Wo(i,2*mp1-1,k) = Wo(i,2*mp1-1,k)            &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Ve(Imid,2*mp1-2,k) = Ve(Imid,2*mp1-2,k)      &
                            & + Br(mp1,np1,k)*Vb(Imid,np1,iv)
                           Ve(Imid,2*mp1-1,k) = Ve(Imid,2*mp1-1,k)      &
                            & + Bi(mp1,np1,k)*Vb(Imid,np1,iv)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSEIF ( itypp==5 ) THEN
!
!     case ityp=4   v even,  w odd, 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 , Imid
                  Ve(i,1,k) = Ve(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
                           Ve(i,2*mp1-2,k) = Ve(i,2*mp1-2,k)            &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Ve(i,2*mp1-1,k) = Ve(i,2*mp1-1,k)            &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           Wo(i,2*mp1-2,k) = Wo(i,2*mp1-2,k)            &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           Wo(i,2*mp1-1,k) = Wo(i,2*mp1-1,k)            &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Ve(Imid,2*mp1-2,k) = Ve(Imid,2*mp1-2,k)      &
                            & + Br(mp1,np1,k)*Vb(Imid,np1,iv)
                           Ve(Imid,2*mp1-1,k) = Ve(Imid,2*mp1-1,k)      &
                            & + Bi(mp1,np1,k)*Vb(Imid,np1,iv)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSEIF ( itypp==6 ) THEN
!
!     case ityp=5   v even,  w odd,     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 , imm1
                  Wo(i,1,k) = Wo(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
                           Ve(i,2*mp1-2,k) = Ve(i,2*mp1-2,k)            &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Ve(i,2*mp1-1,k) = Ve(i,2*mp1-1,k)            &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           Wo(i,2*mp1-2,k) = Wo(i,2*mp1-2,k)            &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           Wo(i,2*mp1-1,k) = Wo(i,2*mp1-1,k)            &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Ve(Imid,2*mp1-2,k) = Ve(Imid,2*mp1-2,k)      &
                            & - Ci(mp1,np1,k)*Wb(Imid,np1,iw)
                           Ve(Imid,2*mp1-1,k) = Ve(Imid,2*mp1-1,k)      &
                            & + Cr(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSEIF ( itypp==7 ) THEN
!
!     case ityp=6   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 , Imid
                  We(i,1,k) = We(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 , imm1
                  Vo(i,1,k) = Vo(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
                           Vo(i,2*mp1-2,k) = Vo(i,2*mp1-2,k)            &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Vo(i,2*mp1-1,k) = Vo(i,2*mp1-1,k)            &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           We(i,2*mp1-2,k) = We(i,2*mp1-2,k)            &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           We(i,2*mp1-1,k) = We(i,2*mp1-1,k)            &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           We(Imid,2*mp1-2,k) = We(Imid,2*mp1-2,k)      &
                            & - Bi(mp1,np1,k)*Wb(Imid,np1,iw)
                           We(Imid,2*mp1-1,k) = We(Imid,2*mp1-1,k)      &
                            & + Br(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
               IF ( mp2<=ndo2 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        DO i = 1 , imm1
                           Vo(i,2*mp1-2,k) = Vo(i,2*mp1-2,k)            &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Vo(i,2*mp1-1,k) = Vo(i,2*mp1-1,k)            &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           We(i,2*mp1-2,k) = We(i,2*mp1-2,k)            &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           We(i,2*mp1-1,k) = We(i,2*mp1-1,k)            &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           We(Imid,2*mp1-2,k) = We(Imid,2*mp1-2,k)      &
                            & - Cr(mp1,np1,k)*Vb(Imid,np1,iv)
                           We(Imid,2*mp1-1,k) = We(Imid,2*mp1-1,k)      &
                            & - Ci(mp1,np1,k)*Vb(Imid,np1,iv)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSEIF ( itypp==8 ) THEN
!
!     case ityp=7   v odd, w even   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 , imm1
                  Vo(i,1,k) = Vo(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
                           Vo(i,2*mp1-2,k) = Vo(i,2*mp1-2,k)            &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Vo(i,2*mp1-1,k) = Vo(i,2*mp1-1,k)            &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           We(i,2*mp1-2,k) = We(i,2*mp1-2,k)            &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           We(i,2*mp1-1,k) = We(i,2*mp1-1,k)            &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           We(Imid,2*mp1-2,k) = We(Imid,2*mp1-2,k)      &
                            & - Bi(mp1,np1,k)*Wb(Imid,np1,iw)
                           We(Imid,2*mp1-1,k) = We(Imid,2*mp1-1,k)      &
                            & + Br(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ELSEIF ( itypp==9 ) THEN
!
!     case ityp=8   v odd,  w even   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 , Imid
                  We(i,1,k) = We(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
                           Vo(i,2*mp1-2,k) = Vo(i,2*mp1-2,k)            &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Vo(i,2*mp1-1,k) = Vo(i,2*mp1-1,k)            &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           We(i,2*mp1-2,k) = We(i,2*mp1-2,k)            &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           We(i,2*mp1-1,k) = We(i,2*mp1-1,k)            &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           We(Imid,2*mp1-2,k) = We(Imid,2*mp1-2,k)      &
                            & - Cr(mp1,np1,k)*Vb(Imid,np1,iv)
                           We(Imid,2*mp1-1,k) = We(Imid,2*mp1-1,k)      &
                            & - Ci(mp1,np1,k)*Vb(Imid,np1,iv)
                        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 , Imid
                  Ve(i,1,k) = Ve(i,1,k) + Br(1,np1,k)*Vb(i,np1,iv)
                  We(i,1,k) = We(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 , imm1
                  Vo(i,1,k) = Vo(i,1,k) + Br(1,np1,k)*Vb(i,np1,iv)
                  Wo(i,1,k) = Wo(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
                           Vo(i,2*mp1-2,k) = Vo(i,2*mp1-2,k)            &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Ve(i,2*mp1-2,k) = Ve(i,2*mp1-2,k)            &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Vo(i,2*mp1-1,k) = Vo(i,2*mp1-1,k)            &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           Ve(i,2*mp1-1,k) = Ve(i,2*mp1-1,k)            &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           Wo(i,2*mp1-2,k) = Wo(i,2*mp1-2,k)            &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           We(i,2*mp1-2,k) = We(i,2*mp1-2,k)            &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           Wo(i,2*mp1-1,k) = Wo(i,2*mp1-1,k)            &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                           We(i,2*mp1-1,k) = We(i,2*mp1-1,k)            &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Ve(Imid,2*mp1-2,k) = Ve(Imid,2*mp1-2,k)      &
                            & - Ci(mp1,np1,k)*Wb(Imid,np1,iw)
                           Ve(Imid,2*mp1-1,k) = Ve(Imid,2*mp1-1,k)      &
                            & + Cr(mp1,np1,k)*Wb(Imid,np1,iw)
                           We(Imid,2*mp1-2,k) = We(Imid,2*mp1-2,k)      &
                            & - Bi(mp1,np1,k)*Wb(Imid,np1,iw)
                           We(Imid,2*mp1-1,k) = We(Imid,2*mp1-1,k)      &
                            & + Br(mp1,np1,k)*Wb(Imid,np1,iw)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
               IF ( mp2<=ndo2 ) THEN
                  DO k = 1 , Nt
                     DO np1 = mp2 , ndo2 , 2
                        DO i = 1 , imm1
                           Ve(i,2*mp1-2,k) = Ve(i,2*mp1-2,k)            &
                            & + Br(mp1,np1,k)*Vb(i,np1,iv)
                           Vo(i,2*mp1-2,k) = Vo(i,2*mp1-2,k)            &
                            & - Ci(mp1,np1,k)*Wb(i,np1,iw)
                           Ve(i,2*mp1-1,k) = Ve(i,2*mp1-1,k)            &
                            & + Bi(mp1,np1,k)*Vb(i,np1,iv)
                           Vo(i,2*mp1-1,k) = Vo(i,2*mp1-1,k)            &
                            & + Cr(mp1,np1,k)*Wb(i,np1,iw)
                           We(i,2*mp1-2,k) = We(i,2*mp1-2,k)            &
                            & - Cr(mp1,np1,k)*Vb(i,np1,iv)
                           Wo(i,2*mp1-2,k) = Wo(i,2*mp1-2,k)            &
                            & - Bi(mp1,np1,k)*Wb(i,np1,iw)
                           We(i,2*mp1-1,k) = We(i,2*mp1-1,k)            &
                            & - Ci(mp1,np1,k)*Vb(i,np1,iv)
                           Wo(i,2*mp1-1,k) = Wo(i,2*mp1-1,k)            &
                            & + Br(mp1,np1,k)*Wb(i,np1,iw)
                        ENDDO
                        IF ( mlat/=0 ) THEN
                           Ve(Imid,2*mp1-2,k) = Ve(Imid,2*mp1-2,k)      &
                            & + Br(mp1,np1,k)*Vb(Imid,np1,iv)
                           Ve(Imid,2*mp1-1,k) = Ve(Imid,2*mp1-1,k)      &
                            & + Bi(mp1,np1,k)*Vb(Imid,np1,iv)
                           We(Imid,2*mp1-2,k) = We(Imid,2*mp1-2,k)      &
                            & - Cr(mp1,np1,k)*Vb(Imid,np1,iv)
                           We(Imid,2*mp1-1,k) = We(Imid,2*mp1-1,k)      &
                            & - Ci(mp1,np1,k)*Vb(Imid,np1,iv)
                        ENDIF
                     ENDDO
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ENDIF
      DO k = 1 , Nt
         CALL DHRFFTB(Idv,Nlon,Ve(1,1,k),Idv,Wrfft,Vb)
         CALL DHRFFTB(Idv,Nlon,We(1,1,k),Idv,Wrfft,Vb)
      ENDDO
      IF ( Ityp>2 ) THEN
         DO k = 1 , Nt
            DO j = 1 , Nlon
               DO i = 1 , imm1
                  V(i,j,k) = .5*Ve(i,j,k)
                  W(i,j,k) = .5*We(i,j,k)
               ENDDO
            ENDDO
         ENDDO
      ELSE
         DO k = 1 , Nt
            DO j = 1 , Nlon
               DO i = 1 , imm1
                  V(i,j,k) = .5*(Ve(i,j,k)+Vo(i,j,k))
                  W(i,j,k) = .5*(We(i,j,k)+Wo(i,j,k))
                  V(nlp1-i,j,k) = .5*(Ve(i,j,k)-Vo(i,j,k))
                  W(nlp1-i,j,k) = .5*(We(i,j,k)-Wo(i,j,k))
               ENDDO
            ENDDO
         ENDDO
      ENDIF
      IF ( mlat==0 ) RETURN
      DO k = 1 , Nt
         DO j = 1 , Nlon
            V(Imid,j,k) = .5*Ve(Imid,j,k)
            W(Imid,j,k) = .5*We(Imid,j,k)
         ENDDO
      ENDDO
    END SUBROUTINE DVHSGC1


      SUBROUTINE DVHSGCI(Nlat,Nlon,Wvhsgc,Lvhsgc,Dwork,Ldwork,Ierror)
      IMPLICIT NONE
      INTEGER Ierror , imid , iw1 , iw2 , iwrk , jw1 , jw2 , jw3 ,      &
            & labc , Ldwork , Lvhsgc , lwvbin , lzz1 , mmax , Nlat ,    &
            & Nlon
      DOUBLE PRECISION Wvhsgc
      DIMENSION Wvhsgc(Lvhsgc)
      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 ( Lvhsgc<2*(lzz1+labc)+Nlon+15 ) RETURN
      Ierror = 4
      IF ( Ldwork<2*Nlat*(Nlat+1)+1 ) RETURN
      Ierror = 0
!
!     compute gaussian points in first nlat+1 words of dwork
!     double precision
!
!     lwk = 2*nlat*(nlat+2)
      jw1 = 1
      jw2 = jw1 + Nlat
      jw3 = jw2 + Nlat
!     jw2 = jw1+nlat+nlat
!     jw3 = jw2+nlat+nlat
      CALL DGAQD(Nlat,Dwork(jw1),Dwork(jw2),Dwork(jw3),Ldwork,Ierror)
!     iwrk = nlat+2
      iwrk = (Nlat+1)/2 + 1
      CALL DVBGINT(Nlat,Nlon,Dwork,Wvhsgc,Dwork(iwrk))
      lwvbin = lzz1 + labc
      iw1 = lwvbin + 1
      CALL DWBGINT(Nlat,Nlon,Dwork,Wvhsgc(iw1),Dwork(iwrk))
      iw2 = iw1 + lwvbin
      CALL DHRFFTI(Nlon,Wvhsgc(iw2))
      END SUBROUTINE DVHSGCI

