C   30/01/800003040507  MEMBER NAME  FAKAL2   (SOURCE)      FORTRAN
      SUBROUTINE FAKAL2(*)
C     PUT IN BAD CHANNEL INFO. INTO COMMON/CALIBR/
C     HEXP  :  INPUT EXPERIMENTAL #
C     HRUN  :  INPUT RUN#
C     HBUF  :  BUFFER FOR BAD CHANNELS. FOR THE OUTPUT OF THE PROG,
C              (J,I),J;1=ADC#,2=#CHANNELS TO BE SUBTRACTED.
C     CODED BY Y.WATANABE 19/9/79  09:05
C     LAST MODIFICATION  Y.WATANABE 30/1/80  09:05
      IMPLICIT INTEGER *2 (H)
#include "cdata.for"
#include "clgkalb.for"
      EQUIVALENCE (NEVNT,HBAD(1)),(HHEXP,HBAD(3)),(HHRUN,HBAD(4))
      EQUIVALENCE (HBUF(1),NCAL(3002))
      DIMENSION  HBBB(11526),HIN(4,2880),HBUF(1000),HBAD(1000)
      EQUIVALENCE (HIN(1,1),HBBB(7))
      EQUIVALENCE (HCAL(100),HBBB(1))
      DATA INIT/0/,HARUN/0/,HRAN/0/
C
C     PUT IN CALIBRATION DATA
      IF(INIT.GT.0) GO TO 30
C
C     PUT IN CALIBRATION CONSTS.
          IPHD = IBLN('HEAD')
      CALL SETSL(HCAL,0,20000,0)
      READ(20) LENG,(HBBB(I),I=1,LENG)
C     WRITE(6,890) LENG,(HBBB(I),I=1,20)
C890  FORMAT(21I6)
      HP=10
      NCAL(2)=HP
      HP=HP+HP+1
      DO 10 I=1,2880
      HCAL(HP)=HIN(2,I)
      HCAL(HP+1)=HIN(4,I)
      HP=HP+2
10    CONTINUE
C     WRITE(6,900) (HCAL(I),I=22,5782,2)
C900  FORMAT(20I6)
      INIT=1
      JNIT=0
C
30        NPHD = IDATA(IPHD)
          IF(NPHD.LE.0) RETURN1
          NHPHD = NPHD+NPHD
          HEXP=HDATA(NHPHD+ 9)
          HRUN=HDATA(NHPHD+10)
      IF(HRUN.LE.0) RETURN1
      IF(HRUN.EQ.HRAN) RETURN
C       IF EQ ALREADY INITIALIZED FOR THE RUN.
      HRAN=HRUN
      IFG=0
      NCAL(7)=3000
C
40    READ(21,END=60) LENG,(HBAD(I),I=1,LENG)
      IF(LENG.LE.10) GO TO 40
      IF(NEVNT.LT.500) GO TO 55
      IF(JNIT.LT.1) GO TO 45
      IF(HHRUN.GT.HRUN) GO TO 60
45    NCAL(3001)=LENG
      DO 50 I=1,LENG
50    HBUF(I)=HBAD(I)
      JNIT=1
55    IF(HHRUN.LT.HRUN) GO TO 40
C     WRITE(6,920) (HBAD(J),J=1,LENG)
      LENG=NCAL(3001)
C     WRITE(6,610) HRUN
C 610 FORMAT(1X,'$$$ RUN # ',I4,' FOUND$$$ GOOD GOOD ')
      HARUN=HHRUN
      REWIND 21
C     WRITE(6,920) (HBUF(J),J=1,LENG)
C920   FORMAT(10(2I6,1X))
C
      RETURN
C
60    REWIND 21
C     WRITE(6,600) HRUN,HARUN
C 600 FORMAT(1X,'*** RUN # ',I4,' NOT FOUND***  *USE',I4)
      RETURN
      END
