c/* %W%      latest revision %G% %U% */
      subroutine voptll(neles,kp,k,k0,i11,i00, i1m1, i10, i01, iss, i1s)
c***********************************************************************

c *** Computes the partial wave optical potential for 1/2 * 1/2 
c *** calling voptth to get the theta-dependent potential.
c     This sub is part of old VoptnA
c *** The l,l' expansion is given
c     in Goldberger and Watson p.397, similar to Haftel's Nuc Phys
c     A158(1970) article eq. 2.7.

      implicit real*8 (a-h, i, k, m, o-z)

      integer  kode, maxLs

      dimension xcos(192), wt(192), pl(100), plp(100), plpp(100)
      dimension nifty(20)
      dimension i11(100,2), i10(100,2), i01(100,2), iss(100,2)
      dimension i00(100,2), i1m1(100,2)
      dimension i1s(100,2)
      dimension sum1m1(100,2), sumss(100,2), sum01(100,2), sum10(100,2)
      dimension sum11(100,2), sum00(100,2)
      dimension sum1s(100,2)

c     optical potential pass via common vopt

      common /vopt/ v10(2), v1m1(2), v01(2), v11(2), v00(2), vss(2),
     &              v1s(2), vsum1, vsum2
      common /params/   hbarc, pi, mpi, xmn, nz, na, nes, nwaves
      common /switch/   nifty

      data ndata/0/
      data maxLs       / 100 /

c >>> FIRST EXECUTABLE STATEMENT <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

      ndata = 1
c ncoss changed to 48 from 32 to maintain consistency with >32 pw 29/11/88
      ncoss = 96
c     ncoss = 48

c *** RHL change of order in ncoss for better printout

      ag = 1.
      bg = -1.
c     tm 11/14/90 use ghe gauss change kode to 0
      kode = 0
      call GAUSS2 (ncoss, kode, ag, bg, xcos, wt)

 99    roeps = 1.
c
c set number of legendre polynomials (was 40 now neles+5)
      n = neles+5

c *** jjm = 1 for real part protons and neturons
c *** jjm = 2 for imag part protons and neutrons

      do 401 jj = 1,neles
         do 402 jmm = 1,2
            sum11(jj,jmm)  = 0.
            sum01(jj,jmm)  = 0.
            sumss(jj,jmm)  = 0.
            sum10(jj,jmm)  = 0.
            sum1m1(jj,jmm) = 0.
            sum00(jj,jmm)  = 0.
            sum1s(jj,jmm)  = 0.
 402     continue
 401  continue

c *** Do loop, over costh for partial wave projection

      do 20 ncos = 1,ncoss
         x = xcos(ncos)
         cthnuc = x


c *** potential call
c ***


         call voptth(kp, k, k0, cthnuc)

         wgt = -wt(ncos)

         call LEGPOL (x, pl, n)
         sinth = sqrt(1.-x**2)
         sth2 = sinth**2

c *** pl1 = +sinth pl'
c *** pl2 = sin**2 th  *pl''

         call PLPRME (x, plp, n)
         call PLDBLP (x, plpp, n)
c
c        partial wave projection
c
         do 12 j = 1,2
            uncero = v10(j) * wgt * sinth * roeps
            cero2 = v00(j) * wgt * roeps
            unoms = v1m1(j) * wgt * sth2 * roeps
            ceroun = v01(j) * wgt * roeps * sinth
            esese = vss(j) * wgt * roeps
            unouno = v11(j) * wgt * roeps
            unoese = v1s(j) * wgt * roeps * sinth

            do 40 l6 = 1,neles
               poly = pl(l6)
               polyp = plp(l6)
               polypp = plpp(l6)
               p10 = uncero * polyp
               p00 = cero2 * poly
               p1m1 = unoms * polypp
               p11 = unouno * poly
               p01 = ceroun * polyp
               pss = esese * poly
               p1s = unoese * polyp
               sum11(l6,j) = sum11(l6,j) + p11
               sum10(l6,j) = sum10(l6,j) + p10
               sum00(l6,j) = sum00(l6,j) + p00
               sum1m1(l6,j) = sum1m1(l6,j) + p1m1
               sumss(l6,j) = sumss(l6,j) + pss
               sum1s(l6,j) = sum1s(l6,j) + p1s

c *** RHL insert of next line missing in this version

               sum01(l6,j) = sum01(l6,j) + p01
  40        continue
  12     continue
  20  continue

      do 831 l = 1,neles
         do 832 lp = 1,2
            i11(l,lp) = sum11(l,lp)
            i00(l,lp) = sum00(l,lp)
            i1m1(l,lp) = sum1m1(l,lp)
            i01(l,lp) = sum01(l,lp)
            i10(l,lp) = sum10(l,lp)
            iss(l,lp) = sumss(l,lp)
            i1s(l,lp) = sum1s(l,lp)
 832     continue
 831  continue

      RETURN

      end