!  . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
!  .                                                             .
!  .                  copyright (c) 1998 by UCAR                 .
!  .                                                             .
!  .       University Corporation for Atmospheric Research       .
!  .                                                             .
!  .                      all rights reserved                    .
!  .                                                             .
!  .                                                             .
!  .                         SPHEREPACK3.0                       .
!  .                                                             .
!  . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
!
!
!
! ... file divgc.f
!
!     this file includes documentation and code for
!     subroutine divgc          i
!
! ... files which must be loaded with divgc.f
!
!     sphcom.f, hrfft.f, vhagc.f, shsgc.f, gaqd.f
!
!
!     subroutine divgc(nlat,nlon,isym,nt,dv,idv,jdv,br,bi,mdb,ndb,
!    +                 wshsgc,lshsgc,work,lwork,ierror)
!
!     given the vector spherical harmonic coefficients br and bi, precomputed
!     by subroutine vhagc for a vector field (v,w), subroutine divgc
!     computes the divergence of the vector field in the scalar array dv.
!     dv(i,j) is the divergence at the gaussian colatitude point theta(i)
!     (see nlat as input parameter) and east longitude
!
!            lambda(j) = (j-1)*2*pi/nlon
!
!     on the sphere.  i.e.
!
!            dv(i,j) = 1/sint*[ d(sint*v(i,j))/dtheta + d(w(i,j))/dlambda ]
!
!     where sint = sin(theta(i)).  w is the east longitudinal and v
!     is the colatitudinal component of the vector field from which
!     br,bi were precomputed.  required associated legendre polynomials
!     are recomputed rather than stored as they are in subroutine divgs.
!
!
!     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.
!
!
!     isym   a parameter which determines whether the divergence is
!            computed on the full or half sphere as follows:
!
!      = 0
!
!            the symmetries/antsymmetries described in isym=1,2 below
!            do not exist in (v,w) about the equator.  in this case the
!            divergence is neither symmetric nor antisymmetric about
!            the equator.  the divergence is computed on the entire
!            sphere.  i.e., in the array dv(i,j) for i=1,...,nlat and
!            j=1,...,nlon.
!
!      = 1
!
!            w is antisymmetric and v is symmetric about the equator.
!            in this case the divergence is antisymmetyric about
!            the equator and is computed for the northern hemisphere
!            only.  i.e., if nlat is odd the divergence is computed
!            in the array dv(i,j) for i=1,...,(nlat+1)/2 and for
!            j=1,...,nlon.  if nlat is even the divergence is computed
!            in the array dv(i,j) for i=1,...,nlat/2 and j=1,...,nlon.
!
!      = 2
!            w is symmetric and v is antisymmetric about the equator
!            in this case the divergence is symmetyric about the
!            equator and is computed for the northern hemisphere
!            only.  i.e., if nlat is odd the divergence is computed
!            in the array dv(i,j) for i=1,...,(nlat+1)/2 and for
!            j=1,...,nlon.  if nlat is even the divergence is computed
!            in the array dv(i,j) for i=1,...,nlat/2 and j=1,...,nlon.
!
!
!     nt     nt is the number of scalar and vector fields.  some
!            computational efficiency is obtained for multiple fields.
!            in the program that calls divgc, the arrays br,bi, and dv
!            can be three dimensional corresponding to an indexed multiple
!            vector field.  in this case multiple scalar synthesis will
!            be performed to compute the divergence for each field.  the
!            third index 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 all the arrays are two dimensional.
!
!     idv    the first dimension of the array dv as it appears in
!            the program that calls divgc. if isym = 0 then idv
!            must be at least nlat.  if isym = 1 or 2 and nlat is
!            even then idv must be at least nlat/2. if isym = 1 or 2
!            and nlat is odd then idv must be at least (nlat+1)/2.
!
!     jdv    the second dimension of the array dv as it appears in
!            the program that calls divgc. jdv must be at least nlon.
!
!     br,bi  two or three dimensional arrays (see input parameter nt)
!            that contain vector spherical harmonic coefficients
!            of the vector field (v,w) as computed by subroutine vhagc.
!     ***    br and bi must be computed by vhagc prior to calling
!            divgc.
!
!     mdb    the first dimension of the arrays br and bi as it
!            appears in the program that calls divgc. mdb must be at
!            least min0(nlat,nlon/2) if nlon is even or at least
!            min0(nlat,(nlon+1)/2) if nlon is odd.
!
!     ndb    the second dimension of the arrays br and bi as it
!            appears in the program that calls divgc. ndb must be at
!            least nlat.
!
!
!     wshsgc an array which must be initialized by subroutine shsgci
!            once initialized, wshsgc can be used repeatedly by divgc
!            as long as nlon and nlat remain unchanged.  wshsgc must
!            not be altered between calls of divgc.
!
!
!     lshsgc the dimension of the array wshsgc as it appears in the
!            program that calls divgc. define
!
!               l1 = min0(nlat,(nlon+2)/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 lshsgc must be at least
!
!               nlat*(2*l2+3*l1-2)+3*l1*(1-l1)/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 divgc. define
!
!               l1 = min0(nlat,(nlon+2)/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
!
!
!            if isym is zero then lwork must be at least
!
!               nlat*(nlon*nt+max0(3*l2,nlon) + 2*nt*l1+1)
!
!            if isym is not zero then lwork must be at least
!
!               l2*(nlon*nt+max0(3*nlat,nlon)) + nlat*(2*nt*l1+1)
!
!
!     **************************************************************
!
!     output parameters
!
!
!    dv     a two or three dimensional array (see input parameter nt)
!           that contains the divergence of the vector field (v,w)
!           whose coefficients br,bi where computed by subroutine
!           vhagc.  dv(i,j) is the divergence at the gaussian colatitude
!           point theta(i) and longitude point lambda(j) = (j-1)*2*pi/nlon.
!           the index ranges are defined above at the input parameter
!           isym.
!
!
!    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 idv
!           = 6  error in the specification of jdv
!           = 7  error in the specification of mdb
!           = 8  error in the specification of ndb
!           = 9  error in the specification of lshsgc
!           = 10 error in the specification of lwork
! **********************************************************************
!
!
      SUBROUTINE DIVGC(Nlat,Nlon,Isym,Nt,Dv,Idv,Jdv,Br,Bi,Mdb,Ndb,      &
                     & Wshsgc,Lshsgc,Work,Lwork,Ierror)
      IMPLICIT NONE

      REAL Bi , Br , Dv , Work , Wshsgc
      INTEGER ia , ib , Idv , Ierror , imid , is , Isym , iwk , Jdv ,   &
            & l1 , l2 , lpimn , ls , Lshsgc , lwk , lwkmin , Lwork ,    &
            & mab , Mdb , mmax
      INTEGER mn , Ndb , Nlat , nln , Nlon , Nt

 
      DIMENSION Dv(Idv,Jdv,Nt) , Br(Mdb,Ndb,Nt) , Bi(Mdb,Ndb,Nt)
      DIMENSION Wshsgc(Lshsgc) , 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. Idv<Nlat) .OR. (Isym>0 .AND. Idv<imid) )      &
         & RETURN
      Ierror = 6
      IF ( Jdv<Nlon ) RETURN
      Ierror = 7
      IF ( Mdb<MIN0(Nlat,(Nlon+1)/2) ) RETURN
      mmax = MIN0(Nlat,(Nlon+2)/2)
      Ierror = 8
      IF ( Ndb<Nlat ) RETURN
      Ierror = 9
      imid = (Nlat+1)/2
      lpimn = (imid*mmax*(Nlat+Nlat-mmax+1))/2
!     check permanent work space length
      l2 = (Nlat+1)/2
      l1 = MIN0((Nlon+2)/2,Nlat)
      IF ( Lshsgc<Nlat*(2*l2+3*l1-2)+3*l1*(1-l1)/2+Nlon+15 ) RETURN
      Ierror = 10
!
!     verify unsaved work space (add to what shsgc requires)
!
      ls = Nlat
      IF ( Isym>0 ) ls = imid
      nln = Nt*ls*Nlon
!
!     set first dimension for a,b (as requried by shsgc)
!
      mab = MIN0(Nlat,Nlon/2+1)
      mn = mab*Nlat*Nt
!     if(lwork.lt. nln+ls*nlon+2*mn+nlat) return
      l1 = MIN0(Nlat,(Nlon+2)/2)
      l2 = (Nlat+1)/2
      IF ( Isym==0 ) THEN
         lwkmin = Nlat*(Nt*Nlon+MAX0(3*l2,Nlon)+2*Nt*l1+1)
      ELSE
         lwkmin = l2*(Nt*Nlon+MAX0(3*Nlat,Nlon)) + Nlat*(2*Nt*l1+1)
      ENDIF
      IF ( Lwork<lwkmin ) RETURN
 
 
      Ierror = 0
!
!     set work space pointers
!
      ia = 1
      ib = ia + mn
      is = ib + mn
      iwk = is + Nlat
      lwk = Lwork - 2*mn - Nlat
      CALL DIVGC1(Nlat,Nlon,Isym,Nt,Dv,Idv,Jdv,Br,Bi,Mdb,Ndb,Work(ia),  &
                & Work(ib),mab,Work(is),Wshsgc,Lshsgc,Work(iwk),lwk,    &
                & Ierror)
      END SUBROUTINE DIVGC

      
      SUBROUTINE DDIVGC(Nlat,Nlon,Isym,Nt,Dv,Idv,Jdv,Br,Bi,Mdb,Ndb,      &
                     & Wshsgc,Lshsgc,Work,Lwork,Ierror)
      IMPLICIT NONE
      DOUBLE PRECISION  Bi , Br , Dv , Work , Wshsgc
      INTEGER ia , ib , Idv , Ierror , imid , is , Isym , iwk , Jdv ,   &
            & l1 , l2 , lpimn , ls , Lshsgc , lwk , lwkmin , Lwork ,    &
            & mab , Mdb , mmax
      INTEGER mn , Ndb , Nlat , nln , Nlon , Nt
      
      DIMENSION Dv(Idv,Jdv,Nt) , Br(Mdb,Ndb,Nt) , Bi(Mdb,Ndb,Nt)
      DIMENSION Wshsgc(Lshsgc) , 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. Idv<Nlat) .OR. (Isym>0 .AND. Idv<imid) )      &
         & RETURN
      Ierror = 6
      IF ( Jdv<Nlon ) RETURN
      Ierror = 7
      IF ( Mdb<MIN0(Nlat,(Nlon+1)/2) ) RETURN
      mmax = MIN0(Nlat,(Nlon+2)/2)
      Ierror = 8
      IF ( Ndb<Nlat ) RETURN
      Ierror = 9
      imid = (Nlat+1)/2
      lpimn = (imid*mmax*(Nlat+Nlat-mmax+1))/2
!     check permanent work space length
      l2 = (Nlat+1)/2
      l1 = MIN0((Nlon+2)/2,Nlat)
      IF ( Lshsgc<Nlat*(2*l2+3*l1-2)+3*l1*(1-l1)/2+Nlon+15 ) RETURN
      Ierror = 10
!
!     verify unsaved work space (add to what shsgc requires)
!
      ls = Nlat
      IF ( Isym>0 ) ls = imid
      nln = Nt*ls*Nlon
!
!     set first dimension for a,b (as requried by shsgc)
!
      mab = MIN0(Nlat,Nlon/2+1)
      mn = mab*Nlat*Nt
!     if(lwork.lt. nln+ls*nlon+2*mn+nlat) return
      l1 = MIN0(Nlat,(Nlon+2)/2)
      l2 = (Nlat+1)/2
      IF ( Isym==0 ) THEN
         lwkmin = Nlat*(Nt*Nlon+MAX0(3*l2,Nlon)+2*Nt*l1+1)
      ELSE
         lwkmin = l2*(Nt*Nlon+MAX0(3*Nlat,Nlon)) + Nlat*(2*Nt*l1+1)
      ENDIF
      IF ( Lwork<lwkmin ) RETURN
 
 
      Ierror = 0
!
!     set work space pointers
!
      ia = 1
      ib = ia + mn
      is = ib + mn
      iwk = is + Nlat
      lwk = Lwork - 2*mn - Nlat
      CALL DDIVGC1(Nlat,Nlon,Isym,Nt,Dv,Idv,Jdv,Br,Bi,Mdb,Ndb,Work(ia),  &
                & Work(ib),mab,Work(is),Wshsgc,Lshsgc,Work(iwk),lwk,    &
                & Ierror)
      END SUBROUTINE DDIVGC

 
      SUBROUTINE DIVGC1(Nlat,Nlon,Isym,Nt,Dv,Idv,Jdv,Br,Bi,Mdb,Ndb,A,B, &
                      & Mab,Sqnn,Wshsgc,Lshsgc,Wk,Lwk,Ierror)
      IMPLICIT NONE

      REAL A , B , Bi , Br , Dv , fn , Sqnn
      REAL, DIMENSION(Lwk)    :: Wk
      REAL, DIMENSION(Lshsgc) :: Wshsgc 
      INTEGER Idv , Ierror , Isym , Jdv , k , Lshsgc , Lwk , m , Mab ,  &
            & Mdb , mmax , n , Ndb , Nlat , Nlon , Nt

      DIMENSION Dv(Idv,Jdv,Nt) , Br(Mdb,Ndb,Nt) , Bi(Mdb,Ndb,Nt)
      DIMENSION A(Mab,Nlat,Nt) , B(Mab,Nlat,Nt) , Sqnn(Nlat)
!
!     set coefficient multiplyers
!
      DO n = 2 , Nlat
         fn = FLOAT(n-1)
         Sqnn(n) = SQRT(fn*(fn+1.))
      ENDDO
!
!     compute divergence scalar coefficients for each vector field
!
      DO k = 1 , Nt
         DO n = 1 , Nlat
            DO m = 1 , Mab
               A(m,n,k) = 0.0
               B(m,n,k) = 0.0
            ENDDO
         ENDDO
!
!     compute m=0 coefficients
!
         DO n = 2 , Nlat
            A(1,n,k) = -Sqnn(n)*Br(1,n,k)
            B(1,n,k) = -Sqnn(n)*Bi(1,n,k)
         ENDDO
!
!     compute m>0 coefficients using vector spherepack value for mmax
!
         mmax = MIN0(Nlat,(Nlon+1)/2)
         DO m = 2 , mmax
            DO n = m , Nlat
               A(m,n,k) = -Sqnn(n)*Br(m,n,k)
               B(m,n,k) = -Sqnn(n)*Bi(m,n,k)
            ENDDO
         ENDDO
      ENDDO
!
!     synthesize a,b into dv
!
      CALL SHSGC(Nlat,Nlon,Isym,Nt,Dv,Idv,Jdv,A,B,Mab,Nlat,Wshsgc,      &
               & Lshsgc,Wk,Lwk,Ierror)
    END SUBROUTINE DIVGC1

    
    SUBROUTINE DDIVGC1(Nlat,Nlon,Isym,Nt,Dv,Idv,Jdv,Br,Bi,Mdb,Ndb,A,B, &
                      & Mab,Sqnn,Wshsgc,Lshsgc,Wk,Lwk,Ierror)
      IMPLICIT NONE

      DOUBLE PRECISION  A , B , Bi , Br , Dv , fn , Sqnn
      DOUBLE PRECISION, DIMENSION(Lwk)    :: Wk
      DOUBLE PRECISION, DIMENSION(Lshsgc) :: Wshsgc 
      INTEGER Idv , Ierror , Isym , Jdv , k , Lshsgc , Lwk , m , Mab ,  &
            & Mdb , mmax , n , Ndb , Nlat , Nlon , Nt

      DIMENSION Dv(Idv,Jdv,Nt) , Br(Mdb,Ndb,Nt) , Bi(Mdb,Ndb,Nt)
      DIMENSION A(Mab,Nlat,Nt) , B(Mab,Nlat,Nt) , Sqnn(Nlat)
!
!     set coefficient multiplyers
!
      DO n = 2 , Nlat
         fn = FLOAT(n-1)
         Sqnn(n) = SQRT(fn*(fn+1.))
      ENDDO
!
!     compute divergence scalar coefficients for each vector field
!
      DO k = 1 , Nt
         DO n = 1 , Nlat
            DO m = 1 , Mab
               A(m,n,k) = 0.0
               B(m,n,k) = 0.0
            ENDDO
         ENDDO
!
!     compute m=0 coefficients
!
         DO n = 2 , Nlat
            A(1,n,k) = -Sqnn(n)*Br(1,n,k)
            B(1,n,k) = -Sqnn(n)*Bi(1,n,k)
         ENDDO
!
!     compute m>0 coefficients using vector spherepack value for mmax
!
         mmax = MIN0(Nlat,(Nlon+1)/2)
         DO m = 2 , mmax
            DO n = m , Nlat
               A(m,n,k) = -Sqnn(n)*Br(m,n,k)
               B(m,n,k) = -Sqnn(n)*Bi(m,n,k)
            ENDDO
         ENDDO
      ENDDO
!
!     synthesize a,b into dv
!
      CALL DSHSGC(Nlat,Nlon,Isym,Nt,Dv,Idv,Jdv,A,B,Mab,Nlat,Wshsgc,      &
               & Lshsgc,Wk,Lwk,Ierror)
      END  SUBROUTINE  DDIVGC1

