!  . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
!  .                                                             .
!  .                  copyright (c) 1998 by UCAR                 .
!  .                                                             .
!  .       University Corporation for Atmospheric Research       .
!  .                                                             .
!  .                      all rights reserved                    .
!  .                                                             .
!  .                                                             .
!  .                         SPHEREPACK3.0                       .
!  .                                                             .
!  . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
!
!
!
! ... file ivlapec.f
!
!     this file includes documentation and code for
!     subroutine ivlapec
!
! ... files which must be loaded with ivlapec.f
!
!     sphcom.f, hrfft.f, vhaec.f, vhsec.f
!
!
!
!     subroutine ivlapec(nlat,nlon,ityp,nt,v,w,idvw,jdvw,br,bi,cr,ci,
!    +mdbc,ndbc,wvhsec,lvhsec,work,lwork,ierror)
!
!
!     subroutine ivlapec computes a the vector field (v,w) whose vector
!     laplacian is (vlap,wlap).  w and wlap are east longitudinal
!     components of the vectors.  v and vlap are colatitudinal components
!     of the vectors.  br,bi,cr, and ci are the vector harmonic coefficients
!     of (vlap,wlap).  these must be precomputed by vhaec and are input
!     parameters to ivlapec.  (v,w) have the same symmetry or lack of
!     symmetry about the about the equator as (vlap,wlap).  the input
!     parameters ityp,nt,mdbc,ndbc must have the same values used by
!     vhaec to compute br,bi,cr, and ci for (vlap,wlap).
!
!
!     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 longitude 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   this parameter should have the same value input to subroutine
!            vhaec to compute the coefficients br,bi,cr, and ci for the
!            vector field (vlap,wlap).  ityp is set as follows:
!
!            = 0  no symmetries exist in (vlap,wlap) about the equator. (v,w)
!                 is computed and stored on the entire sphere in the arrays
!                 arrays v(i,j) and w(i,j) for i=1,...,nlat and j=1,...,nlon.
!
!            = 1  no symmetries exist in (vlap,wlap) about the equator. (v,w)
!                 is computed and stored on the entire sphere in the arrays
!                 v(i,j) and w(i,j) for i=1,...,nlat and j=1,...,nlon.  the
!                 vorticity of (vlap,wlap) is zero so the coefficients cr and
!                 ci are zero and are not used.  the vorticity of (v,w) is
!                 also zero.
!
!
!            = 2  no symmetries exist in (vlap,wlap) about the equator. (v,w)
!                 is computed and stored on the entire sphere in the arrays
!                 w(i,j) and v(i,j) for i=1,...,nlat and j=1,...,nlon.  the
!                 divergence of (vlap,wlap) is zero so the coefficients br and
!                 bi are zero and are not used.  the divergence of (v,w) is
!                 also zero.
!
!            = 3  wlap is antisymmetric and vlap is symmetric about the
!                 equator. consequently w is antisymmetric and v is symmetric.
!                 (v,w) is computed and stored on the northern hemisphere
!                 only.  if nlat is odd, storage is in the arrays v(i,j),
!                 w(i,j) for i=1,...,(nlat+1)/2 and j=1,...,nlon.  if nlat
!                 is even, storage is in the arrays v(i,j),w(i,j) for
!                 i=1,...,nlat/2 and j=1,...,nlon.
!
!            = 4  wlap is antisymmetric and vlap is symmetric about the
!                 equator. consequently w is antisymmetric and v is symmetric.
!                 (v,w) is computed and stored on the northern hemisphere
!                 only.  if nlat is odd, storage is in the arrays v(i,j),
!                 w(i,j) for i=1,...,(nlat+1)/2 and j=1,...,nlon.  if nlat
!                 is even, storage is in the arrays v(i,j),w(i,j) for
!                 i=1,...,nlat/2 and j=1,...,nlon.  the vorticity of (vlap,
!                 wlap) is zero so the coefficients cr,ci are zero and
!                 are not used. the vorticity of (v,w) is also zero.
!
!            = 5  wlap is antisymmetric and vlap is symmetric about the
!                 equator. consequently w is antisymmetric and v is symmetric.
!                 (v,w) is computed and stored on the northern hemisphere
!                 only.  if nlat is odd, storage is in the arrays w(i,j),
!                 v(i,j) for i=1,...,(nlat+1)/2 and j=1,...,nlon.  if nlat
!                 is even, storage is in the arrays w(i,j),v(i,j) for
!                 i=1,...,nlat/2 and j=1,...,nlon.  the divergence of (vlap,
!                 wlap) is zero so the coefficients br,bi are zero and
!                 are not used. the divergence of (v,w) is also zero.
!
!
!            = 6  wlap is symmetric and vlap is antisymmetric about the
!                 equator. consequently w is symmetric and v is antisymmetric.
!                 (v,w) is computed and stored on the northern hemisphere
!                 only.  if nlat is odd, storage is in the arrays w(i,j),
!                 v(i,j) for i=1,...,(nlat+1)/2 and j=1,...,nlon.  if nlat
!                 is even, storage is in the arrays w(i,j),v(i,j) for
!                 i=1,...,nlat/2 and j=1,...,nlon.
!
!            = 7  wlap is symmetric and vlap is antisymmetric about the
!                 equator. consequently w is symmetric and v is antisymmetric.
!                 (v,w) is computed and stored on the northern hemisphere
!                 only.  if nlat is odd, storage is in the arrays w(i,j),
!                 v(i,j) for i=1,...,(nlat+1)/2 and j=1,...,nlon.  if nlat
!                 is even, storage is in the arrays w(i,j),v(i,j) for
!                 i=1,...,nlat/2 and j=1,...,nlon.  the vorticity of (vlap,
!                 wlap) is zero so the coefficients cr,ci are zero and
!                 are not used. the vorticity of (v,w) is also zero.
!
!            = 8  wlap is symmetric and vlap is antisymmetric about the
!                 equator. consequently w is symmetric and v is antisymmetric.
!                 (v,w) is computed and stored on the northern hemisphere
!                 only.  if nlat is odd, storage is in the arrays w(i,j),
!                 v(i,j) for i=1,...,(nlat+1)/2 and j=1,...,nlon.  if nlat
!                 is even, storage is in the arrays w(i,j),v(i,j) for
!                 i=1,...,nlat/2 and j=1,...,nlon.  the divergence of (vlap,
!                 wlap) is zero so the coefficients br,bi are zero and
!                 are not used. the divergence of (v,w) is also zero.
!
!
!     nt     nt is the number of vector fields (vlap,wlap). some computational
!            efficiency is obtained for multiple fields.  in the program
!            that calls ivlapec, the arrays v,w,br,bi,cr and ci can be
!            three dimensional corresponding to an indexed multiple vector
!            field.  in this case multiple vector synthesis will be performed
!            to compute the (v,w) for each field (vlap,wlap).  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 arrays are two dimensional.
!
!   idvw     the first dimension of the arrays w and v as it appears in
!            the program that calls ivlapec.  if ityp=0,1, or 2  then idvw
!            must be at least nlat.  if ityp > 2 and nlat is even then idvw
!            must be at least nlat/2. if ityp > 2 and nlat is odd then idvw
!            must be at least (nlat+1)/2.
!
!   jdvw     the second dimension of the arrays w and v as it appears in
!            the program that calls ivlapec. jdvw must be at least nlon.
!
!
!   br,bi    two or three dimensional arrays (see input parameter nt)
!   cr,ci    that contain vector spherical harmonic coefficients of the
!            vector field (vlap,wlap) as computed by subroutine vhaec.
!            br,bi,cr and ci must be computed by vhaec prior to calling
!            ivlapec.  if ityp=1,4, or 7 then cr,ci are not used and can
!            be dummy arguments.  if ityp=2,5, or 8 then br,bi are not
!            used and can be dummy arguments.
!
!    mdbc    the first dimension of the arrays br,bi,cr and ci as it
!            appears in the program that calls ivlapec.  mdbc must be
!            at least min0(nlat,nlon/2) if nlon is even or at least
!            min0(nlat,(nlon+1)/2) if nlon is odd.
!
!    ndbc    the second dimension of the arrays br,bi,cr and ci as it
!            appears in the program that calls ivlapec. ndbc must be at
!            least nlat.
!
!    wvhsec  an array which must be initialized by subroutine vhseci.
!            once initialized, wvhsec
!            can be used repeatedly by ivlapec as long as nlat and nlon
!            remain unchanged.  wvhsec must not be altered between calls
!            of ivlapec.
!
!    lvhsec  the dimension of the array wvhsec as it appears in the
!            program that calls ivlapec.  let
!
!               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 lvhsec must be at least
!
!            4*nlat*l2+3*max0(l1-2,0)*(nlat+nlat-l1-1)+nlon+15
!
!     work   a work array that does not have to be saved.
!
!     lwork  the dimension of the array work as it appears in the
!            program that calls ivlapec. 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 ityp .le. 2 then
!
!               nlat*(2*nt*nlon+max0(6*l2,nlon)) + nlat*(4*nt*l1+1)
!
!            or if ityp .gt. 2 let
!
!               l2*(2*nt*nlon+max0(6*nlat,nlon)) + nlat*(4*nt*l1+1)
!
!            will suffice as a minimum length for lwork
!            (see ierror=10 below)
!
!     **************************************************************
!
!     output parameters
!
!
!    v,w     two or three dimensional arrays (see input parameter nt) that
!            contain a vector field whose vector laplacian is (vlap,wlap).
!            w(i,j) is the east longitude and v(i,j) is the colatitudinal
!            component of the vector. v(i,j) and w(i,j) are given on the
!            sphere at the colatitude
!
!                 theta(i) = (i-1)*pi/(nlat-1)
!
!            for i=1,...,nlat and east longitude
!
!                 lambda(j) = (j-1)*2*pi/nlon
!
!            for j=1,...,nlon.
!
!            let cost and sint be the cosine and sine at colatitude theta.
!            let d( )/dlambda  and d( )/dtheta be the first order partial
!            derivatives in longitude and colatitude.  let sf be either v
!            or w.  define:
!
!                 del2s(sf) = [d(sint*d(sf)/dtheta)/dtheta +
!                               2            2
!                              d (sf)/dlambda /sint]/sint
!
!            then the vector laplacian of (v,w) in (vlap,wlap) satisfies
!
!                 vlap = del2s(v) + (2*cost*dw/dlambda - v)/sint**2
!
!            and
!
!                 wlap = del2s(w) - (2*cost*dv/dlambda + w)/sint**2
!
!
!  ierror    a parameter which flags errors in input parameters as follows:
!
!            = 0  no errors detected
!
!            = 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 mdbc
!
!            = 8  error in the specification of ndbc
!
!            = 9  error in the specification of lvhsec
!
!            = 10 error in the specification of lwork
!
!
! **********************************************************************
!
!     end of documentation for ivlapec
!
! **********************************************************************
!
      SUBROUTINE IVLAPEC(Nlat,Nlon,Ityp,Nt,V,W,Idvw,Jdvw,Br,Bi,Cr,Ci,   &
                       & Mdbc,Ndbc,Wvhsec,Lvhsec,Work,Lwork,Ierror)
      IMPLICIT NONE

      REAL Bi , Br , Ci , Cr , V , W , Work , Wvhsec
      INTEGER ibi , ibr , ici , icr , Idvw , idz , Ierror , ifn , imid ,&
            & Ityp , iwk , Jdvw , labc , liwk , Lvhsec , lwkmin ,       &
            & Lwork , lzimn , lzz1 , Mdbc
      INTEGER mmax , mn , Ndbc , Nlat , Nlon , Nt
      DIMENSION V(Idvw,Jdvw,Nt) , W(Idvw,Jdvw,Nt)
      DIMENSION Br(Mdbc,Ndbc,Nt) , Bi(Mdbc,Ndbc,Nt)
      DIMENSION Cr(Mdbc,Ndbc,Nt) , Ci(Mdbc,Ndbc,Nt)
      DIMENSION Wvhsec(Lvhsec) , Work(Lwork)
      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 ( Mdbc<mmax ) RETURN
      Ierror = 8
      IF ( Ndbc<Nlat ) RETURN
      Ierror = 9
!
!     set minimum and verify saved workspace length
!
      idz = (mmax*(Nlat+Nlat-mmax+1))/2
      lzimn = idz*imid
!     lsavmin = lzimn+lzimn+nlon+15
!     if (lvhsec .lt. lsavmin) return
      lzz1 = 2*Nlat*imid
      labc = 3*(MAX0(mmax-2,0)*(Nlat+Nlat-mmax-1))/2
      IF ( Lvhsec<2*(lzz1+labc)+Nlon+15 ) RETURN
!
!     set minimum and verify unsaved work space length
!
      Ierror = 10
      mn = mmax*Nlat*Nt
      IF ( Ityp<3 ) THEN
!     no symmetry
         IF ( Ityp==0 ) THEN
!       br,bi,cr,ci nonzero
            lwkmin = Nlat*(2*Nt*Nlon+MAX0(6*imid,Nlon)+1) + 4*mn
         ELSE
!       br,bi or cr,ci zero
            lwkmin = Nlat*(2*Nt*Nlon+MAX0(6*imid,Nlon)+1) + 2*mn
         ENDIF
!     symmetry
      ELSEIF ( Ityp==3 .OR. Ityp==6 ) THEN
!       br,bi,cr,ci nonzero
         lwkmin = imid*(2*Nt*Nlon+MAX0(6*Nlat,Nlon)) + 4*mn + Nlat
      ELSE
!       br,bi or cr,ci zero
         lwkmin = imid*(2*Nt*Nlon+MAX0(6*Nlat,Nlon)) + 2*mn + Nlat
      ENDIF
      IF ( Lwork<lwkmin ) RETURN
      Ierror = 0
!
!     set work space pointers for vector laplacian coefficients
!
      IF ( Ityp==0 .OR. Ityp==3 .OR. Ityp==6 ) THEN
         ibr = 1
         ibi = ibr + mn
         icr = ibi + mn
         ici = icr + mn
      ELSEIF ( Ityp==1 .OR. Ityp==4 .OR. Ityp==7 ) THEN
         ibr = 1
         ibi = ibr + mn
         icr = ibi + mn
         ici = icr
      ELSE
         ibr = 1
         ibi = 1
         icr = ibi + mn
         ici = icr + mn
      ENDIF
      ifn = ici + mn
      iwk = ifn + Nlat
      IF ( Ityp==0 .OR. Ityp==3 .OR. Ityp==6 ) THEN
         liwk = Lwork - 4*mn - Nlat
      ELSE
         liwk = Lwork - 2*mn - Nlat
      ENDIF
      CALL IVLAPEC1(Nlat,Nlon,Ityp,Nt,V,W,Idvw,Jdvw,Work(ibr),Work(ibi),&
                  & Work(icr),Work(ici),mmax,Work(ifn),Mdbc,Ndbc,Br,Bi, &
                  & Cr,Ci,Wvhsec,Lvhsec,Work(iwk),liwk,Ierror)
    END SUBROUTINE IVLAPEC
 

    SUBROUTINE IVLAPEC1(Nlat,Nlon,Ityp,Nt,V,W,Idvw,Jdvw,Brvw,Bivw,    &
                        & Crvw,Civw,Mmax,Fnn,Mdbc,Ndbc,Br,Bi,Cr,Ci,     &
                        & Wsave,Lwsav,Wk,Lwk,Ierror)
      IMPLICIT NONE
      REAL Bi , Bivw , Br , Brvw , Ci , Civw , Cr , Crvw , fn , Fnn ,   &
         & V , W , Wk , Wsave
      INTEGER Idvw , Ierror , Ityp , Jdvw , k , Lwk , Lwsav , m , Mdbc ,&
            & Mmax , n , Ndbc , Nlat , Nlon , Nt

      DIMENSION V(Idvw,Jdvw,Nt) , W(Idvw,Jdvw,Nt)
      DIMENSION Fnn(Nlat) , Brvw(Mmax,Nlat,Nt) , Bivw(Mmax,Nlat,Nt)
      DIMENSION Crvw(Mmax,Nlat,Nt) , Civw(Mmax,Nlat,Nt)
      DIMENSION Br(Mdbc,Ndbc,Nt) , Bi(Mdbc,Ndbc,Nt)
      DIMENSION Cr(Mdbc,Ndbc,Nt) , Ci(Mdbc,Ndbc,Nt)
      DIMENSION Wsave(Lwsav) , Wk(Lwk)
!
!     preset coefficient multiplyers
!
      DO n = 2 , Nlat
         fn = FLOAT(n-1)
         Fnn(n) = -1.0/(fn*(fn+1.))
      ENDDO
!
!     set (v,w) coefficients from br,bi,cr,ci
!
      IF ( Ityp==0 .OR. Ityp==3 .OR. Ityp==6 ) THEN
!
!     all coefficients needed
!
         DO k = 1 , Nt
            DO n = 1 , Nlat
               DO m = 1 , Mmax
                  Brvw(m,n,k) = 0.0
                  Bivw(m,n,k) = 0.0
                  Crvw(m,n,k) = 0.0
                  Civw(m,n,k) = 0.0
               ENDDO
            ENDDO
            DO n = 2 , Nlat
               Brvw(1,n,k) = Fnn(n)*Br(1,n,k)
               Bivw(1,n,k) = Fnn(n)*Bi(1,n,k)
               Crvw(1,n,k) = Fnn(n)*Cr(1,n,k)
               Civw(1,n,k) = Fnn(n)*Ci(1,n,k)
            ENDDO
            DO m = 2 , Mmax
               DO n = m , Nlat
                  Brvw(m,n,k) = Fnn(n)*Br(m,n,k)
                  Bivw(m,n,k) = Fnn(n)*Bi(m,n,k)
                  Crvw(m,n,k) = Fnn(n)*Cr(m,n,k)
                  Civw(m,n,k) = Fnn(n)*Ci(m,n,k)
               ENDDO
            ENDDO
         ENDDO
      ELSEIF ( Ityp==1 .OR. Ityp==4 .OR. Ityp==7 ) THEN
!
!     vorticity is zero so cr,ci=0 not used
!
         DO k = 1 , Nt
            DO n = 1 , Nlat
               DO m = 1 , Mmax
                  Brvw(m,n,k) = 0.0
                  Bivw(m,n,k) = 0.0
               ENDDO
            ENDDO
            DO n = 2 , Nlat
               Brvw(1,n,k) = Fnn(n)*Br(1,n,k)
               Bivw(1,n,k) = Fnn(n)*Bi(1,n,k)
            ENDDO
            DO m = 2 , Mmax
               DO n = m , Nlat
                  Brvw(m,n,k) = Fnn(n)*Br(m,n,k)
                  Bivw(m,n,k) = Fnn(n)*Bi(m,n,k)
               ENDDO
            ENDDO
         ENDDO
      ELSE
!
!     divergence is zero so br,bi=0 not used
!
         DO k = 1 , Nt
            DO n = 1 , Nlat
               DO m = 1 , Mmax
                  Crvw(m,n,k) = 0.0
                  Civw(m,n,k) = 0.0
               ENDDO
            ENDDO
            DO n = 2 , Nlat
               Crvw(1,n,k) = Fnn(n)*Cr(1,n,k)
               Civw(1,n,k) = Fnn(n)*Ci(1,n,k)
            ENDDO
            DO m = 2 , Mmax
               DO n = m , Nlat
                  Crvw(m,n,k) = Fnn(n)*Cr(m,n,k)
                  Civw(m,n,k) = Fnn(n)*Ci(m,n,k)
               ENDDO
            ENDDO
         ENDDO
      ENDIF
!
!     sythesize coefs into vector field (v,w)
!
      CALL VHSEC(Nlat,Nlon,Ityp,Nt,V,W,Idvw,Jdvw,Brvw,Bivw,Crvw,Civw,   &
               & Mmax,Nlat,Wsave,Lwsav,Wk,Lwk,Ierror)
      END SUBROUTINE IVLAPEC1


      SUBROUTINE DIVLAPEC(Nlat,Nlon,Ityp,Nt,V,W,Idvw,Jdvw,Br,Bi,Cr,Ci,   &
                       & Mdbc,Ndbc,Wvhsec,Lvhsec,Work,Lwork,Ierror)
      IMPLICIT NONE

      DOUBLE PRECISION Bi , Br , Ci , Cr , V , W , Work , Wvhsec
      INTEGER ibi , ibr , ici , icr , Idvw , idz , Ierror , ifn , imid ,&
            & Ityp , iwk , Jdvw , labc , liwk , Lvhsec , lwkmin ,       &
            & Lwork , lzimn , lzz1 , Mdbc
      INTEGER mmax , mn , Ndbc , Nlat , Nlon , Nt
      DIMENSION V(Idvw,Jdvw,Nt) , W(Idvw,Jdvw,Nt)
      DIMENSION Br(Mdbc,Ndbc,Nt) , Bi(Mdbc,Ndbc,Nt)
      DIMENSION Cr(Mdbc,Ndbc,Nt) , Ci(Mdbc,Ndbc,Nt)
      DIMENSION Wvhsec(Lvhsec) , Work(Lwork)
      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 ( Mdbc<mmax ) RETURN
      Ierror = 8
      IF ( Ndbc<Nlat ) RETURN
      Ierror = 9
!
!     set minimum and verify saved workspace length
!
      idz = (mmax*(Nlat+Nlat-mmax+1))/2
      lzimn = idz*imid
!     lsavmin = lzimn+lzimn+nlon+15
!     if (lvhsec .lt. lsavmin) return
      lzz1 = 2*Nlat*imid
      labc = 3*(MAX0(mmax-2,0)*(Nlat+Nlat-mmax-1))/2
      IF ( Lvhsec<2*(lzz1+labc)+Nlon+15 ) RETURN
!
!     set minimum and verify unsaved work space length
!
      Ierror = 10
      mn = mmax*Nlat*Nt
      IF ( Ityp<3 ) THEN
!     no symmetry
         IF ( Ityp==0 ) THEN
!       br,bi,cr,ci nonzero
            lwkmin = Nlat*(2*Nt*Nlon+MAX0(6*imid,Nlon)+1) + 4*mn
         ELSE
!       br,bi or cr,ci zero
            lwkmin = Nlat*(2*Nt*Nlon+MAX0(6*imid,Nlon)+1) + 2*mn
         ENDIF
!     symmetry
      ELSEIF ( Ityp==3 .OR. Ityp==6 ) THEN
!       br,bi,cr,ci nonzero
         lwkmin = imid*(2*Nt*Nlon+MAX0(6*Nlat,Nlon)) + 4*mn + Nlat
      ELSE
!       br,bi or cr,ci zero
         lwkmin = imid*(2*Nt*Nlon+MAX0(6*Nlat,Nlon)) + 2*mn + Nlat
      ENDIF
      IF ( Lwork<lwkmin ) RETURN
      Ierror = 0
!
!     set work space pointers for vector laplacian coefficients
!
      IF ( Ityp==0 .OR. Ityp==3 .OR. Ityp==6 ) THEN
         ibr = 1
         ibi = ibr + mn
         icr = ibi + mn
         ici = icr + mn
      ELSEIF ( Ityp==1 .OR. Ityp==4 .OR. Ityp==7 ) THEN
         ibr = 1
         ibi = ibr + mn
         icr = ibi + mn
         ici = icr
      ELSE
         ibr = 1
         ibi = 1
         icr = ibi + mn
         ici = icr + mn
      ENDIF
      ifn = ici + mn
      iwk = ifn + Nlat
      IF ( Ityp==0 .OR. Ityp==3 .OR. Ityp==6 ) THEN
         liwk = Lwork - 4*mn - Nlat
      ELSE
         liwk = Lwork - 2*mn - Nlat
      ENDIF
      CALL DIVLAPEC1(Nlat,Nlon,Ityp,Nt,V,W,Idvw,Jdvw,Work(ibr),Work(ibi),&
                  & Work(icr),Work(ici),mmax,Work(ifn),Mdbc,Ndbc,Br,Bi, &
                  & Cr,Ci,Wvhsec,Lvhsec,Work(iwk),liwk,Ierror)
    END SUBROUTINE DIVLAPEC
 

    SUBROUTINE DIVLAPEC1(Nlat,Nlon,Ityp,Nt,V,W,Idvw,Jdvw,Brvw,Bivw,    &
                        & Crvw,Civw,Mmax,Fnn,Mdbc,Ndbc,Br,Bi,Cr,Ci,     &
                        & Wsave,Lwsav,Wk,Lwk,Ierror)
      IMPLICIT NONE
      DOUBLE PRECISION Bi , Bivw , Br , Brvw , Ci , Civw , Cr , Crvw , fn , Fnn ,   &
         & V , W , Wk , Wsave
      INTEGER Idvw , Ierror , Ityp , Jdvw , k , Lwk , Lwsav , m , Mdbc ,&
            & Mmax , n , Ndbc , Nlat , Nlon , Nt

      DIMENSION V(Idvw,Jdvw,Nt) , W(Idvw,Jdvw,Nt)
      DIMENSION Fnn(Nlat) , Brvw(Mmax,Nlat,Nt) , Bivw(Mmax,Nlat,Nt)
      DIMENSION Crvw(Mmax,Nlat,Nt) , Civw(Mmax,Nlat,Nt)
      DIMENSION Br(Mdbc,Ndbc,Nt) , Bi(Mdbc,Ndbc,Nt)
      DIMENSION Cr(Mdbc,Ndbc,Nt) , Ci(Mdbc,Ndbc,Nt)
      DIMENSION Wsave(Lwsav) , Wk(Lwk)
!
!     preset coefficient multiplyers
!
      DO n = 2 , Nlat
         fn = FLOAT(n-1)
         Fnn(n) = -1.0/(fn*(fn+1.))
      ENDDO
!
!     set (v,w) coefficients from br,bi,cr,ci
!
      IF ( Ityp==0 .OR. Ityp==3 .OR. Ityp==6 ) THEN
!
!     all coefficients needed
!
         DO k = 1 , Nt
            DO n = 1 , Nlat
               DO m = 1 , Mmax
                  Brvw(m,n,k) = 0.0
                  Bivw(m,n,k) = 0.0
                  Crvw(m,n,k) = 0.0
                  Civw(m,n,k) = 0.0
               ENDDO
            ENDDO
            DO n = 2 , Nlat
               Brvw(1,n,k) = Fnn(n)*Br(1,n,k)
               Bivw(1,n,k) = Fnn(n)*Bi(1,n,k)
               Crvw(1,n,k) = Fnn(n)*Cr(1,n,k)
               Civw(1,n,k) = Fnn(n)*Ci(1,n,k)
            ENDDO
            DO m = 2 , Mmax
               DO n = m , Nlat
                  Brvw(m,n,k) = Fnn(n)*Br(m,n,k)
                  Bivw(m,n,k) = Fnn(n)*Bi(m,n,k)
                  Crvw(m,n,k) = Fnn(n)*Cr(m,n,k)
                  Civw(m,n,k) = Fnn(n)*Ci(m,n,k)
               ENDDO
            ENDDO
         ENDDO
      ELSEIF ( Ityp==1 .OR. Ityp==4 .OR. Ityp==7 ) THEN
!
!     vorticity is zero so cr,ci=0 not used
!
         DO k = 1 , Nt
            DO n = 1 , Nlat
               DO m = 1 , Mmax
                  Brvw(m,n,k) = 0.0
                  Bivw(m,n,k) = 0.0
               ENDDO
            ENDDO
            DO n = 2 , Nlat
               Brvw(1,n,k) = Fnn(n)*Br(1,n,k)
               Bivw(1,n,k) = Fnn(n)*Bi(1,n,k)
            ENDDO
            DO m = 2 , Mmax
               DO n = m , Nlat
                  Brvw(m,n,k) = Fnn(n)*Br(m,n,k)
                  Bivw(m,n,k) = Fnn(n)*Bi(m,n,k)
               ENDDO
            ENDDO
         ENDDO
      ELSE
!
!     divergence is zero so br,bi=0 not used
!
         DO k = 1 , Nt
            DO n = 1 , Nlat
               DO m = 1 , Mmax
                  Crvw(m,n,k) = 0.0
                  Civw(m,n,k) = 0.0
               ENDDO
            ENDDO
            DO n = 2 , Nlat
               Crvw(1,n,k) = Fnn(n)*Cr(1,n,k)
               Civw(1,n,k) = Fnn(n)*Ci(1,n,k)
            ENDDO
            DO m = 2 , Mmax
               DO n = m , Nlat
                  Crvw(m,n,k) = Fnn(n)*Cr(m,n,k)
                  Civw(m,n,k) = Fnn(n)*Ci(m,n,k)
               ENDDO
            ENDDO
         ENDDO
      ENDIF
!
!     sythesize coefs into vector field (v,w)
!
      CALL DVHSEC(Nlat,Nlon,Ityp,Nt,V,W,Idvw,Jdvw,Brvw,Bivw,Crvw,Civw,   &
               & Mmax,Nlat,Wsave,Lwsav,Wk,Lwk,Ierror)
      END SUBROUTINE DIVLAPEC1
