C   18/06/79 403191608  MEMBER NAME  SUBNEW   (S)           FORTRAN
      SUBROUTINE SUBNEW
C---  SUBTRACT ADC-PEDESTALS (CONSTANT & PHASE OR CONSTANT ONLY)
C---  & CREATE NEW VALUES FOR LNG, HPOINT, AND HGGADC
C---  (DEALS WITH 240 ADC-CHANNELS)
C
C     H.WRIEDT     12.06.79       14:00
C     LAST MODIFICATION     08.11.79      11:00
C
      IMPLICIT INTEGER*2 (H)
C
      COMMON /CPHASE/ LIMEVT,KCONST(192),LIMIT(192),LCHANN(192),
     &                LTHRES(192),LDEAD(192),LSUB(240)
      LOGICAL LCHANN,LTHRES,LDEAD,LSUB
C
      COMMON /CADCPL/ HADCPL(102,240),HPBHIS(192),IPBPHD(192),
     &                IERR(3)
C
      COMMON /CWORK/ IWORK(42),LNG,HPOINT(4),HGGADC(2,240)
C
      COMMON /CSUBCP/ HSUBPD(240)

      DATA ICOUNT/0/
C
C---  BE CAREFUL! IF REFERENCE CHANNELS ARE HIT IN FIRST EVENT
C---  (THIS SHOULD NEVER OCCUR), THE PROGRAM WILL PROBABLY PRODUCE
C---  NONSENSE. UP TO NOW IT SEEMS UNNECESSARY TO CARE IN THE PROGRAM
C---  BUT YOU NEVER CAN TELL ...
C
C---  DETERMINE RELATIVE PHASE FOR EACH ADC-UNIT (48 CHANNELS EACH)
      WRITE(6,6709)
6709  FORMAT(/,/,/,'   SUBNEW CALLED ',/,/,/)
      ICOUNT = ICOUNT + 1
      IF (HGGADC(1,4).EQ.3) GOTO 1
      IF (IERR(1).LE.100) WRITE(6,600) HGGADC(2,4)
  600 FORMAT(' WRONG CHANNEL FOR SUBTRACTION AT -Z: ',I4)
      IERR(1) = IERR(1) + 1
      RETURN
    1 HSUBMI = HGGADC(2,4)
      IF (HSUBMI.GT.5 .AND. HSUBMI.LT.435) GOTO 21
      IF (HGGADC(1,40).EQ.39) GOTO 31
      IF (IERR(1).LE.100) WRITE(6,600) HGGADC(2,40)
      IERR(1) = IERR(1) + 1
      RETURN
   31 IF (HGGADC(2,40).GE.465) WRITE(6,611) HGGADC(2,4),HGGADC(2,40)
  611 FORMAT(' BOTH REFERENCE CHANNELS FOR -Z, 1.HALF, ARE HIT',
     &       2(2X,I6))
      HSUBMI = HGGADC(2,40) - HSUBPD(40)
   21 CONTINUE
C
      IF (HGGADC(1,93).EQ.92) GOTO 4
      IF (IERR(1).LE.100) WRITE(6,606) HGGADC(2,93)
  606 FORMAT(' WRONG CHANNEL FOR SUBTRACTION AT -Z, 2.HALF: ',I4)
      IERR(1) = IERR(1) + 1
      RETURN
    4 HSUBM2 = HGGADC(2,93)
      IF (HSUBM2.GT.5 .AND. HSUBM2.LT.450) GOTO 24
      IF (HGGADC(1,57).EQ.56) GOTO 34
      IF (IERR(1).LE.100) WRITE(6,606) HGGADC(2,57)
      IERR(1) = IERR(1) + 1
      RETURN
   34 IF (HGGADC(2,57).GE.495) WRITE(6,612) HGGADC(2,93),HGGADC(2,57)
  612 FORMAT(' BOTH REFERENCE CHANNELS FOR -Z, 2.HALF, ARE HIT',
     &       2(2X,I6))
      HSUBM2 = HGGADC(2,57) - HSUBPD(57)
   24 CONTINUE
C
      IF (HGGADC(1,100).EQ.99) GOTO 2
      IF (IERR(1).LE.100) WRITE(6,604) HGGADC(2,100)
  604 FORMAT(' WRONG CHANNEL FOR SUBTRACTION AT +Z: ',I4)
      IERR(1) = IERR(1) + 1
      RETURN
    2 HSUBPL = HGGADC(2,100)
      IF (HSUBPL.GT.5 .AND. HSUBPL.LT.345) GOTO 22
      IF (HGGADC(1,136).EQ.135) GOTO 32
      IF (IERR(1).LE.100) WRITE(6,604) HGGADC(2,136)
      IERR(1) = IERR(1) + 1
      RETURN
   32 IF (HGGADC(2,136).GE.345) WRITE(6,613) HGGADC(2,100),HGGADC(2,136)
  613 FORMAT(' BOTH REFERENCE CHANNELS FOR +Z, 1.HALF, ARE HIT',
     &       2(2X,I6))
      HSUBPL = HGGADC(2,136) - HSUBPD(136)
   22 CONTINUE
C
      IF (HGGADC(1,189).EQ.188) GOTO 8
      IF (IERR(1).LE.100) WRITE(6,607) HGGADC(2,189)
  607 FORMAT(' WRONG CHANNEL FOR SUBTRACTION AT +Z, 2.HALF: ',I4)
      IERR(1) = IERR(1) + 1
      RETURN
    8 HSUBP2 = HGGADC(2,189)
      IF (HSUBP2.GT.5 .AND. HSUBP2.LT.270) GOTO 28
      IF (HGGADC(1,153).EQ.152) GOTO 38
      IF (IERR(1).LE.100) WRITE(6,607) HGGADC(2,153)
      IERR(1) = IERR(1) + 1
      RETURN
   38 IF (HGGADC(2,153).GE.375) WRITE(6,614) HGGADC(2,189),HGGADC(2,153)
  614 FORMAT(' BOTH REFERENCE CHANNELS FOR +Z, 2.HALF, ARE HIT',
     &       2(2X,I6))
      HSUBP2 = HGGADC(2,153) - HSUBPD(153)
   28 CONTINUE
C
C*    IF (HGGADC(1,222).EQ.221) GOTO 3
C*    IF (IERR(1).LE.100) WRITE(6,605) HGGADC(2,222)
C*605 FORMAT(' WRONG CHANNEL FOR SUBTRACTION IN THE 5TH. ADC: ',I4)
C*    IERR(1) = IERR(1) + 1
C*    RETURN
C*  3 HSUBSM = HGGADC(2,222)
      NDAT = LNG - 2
        DO 100 I = 1,NDAT
        HADR = HGGADC(1,I)
        HRED = HGGADC(2,I)
        IF (HRED.EQ.0) GOTO 100
        IF (HADR.GT.191) GOTO 101
        IF (HADR.EQ.0.OR.HADR.EQ.47.OR.HADR.EQ.48.OR.HADR.EQ.95.OR.HADR
     &      .EQ.96.OR.HADR.EQ.143.OR.HADR.EQ.144.OR.HADR.EQ.191) GOTO 9900002700
C
C***    IF (HADR.GT.191) GOTO 9
C---    CHANNELS WITHOUT VARIING PEDESTAL
        IF (LCHANN(HADR)) GOTO 10
C
C---    SUBTRACT PEDESTAL PHASE
        IF (HADR.GT.48) GOTO 5
C---    RELATIVE TO CHANNEL #3
        HRED = HRED - HSUBMI
        GOTO 10
    5   IF (HADR.GT.96) GOTO 6
C---    RELATIVE TO CHANNEL #92
        HRED = HRED - HSUBM2
        GOTO 10
    6   IF (HADR.GT.144) GOTO 7
C---    RELATIVE TO CHANNEL #99
        HRED = HRED - HSUBPL
        GOTO 10
C---    RELATIVE TO CHANNEL #188
    7   HRED = HRED - HSUBP2
        GOTO 10
C---    RELATIVE TO CHANNEL #221
C***9   HRED = HRED - HSUBSM
C***    GOTO 20
C
C---    SUBTRACT PEDESTAL-CONSTANT (DIFFERENT FOR EACH CHANNEL)
   10   IF (LSUB(I)) GOTO 15
        IF (LCHANN(HADR).OR.KCONST(HADR).NE.0) GOTO 11
C***    IN NEXT STM. ON 10.8.79, 15:40, OLD VALUE OF 150 CHANGED TO 225
        IF (HRED.LT.225) GOTO 11
        WRITE(6,602) HGGADC(1,I), HRED
  602   FORMAT(' BLOCK NO. ',I4,' HIT IN SUBTRACTION-CONSTANT ',
     &         'DETERMINING EVENT, PULSE HEIGHT: ',I5,' CHANNELS')
        GOTO 20
C---    DETERMINE PEDESTAL-CONSTANT FOR EACH CHANNEL
   11   HSUBPD(I) = HRED
C---    IF PEDESTAL-CONSTANT IS DETERMINED IN THE ON-LINE PEDESTAL
C       DETERMINING (THE 12.TH) EVENT, INVERT SIGN
        IF (HGGADC(2,I).LT.0) HRED = -HRED
C---    CHANNELS WITH TOO LOW OR TOO HIGH SUBTRACTION CONSTANTS
        IF (KCONST(HADR)) 13,12,14
C
   12   LSUB(I) = .TRUE.
C       IF (ICOUNT.LT.3) WRITE(6,603) HGGADC(1,I),HSUBPD(I),ICOUNT
  603   FORMAT(' SUBTRACTION-CONSTANT FOR BLOCK NO. ',I3,' DETERMINED',
     &         ' TO ',I5,' IN EVENT NO. ',I3)
        GOTO 15
C---    SUBTRACTION CONSTANT TOO LOW
   13   IF (KCONST(HADR).EQ.-10) GOTO 12
        IF (HGGADC(2,I).GT.LIMIT(HADR).AND.HGGADC(2,I).LT.
     &      (LIMIT(HADR)+150)) GOTO 12
        WRITE(6,608) HGGADC(1,I),HGGADC(2,I),ICOUNT,LIMIT(HADR)
  608   FORMAT(' SUBTRACTION-CONSTANT FOR BLOCK NO. ',I3,' NOT YET',
     &         ' DETERMINED, CONTENT :',I5,' IN EVENT NO. ',I3,
     &         ' LOWER LIMIT :',I3)
        GOTO 15
C---    SUBTRACTION CONSTANT TOO HIGH
   14   IF (HGGADC(2,I).GT.(LIMIT(HADR)-150).AND.HGGADC(2,I).LT.
     &      LIMIT(HADR)) GOTO 12
        WRITE(6,609) HGGADC(1,I),HGGADC(2,I),ICOUNT,LIMIT(HADR)
  609   FORMAT(' SUBTRACTION-CONSTANT FOR BLOCK NO. ',I3,' NOT YET',
     &         ' DETERMINED, CONTENT :',I5,' IN EVENT NO. ',I3,
     &         ' UPPER LIMIT :',I3)
C---    CHANNELS WHICH HAVE TO BE SET TO 0
   15   IF (LDEAD(HADR)) GOTO 16
        HRED = HRED - HSUBPD(I)
        GOTO 20
C---    SET CHANNELS TO 0
   16   HRED = 0
C
C---  CHECK ADC-JITTER
   20   HGGADC(2,I) = HRED
        IN = HGGADC(2,I) + 50
        IF (LTHRES(HADR).AND.IN.LT.150) GOTO 99
        IF (KCONST(HADR).EQ.-10 .AND. IN.LT.250) GOTO 99
        IF (IN.GT.100) GOTO 100
        IF (IN.GT.0) GOTO 99
   90   IERR(2) = IERR(2) + 1
        IF (IERR(2).LE.100) WRITE(6,601) HGGADC(1,I), HGGADC(2,I)
  601   FORMAT(' ******* ADC-JITTER > 49     ADC-ADDRESS: ',I4,2X,
     &         'REDUCED CONTENT: ',I4)
C
C---    CUTOFF OF ADCS WITH LOW CONTENT
C       (THRESHOLD: 50 CHANNELS, SPECIAL ONES: 100 CHANNELS)
   99   HGGADC(2,I) = 0
        GOTO 100
C---    SCRATCH UNPHYSICAL ADC-ADDRESSES (I.E. ADDRESSES 208 - 215,
C---    >229) AND CONTENTS
  101   IF ((HADR.GE.208.AND.HADR.LE.215).OR.(HADR.GE.230))
     &   HGGADC(2,I) = 0
  100   CONTINUE
C
      CALL GGSRTH(0,NDAT)
      LNG = 2
        DO 200 I = 1,NDAT
        IF (HGGADC(2,I).LE.0) GOTO 201
  200   LNG = I+2
  201 NDAT = LNG-2
      CALL GGSORT
C
C---  SET UP NEW POINTERS
      HPOINT(1) = 1
      HPOINT(2) = 1
      HPOINT(3) = 1
      IF (NDAT.LE.0) GOTO 211
        DO 210 I = 1,NDAT
        HADDR = HGGADC(1,I)
        IF (HADDR.LE.95) HPOINT(2) = 2*I+1
        IF (HADDR.LE.191) HPOINT(3) = 2*I+1
  210   CONTINUE
  211 HPOINT(4) = 2*NDAT+1
      RETURN
      END
