C   16/07/79 011140211  MEMBER NAME  LGBADC   (SOURCE)      FORTRAN
      SUBROUTINE LGBADC(HEXP,HRUN,*)
C
C  THIS SUBROUTINE GIVES THE LIST OF BAD ADC-CHANNELS, AND #CHANNELS
C  TO BE SUBTRACTED (KILL THAT ADC IF IT IS A BIG NO.)
C  CALLED FROM LGERSE  LAST MOD. 09:40  09-11-79
C     HEXP  :  INPUT EXPERIMENTAL #   IGNORE FROM NOW ON
C     HRUN  :  INPUT RUN#
C     HCAL  :  BUFFER FOR BAD CHANNELS.
C              ALSO USED AS THE OUTPUT OF THIS ROUTINEIN THE FORM OF
C              HCRT(4),HBADC,HBCHN,HADC(J,I)..
C              HCRT(I);SUB CONST FOR CRATE 1-3 AND FOR ALL CRATES(I=4)
C              HBADC=#BAD ADC MODULES, HBCHN=#BAD CHANNELS
C              HADC(J,I),J;1=CHN#,2=#CHANNELS TO BE SUBTRACTED.
C     CODED BY H.TAKEDA  7/5/79  09:05
C        LAST MODIFICATION  29/04/80  23:00 BY Y.WATANABE
C
      IMPLICIT INTEGER *2 (H)
#include "clgwork1.for"
#include "clgkalb.for"
      COMMON /CLGBCH/ HABAD(2,3),HBBAD(2,2,2)
      COMMON /CTEMPB/ HCHB(500)
C     HABAD(J,I); I; 1=ALL CRATES, 2=EACH CRATE, 3=EACH ADC
C                 J; 1=MIN.#CHANNELS FOR THE ACTION TO TAKE PLACE.
C                    2=MIN. FREQ. OF FIRING*10000...
C     HBBAD(K,J,I);I;1=BARREL 2=END CAP, J;1=SUB,2=KILL
C                   K=1;MIN. FREQ. OF FIRING*10000
C                   K=2;MIN. AV. PULSE HEIGHT.
C
C         THE DEFINITION OF BADCH WAS CHANGED BTW SUMMER AND FALL 79
C         SO REDEFINE HBBAD FOR THE SUMMER RUNS
      IF(HRUN.LE.0) RETURN1
      IF(HRUN.GT.1486) GO TO 1
C        DIFFERENT DEF. OF BADCH FILE.
      HBBAD(1,1,1)=500
      HBBAD(2,1,1)=10
      HBBAD(1,1,2)=1000
      HBBAD(2,1,2)=200
1     CONTINUE
      HBBAD(1,1,1)=100
      HBBAD(2,1,1)=3
      HBBAD(1,1,2)=100
      HBBAD(2,1,2)=3
C
      NP=NCAL(7)
      NLENG=NCAL(NP+1)
      NEV=NCAL(NP+2)
      IF(NEV.GT.500) GO TO 5
C       USE PREVIOUS RUN IF NO EVENTS FOR THIS RUN.
      WRITE(6,590) HEXP,HRUN
590   FORMAT(1X,'**EXP#, RUN # ',2I5,' TOO SHORT ***USE PREVIOUS RUN')
      RETURN
C
5     HBADC=0
      HBCHN=0
      HCHB(1)=0
      HCHB(2)=0
      HCHB(3)=0
      HCHB(4)=0
C       (INITIALIZATION)
      NPH=NP+NP+2
      HHEXP=HCAL(NPH+3)
      HHRUN=HCAL(NPH+4)
      KPH=2
C     IF(HHEXP.NE.HEXP) GO TO 90    NOT TEST ON EXP# 27/9/79
      IF(HHRUN.EQ.HRUN) GO TO 10
      WRITE(6,600) HEXP,HRUN,HHRUN
  600 FORMAT(1X,'**EXP#, RUN # ',2I5,' NOT FOUND ***USE RUN#',I5)
C
10    IFG=0
      NBAD=NLENG-10
      NBAD=NBAD/4
      KP=6
      IF(NBAD.LE.0)GO TO 80
      J2=NPH+10
C     WRITE(6,900) HEXP,HRUN
C900   FORMAT('0 BADCH FOR EXP AND RUN',2I5)
      J1=NPH+11
      J2=NPH+NLENG
C     WRITE(6,910) (HCAL(JP),JP=J1,J2)
C910   FORMAT(8(3I5,1X))
      IBE=1
      JP=NPH+7
      IF(HCAL(JP+4).LT.10000) GO TO 100
C
      DO 70 I=1,NBAD
      JP=JP+4
      HCH=HCAL(JP)
      HFR=HCAL(JP+1)
      HAV=HCAL(JP+2)
      HSG=HCAL(JP+3)
      HSG=HSG+HSG
      IF(HSG.LT.6) HSG=6
      IF(HSG.GT.60) HSG=60
C      (SAFETY FACTOR)
      IF(HCH.LT.20000) GO TO 20
C
C     CRATE INFORMATION;  0-3 FOR CRATE 1-3 AND ALL CRATES
      HCH=HCH-20000
      M=2
      IF(HCH.EQ.3) M=1
      HSUB=0
      IF(HFR.GE.HABAD(2,M)) HSUB=HAV+HSG
      HCHB(HCH+1)=HSUB
      GO TO 70
20    IF(HCH.LT.10000) GO TO 30
C
C     ADC INFORMATION
      IF(HFR.LT.HABAD(2,3)) GO TO 70
      HCH=HCH-10000
      HSUB=HAV+HSG
      HBADC=HBADC+1
      GO TO 60
C
C     CAHNNEL INFORMATION
30    IF(HCH.GE.2688) IBE=2
C
      IF(HFR.GT.HBBAD(1,2,IBE)) GO TO 50
      IF(HFR.LT.HBBAD(1,1,IBE)) GO TO 70
C     CATEGORY 1.  CHECK THE PULSE HEIGHT.
      IF(HAV.LT.HBBAD(2,1,IBE)) GO TO 70
      HSUB=HAV+HSG
      HBCHN=HBCHN+1
      GO TO 60
50    CONTINUE
C     CATEGORY 2;KILL IF HAV>1000
      HSUB=HAV+HSG
      IF(HAV.GT.HBBAD(2,2,IBE)) HSUB=9999
C     (KILL THAT CHANNEL)
      HBCHN=HBCHN+1
C     (PROBABLY THIS IS OK. I.E. HAV+HSG TAKES CARE MOST OF THEM.)
60    KP=KP+1
      HCHB(KP)=HCH
      KP=KP+1
      HCHB(KP)=HSUB
70    CONTINUE
C
80    IFG=1
90    CONTINUE
      HCHB(5)=HBADC
      HCHB(6)=HBCHN
C
C     WRITE(6,920) (HCHB(JP),JP=1,KP)
C920   FORMAT(10(2I6,1X))
      RETURN
C
C  ...THE OLD FORMAT IS STILL IN THE /CALIBR/. NO LIST IS DONE.
      DATA IERP/0/
100   IERP=IERP+1
      IF(IERP.LT.6) WRITE(6,670) HEXP,HRUN
670   FORMAT('0 ***** LGBADCH CONSTS STILL OLD. NO KILLING WILL BE '
     1 'DONE IN LGERSE( MESSAGE FROM LGBADC):EXP,RUN=',2I5)
      RETURN1
      END
