
      SUBROUTINE KINEX(AKIN,W,ECM1,DRT,I,KMAX,IREL,ICON19,CONST)
c
      DIMENSION AKIN(32),BKIN(32),W(400),CONST(3)
      EQUIVALENCE (EN,BKIN(1)),(FM,BKIN(2)),(Z,BKIN(3)),(FMA,BKIN(4))
     1,(ZA,BKIN(5)),(RY,BKIN(6)),(FS,BKIN(7)),(ECM,BKIN(8))
     2,(FMU,BKIN(9)),(RC,BKIN(10)),(FK2,BKIN(11)),(FK,BKIN(12))
     3,(ETA,BKIN(13)),(AFACT,BKIN(14)),(PFACT,BKIN(15)),(DRF,BKIN(16))
     4,(FN,BKIN(17)), (PNLOC,BKIN(18)),(amass,bkin(19)),(vfact,BKIN(20))
     5,(sfact,bkin(21)),(fk0,bkin(22)),(hbarc,bkin(27))
c
	common/ch3files/input, ioutp
c
      data fma1/0.0/
C
C     I = 0    Form factor, single particle
C     I > 0    I = channel number
c     I < 0    Same as I = 0, except uses inputted drt as drf
C
      HBARC=CONST(1)
      AMU  =CONST(2)
      CHGSQ=CONST(3)
      READ (input,9000)EN ,FM,Z,FMA,ZA,RY,AC,PNLOC,FS,FN
C
      IF(I.EQ.1) FMA1=FMA
      amass=akin(19)
      if(amass.eq.0.0) amass=fma1
      if(i.ge.0) then
          DRF=DRT*amass/FMA
      else
        drf=drt
      endif
      AFACT=FMA**(1.0/3.0)
      PFACT=FM **(1.0/3.0)
      IF(RY.GE.0.0) RC=    RY * AFACT
      IF(RY.LT.0.0) RC=ABS(RY)*(AFACT+PFACT)
C
C     IREL=ICON(10).EQ.0 GIVES NON-RELATIVISTIC KINEMATICS
      IF(IREL.EQ.0.AND.FM.NE.0.0) THEN
C
      FMF = FMA/(FM+FMA)
      FMU=FM*FMF
      IF(I.EQ.1) THEN
        ECM =EN*FMA/(FM+FMA)
        ECM1=ECM
        ELAB=EN
        Q=0.0
      ELSE IF(I.EQ.0) THEN
        ECM =EN+FN
        ELAB=ECM
      ELSE
        ECM =ECM1+EN+FN
        ELAB=ECM/FMF
      ENDIF
        FACT=2.0*FMU*AMU/HBARC**2
        FK2=ECM*FACT
        plab= sqrt(abs(elab*2.0*amu*fm))
        vfact=fact
        sfact=fact
C
      ELSE
C
C     IREL=ICON(10).NE.0 GIVES RELATIVISTIC KINEMATICS
C
      FM1=FM *AMU
      FM2=FMA*AMU
      FMT=FM1+FM2
C     GET EQUIVALENT LAB ENERGY
      IF(I.EQ.1) THEN
        ELAB=EN
      ELSE IF(I.EQ.0) THEN
        ELAB=((    +EN+FN+FMT)**2-FMT**2)/(2.0*FM2)
      ELSE
        ELAB=((ECM1+EN+FN+FMT)**2-FMT**2)/(2.0*FM2)
      ENDIF
      wcm=SQRT(2.0*ELAB*FM2+FMT**2)
      wlab=elab+fmt
      gamm=wlab/wcm
      W1=(FMT*FM1+FM2*ELAB)/wcm
      W2=FM2*(ELAB+FMT)/wcm
      ECM=wcm-FMT
      IF(I.EQ.1) ECM1=ECM
      if    (irel.eq.1 .or. fm.eq.0.0) then
c     icon(10) = 1 uses reduced energy
        fmu=w1*w2/(w1+w2)
        vfact=2.0*fmu/hbarc**2
        sfact=2.0*fm1*fm2/(fm1+fm2)/hbarc**2
        fact=vfact
      elseif(irel.eq.2) then
c     icon(10) = 2 uses reduced mass
        fmu=fm1*fm2/(fm1+fm2)
        vfact=2.0*fm1*fm2/(fm1+fm2)/hbarc**2
        sfact=vfact
        fact =vfact
        fact =2.0*w1*w2/(w1+w2)/hbarc**2
      elseif(irel.eq.3) then
c     dirac kinematics selected by icon(10) = 3
        fmu = w1
        vfact=2.0*w1 /hbarc**2
        sfact=2.0*fm1/hbarc**2
        fact=vfact
      elseif(irel.gt.3) then
        write(ioutp,'(a,i2)')' Invalid icon(10) value =',irel
      endif
      FMU=FMU/AMU
      FK2=(ELAB**2+2.0*ELAB*FM1)*(FM2/(wcm*HBARC))**2
      plab=sqrt(abs((elab+fm1)**2-(fm1)**2))
      ENDIF
      IF(FK2.NE.0.0) THEN
        FK=SQRT(ABS(FK2))
        ETAK=CHGSQ*Z*ZA*FACT
        ETA=0.5*ETAK/FK
      ELSE
        FK=0.0
        ETA=0.0
        ETAK=CHGSQ*Z*ZA*FACT
      ENDIF
   81 CONTINUE
      Q=ECM-ECM1
      RHO=FK*RC
      DRHOC=DRF*FK
      if(icon19  .eq.0) then
      plabcm = fk*hbarc
      WRITE(ioutp,9012)ELAB,RY,FS,AC,plab
      WRITE(ioutp,9013)FM,FMA,Q
      WRITE(ioutp,9014)Z,ZA,DRF,PNLOC
      WRITE(ioutp,9015)ECM,RC,RHO
      WRITE(ioutp,9016)FK,ETA,DRHOC,plabcm
      endif
      if(i.eq.1) fk0 = fk
      R=0.0
      DO 100 M=1,KMAX
      R=R+DRF
      MK=M+M-1
      IF(R.GT.RC) GO TO 90
      FC=0.5*ETAK*(3.0-(R/RC)**2)/RC
      GO TO 95
   90 CONTINUE
      FC=ETAK/R
   95 CONTINUE
      IF(I.EQ.0) GO TO 98
      W(MK  )=FK2-FC
      W(MK+1)=0.0
      GO TO 99
   98 CONTINUE
      W(MK+1)=FK2-FC
      W(MK  )=0.0
   99 CONTINUE
  100 CONTINUE
C
C
      DO 110 J=1,32
      AKIN(J)=BKIN(J)
  110 CONTINUE
      RETURN
 9000 FORMAT(10F8.4)
 9012 FORMAT(18H0INPUT DATA       ,9H   ELAB =,F9.4,9H   RC0  =,F9.4
     1,                            9H   2*S  =,F9.4,9h   AC   =,f9.2
     2,                            9h   Plab =,f9.2,9h  MeV/c  )
 9013 FORMAT(18H                  ,9H   MASSP=,F9.4,9H   MASST=,F9.4
     1,                            9H   Q    =,F9.4)
 9014 FORMAT(18H                  ,9H   ZP   =,F9.4,9H   ZT   =,F9.4
     1,                            9H   DR   =,F9.4,9H   PNLOC=,F9.4)
 9015 FORMAT(18H0DERIVED DATA     ,9H   ECM  =,F9.4,9H   RC   =,F9.4
     1,                            9H   RHOC =,F9.4)
 9016 FORMAT(18H                  ,9H   K    =,F9.4,9H   ETA  =,F9.4
     1,                            9H   DRHOC=,F9.4,18x
     2,                            9H   P_cm =,f9.2,9h  MeV/c  )
      END

