
C
C                  ***************************
C                  ******   KALP2   **********
C                  ***************************
C
C KALPHA2 ELIMINATION BY RACHINGER AND LADELL METHODS
C REWRITTEN BY TERRY QUICK (LLL) FROM ORIGINAL VERSION WRITTEN BY RAY
C GOEHNER (GE)
C
      SUBROUTINE KALP2(LU,SS,DX,N,ITG,IK2)
C
      DIMENSION DELTA(3,7),WEIGHT(3,7),JRA(5),JLA(5)
      REAL ICU(3),ICR(3),IFE(3),ICO(3),IMO(3),INI(3),IAG(3)
      BYTE IK2
C
      DATA ICU/1.54051,1.54433,1.54178/
      DATA ICR/2.28962,2.29351,2.29092/
      DATA IFE/1.93597,1.93991,1.93728/
      DATA ICO/1.78892,1.79278,1.79021/
      DATA IMO/0.709261,0.713543,0.710688/
      DATA INI/1.65791,1.66175,1.65919/
      DATA IAG/0.55941,0.56381,0.56088/
      DATA JCU,JCR,JFE,JCO,JMO,JNI,JAG/'CU','CR','FE','CO','MO','NI',
     X'AG'/
      DATA JRA/'RA','CH','IN','GE','R '/
      DATA JLA/'  ','LA','DE','LL','  '/
      DATA RTOD/57.29578/
      DATA DTOR/0.01745329/
      DATA DELTA/
     1  0.00235350, 0.00227832, 0.00224083,
     2  0.00245360, 0.00239096, 0.00231594,
     3  0.00257883, 0.00245360, 0.00239106,
     4  0.0       , 0.00252866, 0.00245360,
     5  0.0       , 0.00264143, 0.00251624,
     6  0.0       , 0.0       , 0.00259135,
     7  0.0       , 0.0       , 0.00266647/
      DATA WEIGHT/
     1 -0.15276646, -0.0555895, -0.02497642,
     2 -0.26868760, -0.0971770, -0.05466330,
     3 -0.11017310, -0.2686876, -0.07312673,
     4  0.0       , -0.0601904, -0.26868760,
     5  0.0       , -0.0499827, -0.02667936,
     6  0.0       ,  0.0      , -0.04970387,
     7  0.0       ,  0.0      , -0.03378987/
C
      IF(IK2.EQ.0) RETURN
      IF(ITG.NE.'  ') GO TO 100
      WRITE(6,1)
    1 FORMAT(1H$,'TARGET-CU,CR,FE,CO,MO,NI,AG > ')
      READ(5,2,END=9999) ITG
    2 FORMAT(A2)
  100 IF(ITG.NE.JCU)GO TO 21
   20 ITG=JCU
      XKA1=ICU(1)
      XKA2=ICU(2)
      XKA=ICU(3)
      GO TO 27
   21 IF(ITG.NE.JCR)GO TO 22
      XKA1=ICR(1)
      XKA2=ICR(2)
      XKA=ICR(3)
      GO TO 27
   22 IF(ITG.NE.JFE)GO TO 23
      XKA1=IFE(1)
      XKA2=IFE(2)
      XKA=IFE(3)
      GO TO 27
   23 IF(ITG.NE.JCO)GO TO 24
      XKA1=ICO(1)
      XKA2=ICO(2)
      XKA=ICO(3)
      GO TO 27
   24 IF(ITG.NE.JMO)GO TO 25
      XKA1=IMO(1)
      XKA2=IMO(2)
      XKA=IMO(3)
      GO TO 27
   25 IF(ITG.NE.JNI)GO TO 26
      XKA1=INI(1)
      XKA2=INI(2)
      XKA=INI(3)
      GO TO 27
   26 IF(ITG.NE.JAG)GO TO 20
      XKA1=IAG(1)
      XKA2=IAG(2)
      XKA=IAG(3)
   27 IF(ITG.NE.JCU)GO TO 12
      IF(IK2.EQ.2)GO TO 4
   12 WRITE(7,3) ITG,XKA1,XKA2,XKA,(JRA(I),I=1,5)
    3 FORMAT(/1X,'TARGET',6X,'KA1',8X,'KA2',8X,'KA',6X,'ALGORITHM'/3X,
     XA2,2X,3F11.6,3X,5A2/)
      DL=(XKA2-XKA1)/XKA
      CON=0.01745329
      I1=ABS(114.59156*TAN(.5*CON*SS)*DL/DX)+1
      DO 10 I=I1,N
      T2=(SS+(I-1)*DX)/2.
      DT=57.29578*TAN(CON*T2)*DL
      XJ2=FLOAT(I)-2.*DT/DX
      J2=XJ2
      IF(J2.LT.1) GO TO 10
      J1=J2+1
      BJ2=FLOAT(J2)
      READ(LU'J2,ERR=9999) B2
      READ(LU'J1,ERR=9999) BJ1
      J=I
      READ(LU'J,ERR=9999) B
      B=B - (B2 + ((XJ2 - BJ2)*(BJ1 - B2)))*0.5
      WRITE(LU'J) B
   10 CONTINUE
      RETURN
    4 WRITE(6,3) ITG,XKA1,XKA2,XKA,(JLA(I),I=1,5)
      WRITE(6,5)
    5 FORMAT(1H$,'HISTOGRAM BARS-3,5,7 > ')
      READ(5,6,END=9999) NUM1
    6 FORMAT(I1)
      IF(NUM1.EQ.3)GO TO 7
      IF(NUM1.EQ.5)GO TO 7
      IF(NUM1.EQ.7)GO TO 7
      NUM1=3
    7 NUM=(NUM1 + 2)/3
      TINC=DX
      DO 8 I=1,N
      J=I
      READ(LU'J,ERR=9999) BI
      IF(BI.LE.0.1)GO TO 8
      T1=SS + (I - 1)*TINC
      TEMP=2.0*SIN(T1*DTOR/2.0)
      DO 11 J=1,NUM1
      T2=TEMP*DELTA(NUM,J) + TEMP
      T2=2.0*ASIN(T2*0.5)*RTOD
      YTEMP=WEIGHT(NUM,J)*BI
      INDEX=INT((T2-T1)/TINC)
      I1=I + INDEX
      I2=I1 + 1
      TEMP1=T1 + INDEX*TINC
      TEMP2=TEMP1 + TINC
      IF(I1.GE.N)GO TO 9
      READ(LU'I1,ERR=9999) B
      B=ABS(B + (TEMP2 - T2)/TINC*YTEMP)
      WRITE(LU'I1) B
      READ(LU'I2,ERR=9999) B
      B=ABS(B + (T2 - TEMP1)/TINC*YTEMP)
      WRITE(LU'I2) B
   11 CONTINUE
    8 CONTINUE
    9 RETURN
 9999 CONTINUE
      TYPE *,'I1,N,J2,J1,J',I1,N,J2,J1,J
      TYPE *,'I=',I
      TYPE *,'DL,DT',DL,DT
      TYPE *,'I1,I2',I1,I2
      STOP
      END
