!  . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
!  .                                                             .
!  .                  copyright (c) 1998 by UCAR                 .
!  .                                                             .
!  .       University Corporation for Atmospheric Research       .
!  .                                                             .
!  .                      all rights reserved                    .
!  .                                                             .
!  .                                                             .
!  .                         SPHEREPACK3.0                       .
!  .                                                             .
!  . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
!
!
!
! ... file ivrtgs.f
!
!     this file includes documentation and code for
!     subroutine ivrtgs
!
! ... files which must be loaded with ivrtgs.f
!
!     sphcom.f, hrfft.f, vhsgs.f,shags.f, gaqd.f
!
!
!     subroutine ivrtgs(nlat,nlon,isym,nt,v,w,idvw,jdvw,a,b,mdab,ndab,
!    +                  wvhsgs,lvhsgs,work,lwork,pertrb,ierror)
!
!     given the scalar spherical harmonic coefficients a and b, precomputed
!     by subroutine shags for a scalar array vt, subroutine ivrtgs computes
!     a divergence free vector field (v,w) whose vorticity is vt - pertrb.
!     w is the east longitude component and v is the colatitudinal component.
!     pertrb is a constant which must be subtracted from vt for (v,w) to
!     exist (see the description of pertrb below).  usually pertrb is zero
!     or small relative to vt.  the divergence of (v,w), as computed by
!     ivrtgs, is the zero scalar field.  v(i,j) and w(i,j) are the
!     colatitudinal and east longitude velocity components at gaussian
!     colatitude theta(i) (see nlat as input parameter) and longitude
!     lambda(j) = (j-1)*2*pi/nlon.  the
!
!            vorticity(v(i,j),w(i,j))
!
!         =  [-dv/dlambda + d(sint*w)/dtheta]/sint
!
!         =  vort(i,j) - pertrb
!
!     and
!
!            divergence(v(i,j),w(i,j))
!
!         =  [d(sint*v)/dtheta + dw/dlambda]/sint
!
!         =  0.0
!
!     where sint = sin(theta(i)).  required associated legendre polynomials
!     are stored rather than recomputed as they are in subroutine ivrtgc.
!
!
!     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 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   this has the same value as the isym that was input to
!            subroutine shags to compute the arrays a and b.  isym
!            determines whether (v,w) are computed on the full or half
!            sphere as follows:
!
!      = 0
!            vt is not symmetric about the equator. in this case
!            the vector field (v,w) is computed on the entire sphere.
!            i.e., in the arrays  v(i,j),w(i,j) for i=1,...,nlat and
!            j=1,...,nlon.
!
!      = 1
!
!            vt is symmetric about the equator. in this case w is
!            antiymmetric and v is symmetric about the equator. v
!            and w are computed on the northern hemisphere only.  i.e.,
!            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
!
!            vt 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.  i.e.,
!            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 ivrtgs, nt is the number of vorticity
!            and vector fields.  some computational efficiency is obtained
!            for multiple fields.  the arrays a,b,v, and w can be three
!            dimensional and pertrb can be one dimensional corresponding
!            to an indexed multiple array vt.  in this case, multiple vector
!            synthesis will be performed to compute each vector field.  the
!            third index for a,b,v,w and first for pertrb is the synthesis
!            index which assumes the values k=1,...,nt.  for a single
!            synthesis set nt=1. the description of the remaining parameters
!            is simplified by assuming that nt=1 or that a,b,v,w are two
!            dimensional and pertrb is a constant.
!
!     idvw   the first dimension of the arrays v,w as it appears in
!            the program that calls ivrtgs. 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 ivrtgs. jdvw must be at least nlon.
!
!     a,b    two or three dimensional arrays (see input parameter nt)
!            that contain scalar spherical harmonic coefficients
!            of the vorticity array vt as computed by subroutine shags.
!     ***    a,b must be computed by shags prior to calling ivrtgs.
!
!     mdab   the first dimension of the arrays a and b as it appears in
!            the program that calls ivrtgs (and shags). 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 a and b as it appears in
!            the program that calls ivrtgs (and shags). ndab must be at
!            least nlat.
!
!
!  wvhsgs    an array which must be initialized by subroutine vhsgsi.
!            once initialized
!            wvhsgs can be used repeatedly by ivrtgs as long as nlon
!            and nlat remain unchanged.  wvhsgs must not be altered
!            between calls of ivrtgs.
!
!
!  lvhsgs    the dimension of the array wvhsgs as it appears in the
!            program that calls ivrtgs. 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 lvhsgs 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 ivrtgs. 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
!
!               (2*nt+1)*nlat*nlon + nlat*(2*nt*l1+1)
!
!            if isym = 1 or 2 then lwork must be at least
!
!               (2*nt+1)*l2*nlon + nlat*(2*nt*l1+1)
!
!
!     **************************************************************
!
!     output parameters
!
!
!     v,w   two or three dimensional arrays (see input parameter nt) that
!           contain a divergence free vector field whose vorticity is
!           vt - pertrb at the gaussian colatitude point theta(i)
!           and longitude point lambda(j)=(j-1)*2*pi/nlon.  w is the east
!           longitude component and v is the colatitudinal component.  the
!           indices for v and w are defined at the input parameter isym.
!           the divergence of (v,w) is the zero scalar field.
!
!   pertrb  a nt dimensional array (see input parameter nt and assume nt=1
!           for the description that follows).  vt - pertrb is a scalar
!           field which can be the vorticity of a vector field (v,w).
!           pertrb is related to the scalar harmonic coefficients a,b
!           of vt (computed by shags) by the formula
!
!                pertrb = a(1,1)/(2.*sqrt(2.))
!
!           an unperturbed vt can be the vorticity of a vector field
!           only if a(1,1) is zero.  if a(1,1) is nonzero (flagged by
!           pertrb nonzero) then subtracting pertrb from vt yields a
!           scalar field for which a(1,1) is zero.
!
!    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 lvhsgs
!           = 10 error in the specification of lwork
! **********************************************************************
!
!
      SUBROUTINE IVRTGS(Nlat,Nlon,Isym,Nt,V,W,Idvw,Jdvw,A,B,Mdab,Ndab,  &
                      & Wvhsgs,Lvhsgs,Work,Lwork,Pertrb,Ierror)
      IMPLICIT NONE
      REAL A , B , Pertrb , V , W , Work , Wvhsgs
      INTEGER ici , icr , Idvw , idz , Ierror , imid , is , Isym , iwk ,&
            & Jdvw , liwk , Lvhsgs , Lwork , lzimn , Mdab , mmax , mn , &
            & Ndab , Nlat , Nlon
      INTEGER Nt
      DIMENSION V(Idvw,Jdvw,Nt) , W(Idvw,Jdvw,Nt) , Pertrb(Nt)
      DIMENSION A(Mdab,Ndab,Nt) , B(Mdab,Ndab,Nt)
      DIMENSION Wvhsgs(Lvhsgs) , 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
!     lzz1 = 2*nlat*imid
!     labc = 3*(max0(mmax-2,0)*(nlat+nlat-mmax-1))/2
!     if(lvhsgs .lt. 2*(lzz1+labc)+nlon+15) return
      idz = (mmax*(Nlat+Nlat-mmax+1))/2
      lzimn = idz*imid
      IF ( Lvhsgs<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))       &
         & +2*mn+Nlat ) RETURN
      IF ( Isym==0 .AND. Lwork<imid*(2*Nt*Nlon+MAX0(6*Nlat,Nlon))       &
         & +2*mn+Nlat ) RETURN
      Ierror = 0
!
!     set work space pointers
!
      icr = 1
      ici = icr + mn
      is = ici + mn
      iwk = is + Nlat
      liwk = Lwork - 2*mn - Nlat
      CALL IVTGS1(Nlat,Nlon,Isym,Nt,V,W,Idvw,Jdvw,Work(icr),Work(ici),  &
                & mmax,Work(is),Mdab,Ndab,A,B,Wvhsgs,Lvhsgs,Work(iwk),  &
                & liwk,Pertrb,Ierror)
      END SUBROUTINE IVRTGS
 
      SUBROUTINE IVTGS1(Nlat,Nlon,Isym,Nt,V,W,Idvw,Jdvw,Cr,Ci,Mmax,Sqnn,&
                      & Mdab,Ndab,A,B,Wsav,Lsav,Wk,Lwk,Pertrb,Ierror)
      IMPLICIT NONE
      REAL A , B , bi , br , Ci , Cr , fn , Pertrb , Sqnn , V , W , Wk ,&
         & Wsav
      INTEGER Idvw , Ierror , Isym , ityp , Jdvw , k , Lsav , Lwk , m , &
            & Mdab , Mmax , n , Ndab , Nlat , Nlon , Nt
      DIMENSION V(Idvw,Jdvw,Nt) , W(Idvw,Jdvw,Nt) , Pertrb(Nt)
      DIMENSION Cr(Mmax,Nlat,Nt) , Ci(Mmax,Nlat,Nt) , Sqnn(Nlat)
      DIMENSION A(Mdab,Ndab,Nt) , B(Mdab,Ndab,Nt)
      DIMENSION Wsav(Lsav) , Wk(Lwk)
!
!     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 vorticity field perturbation adjustment
!
         Pertrb(k) = A(1,1,k)/(2.*SQRT(2.))
!
!     preset br,bi to 0.0
!
         DO n = 1 , Nlat
            DO m = 1 , Mmax
               Cr(m,n,k) = 0.0
               Ci(m,n,k) = 0.0
            ENDDO
         ENDDO
!
!     compute m=0 coefficients
!
         DO n = 2 , Nlat
            Cr(1,n,k) = A(1,n,k)/Sqnn(n)
            Ci(1,n,k) = B(1,n,k)/Sqnn(n)
         ENDDO
!
!     compute m>0 coefficients
!
         DO m = 2 , Mmax
            DO n = m , Nlat
               Cr(m,n,k) = A(m,n,k)/Sqnn(n)
               Ci(m,n,k) = B(m,n,k)/Sqnn(n)
            ENDDO
         ENDDO
      ENDDO
!
!     set ityp for vector synthesis with divergence=0
!
      IF ( Isym==0 ) THEN
         ityp = 2
      ELSEIF ( Isym==1 ) THEN
         ityp = 5
      ELSEIF ( Isym==2 ) THEN
         ityp = 8
      ENDIF
!
!     vector sythesize cr,ci into divergence free vector field (v,w)
!
      CALL VHSGS(Nlat,Nlon,ityp,Nt,V,W,Idvw,Jdvw,br,bi,Cr,Ci,Mmax,Nlat, &
               & Wsav,Lsav,Wk,Lwk,Ierror)
      END SUBROUTINE IVTGS1


      SUBROUTINE DIVRTGS(Nlat,Nlon,Isym,Nt,V,W,Idvw,Jdvw,A,B,Mdab,Ndab,  &
                      & Wvhsgs,Lvhsgs,Work,Lwork,Pertrb,Ierror)
      IMPLICIT NONE
      DOUBLE PRECISION A , B , Pertrb , V , W , Work , Wvhsgs
      INTEGER ici , icr , Idvw , idz , Ierror , imid , is , Isym , iwk ,&
            & Jdvw , liwk , Lvhsgs , Lwork , lzimn , Mdab , mmax , mn , &
            & Ndab , Nlat , Nlon
      INTEGER Nt
      DIMENSION V(Idvw,Jdvw,Nt) , W(Idvw,Jdvw,Nt) , Pertrb(Nt)
      DIMENSION A(Mdab,Ndab,Nt) , B(Mdab,Ndab,Nt)
      DIMENSION Wvhsgs(Lvhsgs) , 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
!     lzz1 = 2*nlat*imid
!     labc = 3*(max0(mmax-2,0)*(nlat+nlat-mmax-1))/2
!     if(lvhsgs .lt. 2*(lzz1+labc)+nlon+15) return
      idz = (mmax*(Nlat+Nlat-mmax+1))/2
      lzimn = idz*imid
      IF ( Lvhsgs<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))       &
         & +2*mn+Nlat ) RETURN
      IF ( Isym==0 .AND. Lwork<imid*(2*Nt*Nlon+MAX0(6*Nlat,Nlon))       &
         & +2*mn+Nlat ) RETURN
      Ierror = 0
!
!     set work space pointers
!
      icr = 1
      ici = icr + mn
      is = ici + mn
      iwk = is + Nlat
      liwk = Lwork - 2*mn - Nlat
      CALL DIVTGS1(Nlat,Nlon,Isym,Nt,V,W,Idvw,Jdvw,Work(icr),Work(ici),  &
                & mmax,Work(is),Mdab,Ndab,A,B,Wvhsgs,Lvhsgs,Work(iwk),  &
                & liwk,Pertrb,Ierror)
      END SUBROUTINE DIVRTGS
 
      SUBROUTINE DIVTGS1(Nlat,Nlon,Isym,Nt,V,W,Idvw,Jdvw,Cr,Ci,Mmax,Sqnn,&
                      & Mdab,Ndab,A,B,Wsav,Lsav,Wk,Lwk,Pertrb,Ierror)
      IMPLICIT NONE
      DOUBLE PRECISION A , B , bi , br , Ci , Cr , fn , Pertrb , Sqnn , V , W , Wk ,&
         & Wsav
      INTEGER Idvw , Ierror , Isym , ityp , Jdvw , k , Lsav , Lwk , m , &
            & Mdab , Mmax , n , Ndab , Nlat , Nlon , Nt
      DIMENSION V(Idvw,Jdvw,Nt) , W(Idvw,Jdvw,Nt) , Pertrb(Nt)
      DIMENSION Cr(Mmax,Nlat,Nt) , Ci(Mmax,Nlat,Nt) , Sqnn(Nlat)
      DIMENSION A(Mdab,Ndab,Nt) , B(Mdab,Ndab,Nt)
      DIMENSION Wsav(Lsav) , Wk(Lwk)
!
!     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 vorticity field perturbation adjustment
!
         Pertrb(k) = A(1,1,k)/(2.*SQRT(2.))
!
!     preset br,bi to 0.0
!
         DO n = 1 , Nlat
            DO m = 1 , Mmax
               Cr(m,n,k) = 0.0
               Ci(m,n,k) = 0.0
            ENDDO
         ENDDO
!
!     compute m=0 coefficients
!
         DO n = 2 , Nlat
            Cr(1,n,k) = A(1,n,k)/Sqnn(n)
            Ci(1,n,k) = B(1,n,k)/Sqnn(n)
         ENDDO
!
!     compute m>0 coefficients
!
         DO m = 2 , Mmax
            DO n = m , Nlat
               Cr(m,n,k) = A(m,n,k)/Sqnn(n)
               Ci(m,n,k) = B(m,n,k)/Sqnn(n)
            ENDDO
         ENDDO
      ENDDO
!
!     set ityp for vector synthesis with divergence=0
!
      IF ( Isym==0 ) THEN
         ityp = 2
      ELSEIF ( Isym==1 ) THEN
         ityp = 5
      ELSEIF ( Isym==2 ) THEN
         ityp = 8
      ENDIF
!
!     vector sythesize cr,ci into divergence free vector field (v,w)
!
      CALL DVHSGS(Nlat,Nlon,ityp,Nt,V,W,Idvw,Jdvw,br,bi,Cr,Ci,Mmax,Nlat, &
               & Wsav,Lsav,Wk,Lwk,Ierror)
      END SUBROUTINE DIVTGS1
