      subroutine icode3(temp)
c
c     Calculates reduced matrix elements for the icode options
c
C
C     D(op)*PHI(J) = Sum(I)[C(J,I)*V(J,I)*PHI(I)]
C
C     I IS *INITIAL* STATE ( ON rhs OF EQUATION )
c     II=NTAB(I)
C     J IS * FINAL * STATE ( ON lhs OF EQUATION )
c     JJ=NTAB(J)
c
c      x denotes initial state
c      y denotes final   state
c
      common /integ /icode, ii,jj, klii,kljj, fmii,fmjj
     1              ,lx,isx,jx,ix, ly,isy,jy,iy, ll2,is2,jj2, jt
	common/ch3files/input, ioutp
c
      DATA SQR4PI,sqr8pi/3.5449077, 5.0132566/
c
      if(icode .eq. 0) go to 100
C  icode =   0   1   2   3   4   5   6   7   8   9
      goto(100,110,120,130,110,300,300,140,140, 99),icode+1
      goto(190,110,120,170,180, 99, 99,100, 99, 99),icode-09
      goto( 99,140,140,150,160,170,180,140,150,150),icode-19
      goto( 99, 99, 99, 99, 99, 99, 99,140,140, 99),icode-39
      goto( 99, 99, 99, 99, 99, 99, 99,140,140, 99),icode-49
      write(ioutp,'(a)')'0Invalid icode in INTEG  <------------'
   99 continue
      temp=0.0
      iout = 995
      return
C
C     COLLECTIVE  OPTIONS 0, 3 and 17
C
  100 CONTINUE
      IF(KLII.eq.KLJJ) then
        TEMP=TEMP*SQRT(FLOAT(IX+1))*VCC(IX,LL2,IY,KLII,0)
     1      *SQRT(FLOAT(ISY+1))*PHASEF((IY-IX-JJ2)/2)
     2      *VCC(LX,LL2,LY,0,0)*SQRT(FLOAT(LX+1)*FLOAT(LL2+1))
     3      *PHASEF((LX+LL2-LY)/4)/SQR4PI
      else
        TEMP=0.0
      endif
      if(icode .eq.17) then
        factr_ls = 0.25*(jx*(jx+2) - lx*(lx+2) - isx*(isx+2)
     1                 + jy*(jy+2) - ly*(ly+2) - isy*(isy+2))*0.25
c        write(ioutp,'(6i4,1pe15.6)')lx,isx,jx,ly,isy,jy,factr_ls
        temp = temp*factr_ls
      endif
      GO TO 300
  110 CONTINUE
C
C     PARTICLE TRANSFER  OPTION 1
C
      temp=temp
     1*VCC(LX,LL2,LY,0,0)*SQRT(FLOAT(LX+1)*FLOAT(LL2+1))
     2*PHASEF((LX+LL2-LY)/4)/SQR4PI
      IF    (FMII.GT.FMJJ+0.2) then
C       PICKUP
        TEMP=TEMP*SQRT(FLOAT((IX+1)*(ISY+1)))*PHASEF((IY +JJ2-IX )/2)
      ELSEIF(FMJJ.GT.FMII+0.2) then
C       STRIPPING
        TEMP=TEMP*SQRT(FLOAT((IY+1)*(ISX+1)))*PHASEF((ISY+IS2-ISX)/2)
      ELSE
	write(ioutp,'(2a,i3,a,i3)')' Transfer option has occured for'
     1  ,' equal mass targets, I =',ii,' ---> J =',jj
      ENDIF
      GO TO 300
  120 CONTINUE
C
C     MICROSCOPIC  OPTION 2
C
      TEMP=TEMP*PHASEF(JJ2/2)
     1*VCC(LX,LL2,LY,0,0)*SQRT(FLOAT(LX+1)*FLOAT(LL2+1))
     2*PHASEF((LX+LL2-LY)/4)/SQR4PI
      IF(IS2.EQ.0) TEMP=TEMP*SQRT(FLOAT(ISY+1))
      IF(IS2.EQ.2) TEMP=TEMP*SQRT(FLOAT((ISY+1)*(ISY)*(ISY+2))/3.0)
      IF(II.GT.JJ) TEMP=TEMP*PHASEF((IY+JJ2-IX+ISY+IS2-ISX)/2)
      GO TO 300
C
C     COLLECTIVE WEAK COUPLING MODEL
C     *** K IS NOT A GOOD QUANT. NO.        OPTION 3
C
  130 CONTINUE
      TEMP=TEMP*SQRT(FLOAT((ISY+1)*(IY+1))/FLOAT(LL2+1))
     1*PHASEF((IY-IX+LL2)/2)
     2*VCC(LX,LL2,LY,0,0)*SQRT(FLOAT(LX+1)*FLOAT(LL2+1))
     3*PHASEF((IX+LL2-IY)/4)/SQR4PI
      IF(II.LT.JJ) GO TO 300
      TEMP=TEMP*SQRT(FLOAT(IX+1)/FLOAT(IY+1))*PHASEF((LL2+IX-IY)/2)
      GO TO 300
C
C     Scalar, sigma * (2*I) and Tensor potentials  Options 7, 8, 21, 22 and 27
C
  140 CONTINUE
c
c     l dependent potential options
c
      if((icode.eq.47 .or. icode.eq.48) .and. lx.ne.0) temp=0.0
      if((icode.eq.57 .or. icode.eq.58) .and. lx.eq.0) temp=0.0
c
      TEMP=TEMP*PHASEF(JJ2/2)
     1*VCC(LX,LL2,LY,0,0)*SQRT(FLOAT(LX+1)*FLOAT(LL2+1))
     2*PHASEF((LX+LL2-LY)/4)/SQR4PI
      IF(LL2.eq.0.and.IS2.EQ.0) TEMP = TEMP*sqr4pi
     1   *SQRT(FLOAT((ISY+1)*(IY+1)))
      IF(LL2.eq.0.and.IS2.EQ.2) TEMP = TEMP*sqr4pi
     1   *sqrt(FLOAT((ISY+1)*(ISY)*(ISY+2))*float((iy+1)*iy*(iy+2)))
      IF(LL2.eq.4.and.IS2.EQ.2) TEMP = TEMP*sqr8pi
     1   *sqrt(FLOAT((ISY+1)*(ISY)*(ISY+2))*float((iy+1)*iy*(iy+2)))
      IF(II.GT.JJ) TEMP=TEMP*PHASEF((IY+JJ2-IX+ISY+IS2-ISX)/2)
      GO TO 300
c
c     Derivative coupling, term 1  options 23 and 28
c      li**2 - lf**2
c

  150 CONTINUE
      TEMP=TEMP*PHASEF(JJ2/2)
     1*VCC(LX,LL2,LY,0,0)*SQRT(FLOAT(LX+1)*FLOAT(LL2+1))
     2*PHASEF((LX+LL2-LY)/4)/SQR4PI
      if(ll2.eq.0.and.is2.eq.0) temp = temp*sqr4pi
     1   *sqrt(float((isy+1)*(iy+1)))
      if(ll2.eq.0.and.is2.eq.2) temp = temp*sqr4pi
     1   *(float((isy+1)*(isy)*(isy+2)))
      if(ll2.eq.4.and.is2.eq.2) temp = temp*sqr8pi
     1   *(float((isy+1)*(isy)*(isy+2)))
      if(ii.gt.jj) temp=temp*phasef((iy+jj2-ix+isy+is2-isx)/2)
      li=lx/2
      lf=ly/2
      temp=temp*(float(li*(li+1))-float(lf*(lf+1)))
      GO TO 300
c
c     Derivative coupling, term 2  option 24
c     (li**2 - lf**2)**2
c
  160 CONTINUE
      TEMP=TEMP*PHASEF(JJ2/2)
     1*VCC(LX,LL2,LY,0,0)*SQRT(FLOAT(LX+1)*FLOAT(LL2+1))
     2*PHASEF((LX+LL2-LY)/4)/SQR4PI
      IF(LL2.eq.0.and.IS2.EQ.0) TEMP = TEMP*sqr4pi
     1   *SQRT(FLOAT((ISY+1)*(IY+1)))
      IF(LL2.eq.0.and.IS2.EQ.2) TEMP = TEMP*sqr4pi
     1   *(FLOAT((ISY+1)*(ISY)*(ISY+2)))
      IF(LL2.eq.4.and.IS2.EQ.2) TEMP = TEMP*sqr8pi
     1   *(FLOAT((ISY+1)*(ISY)*(ISY+2)))
      IF(II.GT.JJ) TEMP=TEMP*PHASEF((IY+JJ2-IX+ISY+IS2-ISX)/2)
      li=lx/2
      lf=ly/2
      temp=temp*(float(li*(li+1))-float(lf*(lf+1)))**2
      GO TO 300
  170 CONTINUE
c
c     L*S coupling - projectile  option 13,15 and 25
c        deltaL = 1, deltaS = 1, deltaJ = 0
c
      if(lx.eq.ly.and.isx.eq.isy.and.ix.eq.iy) then
	t1=temp
      TEMP=TEMP*PHASEF(JJ2/2+1)
     1  *sqrt(float((isy+1)*(isy)*(isy+2))*float(iy+1)
     2  *float((ly+1)*(ly)*(ly+2)))*0.25
      IF(II.GT.JJ) TEMP=TEMP*PHASEF((IY+JJ2-IX+ISY+IS2-ISX)/2+1)
      else
      temp=0.0
      endif
      GO TO 300
  180 CONTINUE
c
c     L*S coupling - target   option 14,15 and 26
c        deltaL = 1, deltaS = 0, deltaJ = 1
c
      if(lx.eq.ly.and.isx.eq.isy.and.ix.eq.iy) then
	t1=temp
      TEMP=TEMP*PHASEF(JJ2/2)
     1  *sqrt(FLOAT(isy+1)*FLOAT((iy+1)*(iy)*(iy+2))/float(jj2+1)
     2  *float((ly+1)*(ly)*(ly+2)))*0.25
      IF(II.GT.JJ) TEMP=TEMP*PHASEF((IY+JJ2-IX+ISY+IS2-ISX)/2+1)
      else
      temp=0.0
      endif
      go to 300
  190 continue
c
c     TNT off-shell FR correction,   is(ii)=is(jj) = 1/2 only
c
      temp=temp*phasef((2-is2+ix-iy+jj2)/2)*sqrt(float((is2+1)*(ix+1)))
     1    *Racah(isx,1,isy,1,2,is2)*sqrt(3.0*float(isy+1))
     1*VCC(LX,LL2,LY,0,0)*SQRT(FLOAT(LX+1)*FLOAT(LL2+1))
     2*PHASEF((LX+LL2-LY)/4)/SQR4PI
      GO TO 300
c 
  300 CONTINUE
      return
      end

