!  . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
!  .                                                             .
!  .                  copyright (c) 1998 by UCAR                 .
!  .                                                             .
!  .       University Corporation for Atmospheric Research       .
!  .                                                             .
!  .                      all rights reserved                    .
!  .                                                             .
!  .                                                             .
!  .                         SPHEREPACK3.0                       .
!  .                                                             .
!  . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
!
!
!
! ... file idvtes.f
!
!     this file includes documentation and code for
!     subroutine idvtes         i
!
! ... files which must be loaded with idvtes.f
!
!     sphcom.f, hrfft.f, vhses.f,shaes.f
!
!
!     subroutine idvtes(nlat,nlon,isym,nt,v,w,idvw,jdvw,ad,bd,av,bv,
!    +mdab,ndab,wvhses,lvhses,work,lwork,pertbd,pertbv,ierror)
!
!     given the scalar spherical harmonic coefficients ad,bd precomputed
!     by subroutine shaes for the scalar field divg and coefficients av,bv
!     precomputed by subroutine shaes for the scalar field vort, subroutine
!     idvtes computes a vector field (v,w) whose divergence is divg - pertbd
!     and whose vorticity is vort - pertbv.  w the is east longitude component
!     and v is the colatitudinal component of the velocity.  if nt=1 (see nt
!     below) pertrbd and pertbv are constants which must be subtracted from
!     divg and vort for (v,w) to exist (see the description of pertbd and
!     pertrbv below).  usually pertbd and pertbv are zero or small relative
!     to divg and vort.  w(i,j) and v(i,j) are the velocity components at
!     colatitude
!
!            theta(i) = (i-1)*pi/(nlat-1)
!
!     and longitude
!
!            lambda(j) = (j-1)*2*pi/nlon
!
!     the
!
!            divergence(v(i,j),w(i,j))
!
!         =  [d(sint*v)/dtheta + dw/dlambda]/sint
!
!         =  divg(i,j) - pertbd
!
!     and
!
!            vorticity(v(i,j),w(i,j))
!
!         =  [-dv/dlambda + d(sint*w)/dtheta]/sint
!
!         =  vort(i,j) - pertbv
!
!     where
!
!            sint = cos(theta(i)).
!
!
!     input parameters
!
!     nlat   the number of colatitudes on the full sphere including the
!            poles. for example, nlat = 37 for a five degree grid.
!            nlat determines the grid increment in colatitude as
!            pi/(nlat-1).  if nlat is odd the equator is located at
!            grid point i=(nlat+1)/2. if nlat is even the equator is
!            located half way between points i=nlat/2 and i=nlat/2+1.
!            nlat must be at least 3. note: on the half sphere, the
!            number of grid points in the colatitudinal direction is
!            nlat/2 if nlat is even or (nlat+1)/2 if nlat is odd.
!
!     nlon   the number of distinct londitude points.  nlon determines
!            the grid increment in longitude as 2*pi/nlon. for example
!            nlon = 72 for a five degree grid. nlon must be greater
!            than 3. the axisymmetric case corresponds to nlon=1.
!            the efficiency of the computation is improved when nlon
!            is a product of small prime numbers.
!
!
!     isym   isym determines whether (v,w) are computed on the full or half
!            sphere as follows:
!
!      = 0
!            divg,vort are neither pairwise symmetric/antisymmetric nor
!            antisymmetric/symmetric about the equator as described for
!            isym = 1 or isym = 2  below.  in this case, the vector field
!            (v,w) is computed on the entire sphere.  i.e., in the arrays
!            w(i,j) and v(i,j) i=1,...,nlat and j=1,...,nlon.
!
!      = 1
!
!            divg is antisymmetric and vort is symmetric about the equator.
!            in this case w is antisymmetric and v is symmetric about the
!            equator.  w and v are computed on the northern hemisphere only.
!            if nlat is odd they are computed for i=1,...,(nlat+1)/2
!            and j=1,...,nlon.  if nlat is even they are computed for
!            i=1,...,nlat/2 and j=1,...,nlon.
!
!      = 2
!
!            divg is symmetric and vort is antisymmetric about the equator.
!            in this case w is symmetric and v is antisymmetric about the
!            equator.  w and v are computed on the northern hemisphere only.
!            if nlat is odd they are computed for i=1,...,(nlat+1)/2
!            and j=1,...,nlon.  if nlat is even they are computed for
!            i=1,...,nlat/2 and j=1,...,nlon.
!
!
!     nt     in the program that calls idvtes, nt is the number of scalar
!            and vector fields.  some computational efficiency is obtained
!            for multiple fields.  the arrays ad,bd,av,bv,u, and v can be
!            three dimensional and pertbd,pertbv can be one dimensional
!            corresponding to indexed multiple arrays divg, vort.  in this
!            case, multiple synthesis will be performed to compute each
!            vector field.  the third index for ad,bd,av,bv,v,w and first
!            pertrbd,pertbv is the synthesis index which assumes the values
!            k=1,...,nt.  for a single synthesis set nt=1. the description of
!            remaining parameters is simplified by assuming that nt=1 or that
!            ad,bd,av,bv,v,w are two dimensional and pertbd,pertbv are
!            constants.
!
!     idvw   the first dimension of the arrays v,w as it appears in
!            the program that calls idvtes. if isym = 0 then idvw
!            must be at least nlat.  if isym = 1 or 2 and nlat is
!            even then idvw must be at least nlat/2. if isym = 1 or 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 idvtes. jdvw must be at least nlon.
!
!     ad,bd  two or three dimensional arrays (see input parameter nt)
!            that contain scalar spherical harmonic coefficients
!            of the divergence array divg as computed by subroutine shaes.
!
!     av,bv  two or three dimensional arrays (see input parameter nt)
!            that contain scalar spherical harmonic coefficients
!            of the vorticity array vort as computed by subroutine shaes.
!     ***    ad,bd,av,bv must be computed by shaes prior to calling idvtes.
!
!     mdab   the first dimension of the arrays ad,bd,av,bv as it appears
!            in the program that calls idvtes (and shaes). mdab must be at
!            least min0(nlat,(nlon+2)/2) if nlon is even or at least
!            min0(nlat,(nlon+1)/2) if nlon is odd.
!
!     ndab   the second dimension of the arrays ad,bd,av,bv as it appears in
!            the program that calls idvtes (and shaes). ndab must be at
!            least nlat.
!
!  wvhses    an array which must be initialized by subroutine vhsesi.
!            wvhses can be used repeatedly by idvtes as long as nlon
!            and nlat remain unchanged.  wvhses must not be altered
!            between calls of idvtes.
!
!
!  lvhses    the dimension of the array wvhses as it appears in the
!            program that calls idvtes. 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 lvhses must be at least
!
!               (l1*l2*(nlat+nlat-l1+1))/2+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 idvtes. define
!
!               l2 = nlat/2                    if nlat is even or
!               l2 = (nlat+1)/2                if nlat is odd
!               l1 = min0(nlat,nlon/2)       if nlon is even or
!               l1 = min0(nlat,(nlon+1)/2)   if nlon is odd
!
!            if isym = 0 then lwork must be at least
!
!                       nlat*((2*nt+1)*nlon+4*nt*l1+1)
!
!            if isym = 1 or 2 then lwork must be at least
!
!                       (2*nt+1)*l2*nlon+nlat*(4*nt*l1+1)
!
!     **************************************************************
!
!     output parameters
!
!
!     v,w   two or three dimensional arrays (see input parameter nt) that
!           contain a vector field whose divergence is divg - pertbd and
!           whose vorticity is vort - pertbv.  w(i,j) is the east longitude
!           component and v(i,j) is the colatitudinal component of velocity
!           at the colatitude theta(i) = (i-1)*pi/(nlat-1) and longitude
!           lambda(j) = (j-1)*2*pi/nlon for i=1,...,nlat and j=1,...,nlon.
!
!   pertbd  a nt dimensional array (see input parameter nt and assume nt=1
!           for the description that follows).  divg - pertbd is a scalar
!           field which can be the divergence of a vector field (v,w).
!           pertbd is related to the scalar harmonic coefficients ad,bd
!           of divg (computed by shaes) by the formula
!
!                pertbd = ad(1,1)/(2.*sqrt(2.))
!
!           an unperturbed divg can be the divergence of a vector field
!           only if ad(1,1) is zero.  if ad(1,1) is nonzero (flagged by
!           pertbd nonzero) then subtracting pertbd from divg yields a
!           scalar field for which ad(1,1) is zero.  usually pertbd is
!           zero or small relative to divg.
!
!   pertbv a nt dimensional array (see input parameter nt and assume nt=1
!           for the description that follows).  vort - pertbv is a scalar
!           field which can be the vorticity of a vector field (v,w).
!           pertbv is related to the scalar harmonic coefficients av,bv
!           of vort (computed by shaes) by the formula
!
!                pertbv = av(1,1)/(2.*sqrt(2.))
!
!           an unperturbed vort can be the vorticity of a vector field
!           only if av(1,1) is zero.  if av(1,1) is nonzero (flagged by
!           pertbv nonzero) then subtracting pertbv from vort yields a
!           scalar field for which av(1,1) is zero.  usually pertbv is
!           zero or small relative to vort.
!
!    ierror = 0  no errors
!           = 1  error in the specification of nlat
!           = 2  error in the specification of nlon
!           = 3  error in the specification of isym
!           = 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 lvhses
!           = 10 error in the specification of lwork
! **********************************************************************


      SUBROUTINE IDVTES(Nlat,Nlon,Isym,Nt,V,W,Idvw,Jdvw,Ad,Bd,Av,Bv,    &
                      & Mdab,Ndab,Wvhses,Lvhses,Work,Lwork,Pertbd,      &
                      & Pertbv,Ierror)
      IMPLICIT NONE

      REAL Ad , Av , Bd , Bv , Pertbd , Pertbv , V , W , Work , Wvhses
      INTEGER ibi , ibr , ici , icr , Idvw , idz , Ierror , imid , is , &
            & Isym , iwk , Jdvw , liwk , Lvhses , Lwork , lzimn , Mdab ,&
            & mmax , mn , Ndab
      INTEGER Nlat , Nlon , Nt

      DIMENSION W(Idvw,Jdvw,Nt) , V(Idvw,Jdvw,Nt) , Pertbd(Nt) ,        &
              & Pertbv(Nt)
      DIMENSION Ad(Mdab,Ndab,Nt) , Bd(Mdab,Ndab,Nt)
      DIMENSION Av(Mdab,Ndab,Nt) , Bv(Mdab,Ndab,Nt)
      DIMENSION Wvhses(Lvhses) , Work(Lwork)
!
!     check input parameters
!
      Ierror = 1
      IF ( Nlat<3 ) RETURN
      Ierror = 2
      IF ( Nlon<4 ) RETURN
      Ierror = 3
      IF ( Isym<0 .OR. Isym>2 ) RETURN
      Ierror = 4
      IF ( Nt<0 ) RETURN
      Ierror = 5
      imid = (Nlat+1)/2
      IF ( (Isym==0 .AND. Idvw<Nlat) .OR. (Isym/=0 .AND. Idvw<imid) )   &
         & RETURN
      Ierror = 6
      IF ( Jdvw<Nlon ) RETURN
      Ierror = 7
      mmax = MIN0(Nlat,(Nlon+1)/2)
      IF ( Mdab<MIN0(Nlat,(Nlon+2)/2) ) RETURN
      Ierror = 8
      IF ( Ndab<Nlat ) RETURN
      Ierror = 9
      idz = (mmax*(Nlat+Nlat-mmax+1))/2
      lzimn = idz*imid
      IF ( Lvhses<lzimn+lzimn+Nlon+15 ) RETURN
      Ierror = 10
!
!     verify unsaved work space length
!
      mn = mmax*Nlat*Nt
      IF ( Isym/=0 .AND. Lwork<Nlat*(2*Nt*Nlon+MAX0(6*imid,Nlon))       &
         & +4*mn+Nlat ) RETURN
      IF ( Isym==0 .AND. Lwork<imid*(2*Nt*Nlon+MAX0(6*Nlat,Nlon))       &
         & +4*mn+Nlat ) RETURN
      Ierror = 0
!
!     set work space pointers
!
      ibr = 1
      ibi = ibr + mn
      icr = ibi + mn
      ici = icr + mn
      is = ici + mn
      iwk = is + Nlat
      liwk = Lwork - 4*mn - Nlat
      CALL IDVTES1(Nlat,Nlon,Isym,Nt,V,W,Idvw,Jdvw,Work(ibr),Work(ibi), &
                 & Work(icr),Work(ici),mmax,Work(is),Mdab,Ndab,Ad,Bd,Av,&
                 & Bv,Wvhses,Lvhses,Work(iwk),liwk,Pertbd,Pertbv,Ierror)
    END SUBROUTINE IDVTES


    SUBROUTINE IDVTES1(Nlat,Nlon,Isym,Nt,V,W,Idvw,Jdvw,Br,Bi,Cr,Ci,   &
           & Mmax,Sqnn,Mdab,Ndab,Ad,Bd,Av,Bv,Widvtes,       &
                       & Lidvtes,Wk,Lwk,Pertbd,Pertbv,Ierror)
      IMPLICIT NONE
      REAL Ad , Av , Bd , Bi , Br , Bv , Ci , Cr , fn , Pertbd ,        &
         & Pertbv , Sqnn , V , W , Widvtes , Wk
      INTEGER Idvw , Ierror , Isym , ityp , Jdvw , k , Lidvtes , Lwk ,  &
            & m , Mdab , Mmax , n , Ndab , Nlat , Nlon , Nt
      DIMENSION W(Idvw,Jdvw,Nt) , V(Idvw,Jdvw,Nt)
      DIMENSION Br(Mmax,Nlat,Nt) , Bi(Mmax,Nlat,Nt) , Sqnn(Nlat)
      DIMENSION Cr(Mmax,Nlat,Nt) , Ci(Mmax,Nlat,Nt)
      DIMENSION Ad(Mdab,Ndab,Nt) , Bd(Mdab,Ndab,Nt)
      DIMENSION Av(Mdab,Ndab,Nt) , Bv(Mdab,Ndab,Nt)
      DIMENSION Widvtes(Lidvtes) , Wk(Lwk)
      DIMENSION Pertbd(Nt) , Pertbv(Nt)
!
!     preset coefficient multiplyers in vector
!
      DO n = 2 , Nlat
         fn = FLOAT(n-1)
         Sqnn(n) = SQRT(fn*(fn+1.))
      ENDDO
!
!     compute multiple vector fields coefficients
!
      DO k = 1 , Nt
!
!     set divergence,vorticity perturbation constants
!
         Pertbd(k) = Ad(1,1,k)/(2.*SQRT(2.))
         Pertbv(k) = Av(1,1,k)/(2.*SQRT(2.))
!
!     preset br,bi,cr,ci to 0.0
!
         DO n = 1 , Nlat
            DO m = 1 , Mmax
               Br(m,n,k) = 0.0
               Bi(m,n,k) = 0.0
               Cr(m,n,k) = 0.0
               Ci(m,n,k) = 0.0
            ENDDO
         ENDDO
!
!     compute m=0 coefficients
!
         DO n = 2 , Nlat
            Br(1,n,k) = -Ad(1,n,k)/Sqnn(n)
            Bi(1,n,k) = -Bd(1,n,k)/Sqnn(n)
            Cr(1,n,k) = Av(1,n,k)/Sqnn(n)
            Ci(1,n,k) = Bv(1,n,k)/Sqnn(n)
         ENDDO
!
!     compute m>0 coefficients
!
         DO m = 2 , Mmax
            DO n = m , Nlat
               Br(m,n,k) = -Ad(m,n,k)/Sqnn(n)
               Bi(m,n,k) = -Bd(m,n,k)/Sqnn(n)
               Cr(m,n,k) = Av(m,n,k)/Sqnn(n)
               Ci(m,n,k) = Bv(m,n,k)/Sqnn(n)
            ENDDO
         ENDDO
      ENDDO
!
!     set ityp for vector synthesis without assuming div=0 or curl=0
!
      IF ( Isym==0 ) THEN
         ityp = 0
      ELSEIF ( Isym==1 ) THEN
         ityp = 3
      ELSEIF ( Isym==2 ) THEN
         ityp = 6
      ENDIF
!
!     sythesize br,bi,cr,ci into the vector field (v,w)
!
      CALL VHSES(Nlat,Nlon,ityp,Nt,V,W,Idvw,Jdvw,Br,Bi,Cr,Ci,Mmax,Nlat, &
               & Widvtes,Lidvtes,Wk,Lwk,Ierror)
      END SUBROUTINE IDVTES1


      SUBROUTINE DIDVTES(Nlat,Nlon,Isym,Nt,V,W,Idvw,Jdvw,Ad,Bd,Av,Bv,    &
                      & Mdab,Ndab,Wvhses,Lvhses,Work,Lwork,Pertbd,      &
                      & Pertbv,Ierror)
      IMPLICIT NONE

      DOUBLE PRECISION Ad , Av , Bd , Bv , Pertbd , Pertbv , V , W , Work , Wvhses
      INTEGER ibi , ibr , ici , icr , Idvw , idz , Ierror , imid , is , &
            & Isym , iwk , Jdvw , liwk , Lvhses , Lwork , lzimn , Mdab ,&
            & mmax , mn , Ndab
      INTEGER Nlat , Nlon , Nt

      DIMENSION W(Idvw,Jdvw,Nt) , V(Idvw,Jdvw,Nt) , Pertbd(Nt) ,        &
              & Pertbv(Nt)
      DIMENSION Ad(Mdab,Ndab,Nt) , Bd(Mdab,Ndab,Nt)
      DIMENSION Av(Mdab,Ndab,Nt) , Bv(Mdab,Ndab,Nt)
      DIMENSION Wvhses(Lvhses) , Work(Lwork)
!
!     check input parameters
!
      Ierror = 1
      IF ( Nlat<3 ) RETURN
      Ierror = 2
      IF ( Nlon<4 ) RETURN
      Ierror = 3
      IF ( Isym<0 .OR. Isym>2 ) RETURN
      Ierror = 4
      IF ( Nt<0 ) RETURN
      Ierror = 5
      imid = (Nlat+1)/2
      IF ( (Isym==0 .AND. Idvw<Nlat) .OR. (Isym/=0 .AND. Idvw<imid) )   &
         & RETURN
      Ierror = 6
      IF ( Jdvw<Nlon ) RETURN
      Ierror = 7
      mmax = MIN0(Nlat,(Nlon+1)/2)
      IF ( Mdab<MIN0(Nlat,(Nlon+2)/2) ) RETURN
      Ierror = 8
      IF ( Ndab<Nlat ) RETURN
      Ierror = 9
      idz = (mmax*(Nlat+Nlat-mmax+1))/2
      lzimn = idz*imid
      IF ( Lvhses<lzimn+lzimn+Nlon+15 ) RETURN
      Ierror = 10
!
!     verify unsaved work space length
!
      mn = mmax*Nlat*Nt
      IF ( Isym/=0 .AND. Lwork<Nlat*(2*Nt*Nlon+MAX0(6*imid,Nlon))       &
         & +4*mn+Nlat ) RETURN
      IF ( Isym==0 .AND. Lwork<imid*(2*Nt*Nlon+MAX0(6*Nlat,Nlon))       &
         & +4*mn+Nlat ) RETURN
      Ierror = 0
!
!     set work space pointers
!
      ibr = 1
      ibi = ibr + mn
      icr = ibi + mn
      ici = icr + mn
      is = ici + mn
      iwk = is + Nlat
      liwk = Lwork - 4*mn - Nlat
      CALL DIDVTES1(Nlat,Nlon,Isym,Nt,V,W,Idvw,Jdvw,Work(ibr),Work(ibi), &
                 & Work(icr),Work(ici),mmax,Work(is),Mdab,Ndab,Ad,Bd,Av,&
                 & Bv,Wvhses,Lvhses,Work(iwk),liwk,Pertbd,Pertbv,Ierror)
    END SUBROUTINE DIDVTES


    SUBROUTINE DIDVTES1(Nlat,Nlon,Isym,Nt,V,W,Idvw,Jdvw,Br,Bi,Cr,Ci,   &
           & Mmax,Sqnn,Mdab,Ndab,Ad,Bd,Av,Bv,Widvtes,       &
                       & Lidvtes,Wk,Lwk,Pertbd,Pertbv,Ierror)
      IMPLICIT NONE
      DOUBLE PRECISION Ad , Av , Bd , Bi , Br , Bv , Ci , Cr , fn , Pertbd ,        &
         & Pertbv , Sqnn , V , W , Widvtes , Wk
      INTEGER Idvw , Ierror , Isym , ityp , Jdvw , k , Lidvtes , Lwk ,  &
            & m , Mdab , Mmax , n , Ndab , Nlat , Nlon , Nt
      DIMENSION W(Idvw,Jdvw,Nt) , V(Idvw,Jdvw,Nt)
      DIMENSION Br(Mmax,Nlat,Nt) , Bi(Mmax,Nlat,Nt) , Sqnn(Nlat)
      DIMENSION Cr(Mmax,Nlat,Nt) , Ci(Mmax,Nlat,Nt)
      DIMENSION Ad(Mdab,Ndab,Nt) , Bd(Mdab,Ndab,Nt)
      DIMENSION Av(Mdab,Ndab,Nt) , Bv(Mdab,Ndab,Nt)
      DIMENSION Widvtes(Lidvtes) , Wk(Lwk)
      DIMENSION Pertbd(Nt) , Pertbv(Nt)
!
!     preset coefficient multiplyers in vector
!
      DO n = 2 , Nlat
         fn = FLOAT(n-1)
         Sqnn(n) = SQRT(fn*(fn+1.))
      ENDDO
!
!     compute multiple vector fields coefficients
!
      DO k = 1 , Nt
!
!     set divergence,vorticity perturbation constants
!
         Pertbd(k) = Ad(1,1,k)/(2.*SQRT(2.))
         Pertbv(k) = Av(1,1,k)/(2.*SQRT(2.))
!
!     preset br,bi,cr,ci to 0.0
!
         DO n = 1 , Nlat
            DO m = 1 , Mmax
               Br(m,n,k) = 0.0
               Bi(m,n,k) = 0.0
               Cr(m,n,k) = 0.0
               Ci(m,n,k) = 0.0
            ENDDO
         ENDDO
!
!     compute m=0 coefficients
!
         DO n = 2 , Nlat
            Br(1,n,k) = -Ad(1,n,k)/Sqnn(n)
            Bi(1,n,k) = -Bd(1,n,k)/Sqnn(n)
            Cr(1,n,k) = Av(1,n,k)/Sqnn(n)
            Ci(1,n,k) = Bv(1,n,k)/Sqnn(n)
         ENDDO
!
!     compute m>0 coefficients
!
         DO m = 2 , Mmax
            DO n = m , Nlat
               Br(m,n,k) = -Ad(m,n,k)/Sqnn(n)
               Bi(m,n,k) = -Bd(m,n,k)/Sqnn(n)
               Cr(m,n,k) = Av(m,n,k)/Sqnn(n)
               Ci(m,n,k) = Bv(m,n,k)/Sqnn(n)
            ENDDO
         ENDDO
      ENDDO
!
!     set ityp for vector synthesis without assuming div=0 or curl=0
!
      IF ( Isym==0 ) THEN
         ityp = 0
      ELSEIF ( Isym==1 ) THEN
         ityp = 3
      ELSEIF ( Isym==2 ) THEN
         ityp = 6
      ENDIF
!
!     sythesize br,bi,cr,ci into the vector field (v,w)
!
      CALL DVHSES(Nlat,Nlon,ityp,Nt,V,W,Idvw,Jdvw,Br,Bi,Cr,Ci,Mmax,Nlat, &
               & Widvtes,Lidvtes,Wk,Lwk,Ierror)
      END SUBROUTINE DIDVTES1
