c/* %W%      latest revision %G% %U% */
      subroutine COES2L( a , ldum )
************************************************************************

c *** Code ala Goddard

c *** Vss(i)      i=n ,s,sp=
c                       1: 11        2:10      3:1-1
c                       4: 01        5:00

c *** Vll' code , i=n, l', l= (same fixed l)
c                       1: l-2, l-1     2: l+2,l+1
c                       3: l ,l+1       4:l,l
c                       5: l, l-1

      implicit real*8 (a-h, o-z)
      dimension a(5,5)

c *** ldum = 1+l

      al = ldum - 1
      l = ldum - 1
      al2 = al + 2
      al1 = al + 1
      alm = al - 1
      twoal1 = 2 * al + 1

c *** Define theta function

      th1 = 1.

c *** RHL change for clarity and error

      if (l .eq. 0) th1 = 0.
      th2 = 1.
      if (l .le. 1) th2 = 0.

c *** Define Vllp to Vss matrix a

      a(1,1) = -sqrt( abs( alm * al ) )
      a(1,2) = -sqrt( al2 * al1 )
      a(1,3) = al2
      a(1,4) = twoal1
      a(1,5) = alm * th1
      a(2,1) = 0.
      if (l .ge. 2) a(2,1) = -sqrt( abs( alm/al ) )
      a(2,2) = +sqrt( al2/al1 )
      a(2,3) = +1.
      a(2,4) =  0.
      a(2,5) = -1.
      a(3,1) =  0.
      if (l .gt. 1) a(3,1) = -sqrt( 1./al/alm )
      a(3,2) = -sqrt( 1./al2/al1 )
      a(3,3) =  1./al1
      a(3,4) =  0.
      if (l .gt. 0) a(3,4) = -twoal1 * th1/al/al1
      a(3,5) =  0.
      if (l .ge. 1) a(3,5) = 1./al
      a(4,1) =  0.
      if (l .ge. 2) a(4,1) = -sqrt( abs( alm/al ) )
      a(4,2) = -sqrt( al2/al1 )
      a(4,3) = -al2/al1
      a(4,4) =  0.
      if (l .ge. 1) a(4,4) = +twoal1/al/al1
      a(4,5) =  0.
      if (l .ge. 2) a(4,5) = +alm/al
      a(5,1) = sqrt( abs( al*alm ) ) * th2 * th1
      a(5,2) = sqrt( al2 * al1 )
      a(5,3) = al1
      a(5,4) = 0.
      a(5,5) = al * th1

      RETURN
      end
