C   05/11/79 507111857  MEMBER NAME  EVCONV   (JADESR)      FORTRAN
      SUBROUTINE EVCONV(IREPLY)
C---
C---     COPIED FROM 'F11PST.JADESR(EVCONV7)' 13.30 21.05.79.
C---     NEW DRIFT TIME CHECK 6 NOV. 1979.
C---     INTRODUCE ZETCH  REFORMATING
C---     BK20  NOW BPCH                          31/07/84
C---     BK17  NOW FAMP                          08/10/84
C---     BK21  NOW VPAR                          11/07/85
C
C  PRINT WARNING, THIS VERSION IS HEAVILY OUTDATED !!
C
C
      IMPLICIT INTEGER*2 (H)
      LOGICAL TBIT
C
      COMMON /CWORK/ NWORK,HWORK(20000)
C  %MACRO CDATA
C----------------------------------------------------------------------
C             MACRO CDATA .... BOS COMMON.
C
C
C----------------------------------------------------------------------
C
      COMMON /BCS/ IDATA(33000)
      DIMENSION HDATA(10),IPNT(50),ADATA(1)
      EQUIVALENCE (HDATA(1),IDATA(1),ADATA(1)),(IPNT(1),IDATA(55))
      EQUIVALENCE (NWORD,IPNT(50))
C
C------------------------ END OF MACRO CDATA --------------------------
#include "cgraph.for"
      COMMON/CLHOST/NREADE,NFORME,IENT,ISRAW,ISREF,IHRAW(500),IHREF(500)
     1,IHBANK(128),ISPINW(1540)
C
      DIMENSION NAME(128),HCAMWD(2),MARKTR(3),IPTRIG(3),HSAVE(1000)
      DIMENSION JN32(128)
      DIMENSION HPCELL(98)
      DIMENSION IPRNG(3)
      EQUIVALENCE(ICAMWD,HCAMWD(1))
C
      DATA NAME/'HEAD','LATC','TRIG','TRIG','TRIG','ATST','ATBP','ATOF',
     1          'ALGL','ATAG','TAGC','JETC','MUEV','SCAL','MPRS','N50S',
     1          'FAMP','ZTRG','ZETC','BPCH','VPAR','BK22','BK23','BK24',
     1          'BK25','BK26','BK27','BK28','BK29','BK30','BK31','BK32',
     1          'JETV','FADC','BK35','BK36','BK37','BK38','BK39','BK40',
     1          'BK41','BK42','BK43','BK44','BK45','BK46','BK47','BK48',
     1          'BK49','BK50','BK51','BK52','BK53','BK54','BK55','BK56',
     1          'BK57','BK58','BK59','BK60','BK61','BK62','BK63','BK64',
     1          'C065','C066','C067','C068','C069','C070','C071','C072',
     1          'C073','C074','C075','C076','C077','C078','C079','C080',
     1          'C081','C082','C083','C084','C085','C086','C087','C088',
     1          'C089','C090','C091','C092','C093','C094','C095','C096',
     1          'C097','C098','C099','C100','C101','C102','C103','C104',
     1          'C105','C106','C107','C108','C109','C110','C111','C112',
     1          'C113','C114','C115','C116','C117','C118','C119','C120',
     1          'C121','C122','C123','C124','C125','C126','C127','C128'/
      DATA JN32/'HEAD','LATC','TRG1','TRG2','TRG3','ATST','ATBP','ATOF',
     1          'ALGL','ATAG','TAGC','JETC','MUEV','SCAL','MPRS','N50S',
     1          'FAMP','ZTRG','ZETC','BPCH','VPAR','BK22','BK23','BK24',
     1          'BK25','BK26','BK27','BK28','BK29','BK30','BK31','BK32',
     1          'JETV','FADC','BK35','BK36','BK37','BK38','BK39','BK40',
     1          'BK41','BK42','BK43','BK44','BK45','BK46','BK47','BK48',
     1          'BK49','BK50','BK51','BK52','BK53','BK54','BK55','BK56',
     1          'BK57','BK58','BK59','BK60','BK61','BK62','BK63','BK64',
     1          'C065','C066','C067','C068','C069','C070','C071','C072',
     1          'C073','C074','C075','C076','C077','C078','C079','C080',
     1          'C081','C082','C083','C084','C085','C086','C087','C088',
     1          'C089','C090','C091','C092','C093','C094','C095','C096',
     1          'C097','C098','C099','C100','C101','C102','C103','C104',
     1          'C105','C106','C107','C108','C109','C110','C111','C112',
     1          'C113','C114','C115','C116','C117','C118','C119','C120',
     1          'C121','C122','C123','C124','C125','C126','C127','C128'/
      DATA ICALL/0/,I19/0/
C---
C---     CONVERTS CAMAC TO MONTE CARLO FORMAT AT NORD FOR THE DISPLAY.
C---     FRIDAY, FEBRUARY 23, 1979. L.H. O'NEILL.
C---
      ICALL=ICALL+1
      IF(ICALL.EQ.1) WRITE(6,581)
581   FORMAT(' *************   WARNING !!!!!!  **********')
      IF(ICALL.EQ.1) WRITE(6,582)
582   FORMAT('  HEAVILY OUTDATED VERSION OF EVCONV, CONTACT J.OLSSON')
      IF(ICALL.EQ.1) WRITE(6,581)
      IREPLY=0
      IERRCD = 0
C---
C---     CLEAR MARKERS TELLING WHICH OF THE THREE "TRIG" BANKS ARE
C---     PRESENT.
C---
      MARKTR(1)=0
      MARKTR(2)=0
      MARKTR(3)=0
C
   50 CONTINUE
      LOOK=0
      LEVB=0
      LENGH=0
      LENEVB=0
      IRING = 3
      MAXJET = 108
C
   21 CONTINUE
      IF(LENEVB.LT.8) GOTO 100
      LENEVH=LENEVB/2
      LENEVN=LENEVH*2
      IF(LENEVB.NE.LENEVN) LENEVB=LENEVB+1
C---
C---     SET BOS LENGTH PARAMETER.
C---
      HDATA(LEVB+7)=0
      HDATA(LEVB+8)=(LENEVB-8)/2
C---
C---     SET FIXED POINTER.
C---
      IF(IFPNT.NE.0) HDATA(IFPNT*2+108)=(LEVB+8)/2
      IF(IFPNT.NE.0) HDATA(IFPNT*2+108)=(LEVB+8)/2
      LEVB=LEVB+LENEVB
  100 CONTINUE
      LOOK=LOOK+LENGH
      IF(LOOK.EQ.NWORK*2) GOTO 500
      IF(LOOK.GE.NWORK*2) GOTO 5001
      HCAMWD(1)=HWORK(LOOK+1)
      HCAMWD(2)=HWORK(LOOK+2)
      ICHECK=ICAMWD
      DO 1776 INAME=1,128
      IBANK=INAME
      IF(ICHECK.EQ.JN32(INAME)) GOTO 22
 1776 CONTINUE
      GOTO 5002
   22 CONTINUE
C     IBANK=HWORK(LOOK+2)
C     IF(IBANK.GE.1 .AND. IBANK.LE.16) GOTO 23
C     WRITE(JUSCRN,9053) IBANK,LOOK
C9053 FORMAT(' OUT OF RANGE BANK NUMBER',I10,' AT LOOK=',I10)
C     GOTO 501
C  23 CONTINUE
      IHBANK(IBANK)=IHBANK(IBANK)+1
      LENGH=HWORK(LOOK+8)*2+8
      IF(LENGH.LT.11 .OR. LENGH.GT.20000) GOTO 5003
   24 CONTINUE
      IF(LOOK+LENGH.GT.20000 .OR. LEVB+LENGH.GT.20000) GOTO 5004
C---
C---     MAKE BOS HEADER.
C---
   25 CONTINUE
      ICAMWD=NAME(IBANK)
      HDATA(LEVB+1)=HCAMWD(1)
      HDATA(LEVB+2)=HCAMWD(2)
      HDATA(LEVB+3)=HWORK(LOOK+3)
      HDATA(LEVB+4)=HWORK(LOOK+4)
      HDATA(LEVB+5)=HWORK(LOOK+5)
      HDATA(LEVB+6)=HWORK(LOOK+6)
C---
C---     COPY BANK DESCRIPTOR WORD.
C---
      HDATA(LEVB+ 9)=HWORK(LOOK+ 9)
      HDATA(LEVB+10)=HWORK(LOOK+10)
C
      LENEVB=0
      IF(IBANK.GT.19) GO TO 17
      GOTO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,17,19),IBANK
C---
C---     HEAD
C---
    1 CONTINUE
      IF(LEVB.NE.0) GOTO 5010
      LNORHD=4*(HWORK(LOOK+8)-1)
      IYEAR=HWORK(LOOK+16)
      CALL MVC  (HDATA(11),0,HWORK(LOOK+11),0,LNORHD)
      ICLADD=8+2*HWORK(LOOK+8)+1
      LCLADD=2*(209-ICLADD)
      CALL SETSL(HDATA(ICLADD),0,LCLADD,0)
      LENEVB=208
      IFPNT=0
      GOTO 21
C---
C---     LATC
C---
    2 CONTINUE
      IFPNT=3
         LENEVB=LENGH
         LENCOP=LENGH*2 - 16
         CALL MVCL(HDATA(LEVB+9),0,HWORK(LOOK+9),0,LENCOP)
      GOTO 21
C---
C---     TRIG 1
C---
    3 CONTINUE
      IFPNT=1
      MARKTR(1)=1
      IPTRIG(1)=(LEVB+8)/2
      HDATA(LEVB+4)=1
         LENEVB=LENGH
         LENCOP=LENGH*2 - 16
         CALL MVCL(HDATA(LEVB+9),0,HWORK(LOOK+9),0,LENCOP)
      GOTO 21
C---
C---     TRIG 2
C---
    4 CONTINUE
      IFPNT=0
      IF(MARKTR(1).EQ.0) IFPNT=1
      MARKTR(2)=1
      IPTRIG(2)=(LEVB+8)/2
      HDATA(LEVB+4)=2
         LENEVB = LENGH
         LENCOP=LENGH*2 - 16
         CALL MVCL(HDATA(LEVB+9),0,HWORK(LOOK+9),0,LENCOP)
      GOTO 21
C---
C---     TRIG 3
C---
    5 CONTINUE
      IFPNT=0
      IF(MARKTR(1).EQ.0 .AND. MARKTR(2).EQ.0) IFPNT=1
      MARKTR(3)=1
      IPTRIG(3)=(LEVB+8)/2
      HDATA(LEVB+4)=3
         LENEVB=LENGH
         LENCOP=LENGH*2 - 16
         CALL MVCL(HDATA(LEVB+9),0,HWORK(LOOK+9),0,LENCOP)
      GOTO 21
C---
C---     ATST
C---
    6 CONTINUE
      IFPNT=4
         LENEVB=LENGH
         LENCOP=LENGH*2 - 16
         CALL MVCL(HDATA(LEVB+9),0,HWORK(LOOK+9),0,LENCOP)
      GOTO 21
C---
C---     ATBP
C---
    7 CONTINUE
      IFPNT=10
         LENEVB=LENGH
         LENCOP=LENGH*2 - 16
         CALL MVCL(HDATA(LEVB+9),0,HWORK(LOOK+9),0,LENCOP)
      GOTO 21
C---
C---     ATOF
C---
    8 CONTINUE
      IFPNT=5
         LENEVB=LENGH
         LENCOP=LENGH*2 - 16
         CALL MVCL(HDATA(LEVB+9),0,HWORK(LOOK+9),0,LENCOP)
      GOTO 21
C---
C---     ALGL
C---
    9 CONTINUE
      DATA MSKAD1,MSKAD2 /ZFFFF,Z7FFF/
      IFPNT = 6
      IADR1 = 2688
      IADR2 = 2784
C                                        FROM HERE ON SAME PROCEDURE
C                                        FOR ALGL + ATAG
   55 CONTINUE
      IF(LENGH.LE.11) GOTO 5061
C---
C---     HOW LONG CAN "ALGL" BECOME WHEN REFORMATTED IN THE WORST CASE?
C---     THE BOS HEADER, THE BANK DESCRIPTOR, THE FIRST ADDRESS AND
C---     THE FIRST PULSE HEIGHT ( 12 I*2 WORDS ) OCCUPY THE SAME SPACE
C---     IN THE ORIGINAL AND REFORMATTED EVENTS. THE REST OF THE INFOR-
C---     ATION DOUBLES IN LENGTH IN THE WORST CASE WHEN ONLY A STRING
C---     OF BLOCKS WITH CONSECUTIVE ADDRESSES IS PRESENT. IN ADDITION
C---     THE REFORMATTED BANK HAS 4 I*2 INTERNAL POINTERS.
C---
      MAXALG=LENGH*2-8
      IF(LEVB+MAXALG.GT.20000) GOTO 5062
C
C                                                 INITIALIZE POINTERS
      IPWRK  = LOOK + 10
      IPWRK9 = LOOK + LENGH
      IPHDT0 = LEVB + 14
      IPHDT  = IPHDT0
      IPLG0  = IPHDT0
      IPLG1  = IPHDT0
      IPLG2  = IPHDT0
      IADD  = -1
      HCAMWD(1)=0
C                                                 TEST 1.WORD=ADDRESS
      HZWNXT = HWORK(IPWRK+1)
      HCAMWD(2)=HZWNXT
      IF(SHFTR(ICAMWD,14).NE.2) GOTO 5063
C                                                 LOOP OVER ALL ADC'S
   30 CONTINUE
      IPWRK = IPWRK + 1
      IF(IPWRK.GT.IPWRK9) GOTO 33
C
      ICAMWD = LAND(HWORK(IPWRK),MSKAD1)
C                                                 CHECK IF ADDRESS
      IF(SHFTR(ICAMWD,14).NE.2) GOTO 32
C                                                 CALCULATE ADDRESS
      IADD1 = LAND(ICAMWD,MSKAD2)
      IF(SHFTR(IADD1,10) - 1) 34,35,36
   35 IADD1 = IADD1 - 64
      GOTO 34
   36 IADD1 = IADD1 - 128
      IF(IADD1.GT.2879) GOTO 5065
   34 CONTINUE
      IF(IADD1.LT.IADD) GOTO 5068
      IADD = IADD1
      GOTO 30
C                                                 STORE ADC
   32 CONTINUE
      IPHDT=IPHDT+2
      HDATA(IPHDT  ) = ICAMWD
      HDATA(IPHDT-1) = IADD
      IADD = IADD + 1
      IF(IADD.GT.IADR2) GOTO 30
      IF(IADD.GT.IADR1) GOTO 37
      IPLG1 = IPHDT
   37 IPLG2 = IPHDT
      GOTO 30
C
   33 CONTINUE
C
      IF(HCAMWD(2).EQ.0) IPHDT = IPHDT - 2
      IF(IPLG1.GT.IPHDT) IPLG1 = IPHDT
      IF(IPLG2.GT.IPHDT) IPLG2 = IPHDT
      HDATA(IPHDT0-3) = 1
      HDATA(IPHDT0-2) = IPLG1 - IPHDT0 + 1
      HDATA(IPHDT0-1) = IPLG2 - IPHDT0 + 1
      HDATA(IPHDT0  ) = IPHDT - IPHDT0 + 1
C
      LENEVB = IPHDT - LEVB
      GOTO 21
C---
C---     ATAG
C---
C---                                    SAME PROCEDURE AS FOR ALGL
C---
   10 CONTINUE
      IFPNT = 11
      IADR1 =  96
      IADR2 = 192
      IF(IYEAR.LE.1980) GO TO 55
      IADR1 =  32
      IADR2 =  64
      GOTO 55
C---
C---
C---     TAGC
C---
   11 CONTINUE
      IFPNT=12
         LENEVB=LENGH
         LENCOP=LENGH*2 - 16
         CALL MVCL(HDATA(LEVB+9),0,HWORK(LOOK+9),0,LENCOP)
      GOTO 21
C---
C---     JETC.
C---
   12 CONTINUE
C
C                                       KEEP POINTER TO RING-BANKS
      IF(LENGH.LT.15) GOTO 5071
      MAXHIT = ((LENGH-10)*16)/13+4
      MAXJET = MAXJET + MAXHIT
      IF(MAXJET.GT.20000) GOTO 5072
      IPRNG(IRING) = LOOK + 8
      IRING = IRING - 1
      LENEVB=0
      GOTO 21
C
C
C---
C---     MUEV
C---
   13 CONTINUE
      IFPNT=9
         LENEVB=LENGH
         LENCOP=LENGH*2 - 16
         CALL MVCL(HDATA(LEVB+9),0,HWORK(LOOK+9),0,LENCOP)
      GOTO 21
C---
C---     SCAL
C---
   14 CONTINUE
      IFPNT=2
         LENEVB=LENGH
         LENCOP=LENGH*2 - 16
         CALL MVCL(HDATA(LEVB+9),0,HWORK(LOOK+9),0,LENCOP)
      GOTO 21
C---
C---     MPRS
C---
   15 CONTINUE
      IFPNT=13
         LENEVB=LENGH
         LENCOP=LENGH*2 - 16
         CALL MVCL(HDATA(LEVB+9),0,HWORK(LOOK+9),0,LENCOP)
      GOTO 21
C---
C---     N50S
C---
   16 CONTINUE
      IFPNT=14
         LENEVB=LENGH
         LENCOP=LENGH*2 - 16
         CALL MVCL(HDATA(LEVB+9),0,HWORK(LOOK+9),0,LENCOP)
      GOTO 21
C---
C---     SPECIAL RUN STATUS BANKS
C---
   17 CONTINUE
      IFPNT=0
         LENEVB=LENGH
         LENCOP=LENGH*2 - 16
         CALL MVCL(HDATA(LEVB+9),0,HWORK(LOOK+9),0,LENCOP)
      GOTO 21
C---
C---     Z-CHAMBER BANK ZETC
C---
   19 CONTINUE
      I19    = I19 + 1
      LOOK2  = LOOK+LENGH
      IF(I19.LE.10)      WRITE(JUSCRN,4919) (HWORK(LLL),LLL=LOOK,LOOK2)
 4919 FORMAT(' UNREFORMATTED ZETC ',/(20I6))
      KEXTRA = 0
      IADR0  = -1
      IPHDT0 = LEVB + 10
      IPHDT  = IPHDT0
      IZAMIN = 0
      IZAMAX = 63
      IPWRK  = LOOK + 11
      IPWRK9 = LOOK + LENGH - 3
C                                           LOOP OVER ADCS
 4000 CONTINUE
      IF(IPWRK.GT.IPWRK9)                   GOTO 4100
      NHIT = HWORK(IPWRK)
      IF(NHIT.NE.16384)                     GOTO 4010
C                                           BENCH MARK
C ----------------------------------------- AT PRESENT NOT USED,
C                                           JUST SKIPPED.
         IPWRK  = IPWRK + 1
         NHIT   = HWORK(IPWRK)
C                                           CHECK HIT NUMBER
 4010 CONTINUE
      IF(NHIT.LE.0 .OR. NHIT.GT.127)        GOTO 4501
      IF(NHIT.LE.8)                         GOTO 4020
C ----------------------------------------- FOLLOWING CODE FOR LIST OF
C                                           OVERFLOW WIRES
C                                           -- NOT USED AT PRESENT --
C        IF(KEXTRA.GT.998)                  GOTO 4030
C           HSAVE(KEXTRA+1) = IADR
C           HSAVE(KEXTRA+2) = NHIT
C           KEXTRA          = KEXTRA+2
C -----------------------------------------
 4030    NHIT = 8
 4020 CONTINUE
C                                           CHECK WIRE ADDRESS
      IADR = HWORK(IPWRK+1)
      IF(IADR.LT.0 .OR. IADR.GT.IZAMAX)     GOTO 4502
      IF(IADR.LE.IADR0)                     GOTO 4503
         IADR0 = IADR
         IWIR  = IADR*8 + NHIT
         IPWRK = IPWRK+2
C                                           LOOP OVER HITS
 4040 CONTINUE
         IWIR = IWIR - 1
         HDATA(IPHDT+1) = IWIR
C                                           NOTE A1 AND A2 EXCHANGED
C                                           BETWEEN RAW & REFORMATTED
C                                           BANKS
         HDATA(IPHDT+3) = HWORK(IPWRK)
         HDATA(IPHDT+2) = HWORK(IPWRK+1)
         IF(HWORK(IPWRK+2) .GT. 255)        GOTO 4504
         HDATA(IPHDT+4) = HWORK(IPWRK+2)
         IPWRK = IPWRK + 3
         IPHDT = IPHDT + 4
         NHIT  = NHIT - 1
         IF(NHIT.NE.0)                      GOTO 4040
      GOTO 4000
 4100 CONTINUE
C ----------------------------------------- FOLLOWING CODE FOR LIST OF
C                                           OVERFLOW WIRES
C                                           -- NOT USED AT PRESENT --
C     IF(KEXTRA.LT.2)                       GOTO 4060
C     IF(IPHDT+KEXTRA .GT. 20000)           GOTO 4505
C     DO 4050 I=1,KEXTRA
C             IPHDT = IPHDT+1
C             HDATA(IPHDT) = HSAVE(I)
C4050 CONTINUE
C -----------------------------------------
C                                           UPDATE LENGTH
 4060 CONTINUE
      LENEVB = IPHDT - LEVB
      GOTO 21
C ---
C --- Z-CHAMBER --- ERRORS ---
C ---
C                                           ILLEGAL NHITS
 4501 WRITE(JUSCRN,4511) NHITS
 4511 FORMAT(/' ---- ZETC --- ILLEGAL NHITS = ',I6)
      GOTO 501
C                                           ILLEGAL WIRE ADDRESS
 4502 WRITE(JUSCRN,4512) IADR
 4512 FORMAT(/' ---- ZETC --- ILLEGAL WIRE ADDRESS = ',I6)
      GOTO 501
C                                           NON-INCREASING WIRE NO
 4503 WRITE(JUSCRN,4513) IADR,IADR0
 4513 FORMAT(/' ---- ZETC --- NON-INCREASING WIRE NO = ',I6,
     *        ' (LAST WAS ',I6,')')
      GOTO 501
C                                           ILLEGAL DRIFT TIME
 4504 WRITE(JUSCRN,4514) HWORK(IPWRK+2)
 4514 FORMAT(/' ---- ZETC --- ILLEGAL DRIFT TIME = ',I6)
      GOTO 501
C                                           BANK GETTING TOO LONG
C                                           -- NOT USED AT PRESENT --
C4505 WRITE(JUSCRN,4515)
C4515 FORMAT(/' ---- ZETC --- BANK TOO LONG W. LIST OF OVERFLOW WIRES')
C     GOTO 4060
C
  501 CONTINUE
      IREPLY=-1
      DATA NFAIL /0/
      NFAIL = NFAIL + 1
      IF(NFAIL.LE.1) WRITE(JUSCRN,9050)
 9050 FORMAT(' FAILED TO CONVERT')
C---
C---     SET TOTAL LENGTH.
C---
  500 CONTINUE
      HDATA(208)=LEVB/2
C---
C---     SET INTERNAL POINTERS FOR BANKS WITH THE SAME NAME.
C---
      DO 47 I=1,2
      IF(MARKTR(I).NE.1) GOTO 47
      IP1=IPTRIG(I)
      K=I+1
      DO 48 J=K,3
      IF(MARKTR(J).NE.1) GOTO 48
      IP2=IPTRIG(J)
      HDATA(IP1*2-2)=IP2
      GOTO 47
   48 CONTINUE
   47 CONTINUE
C
C                                       CHECK IF JETC DATA
      IF(IRING.EQ.3) GOTO 600
C---
C---     JETC.
C---
C---
C---     HOW LONG CAN THE REFORMATTED "JETC" BECOME IN THE WORST CASE,
C---     DISCOUNTING THE TRAILING LIST OF WIRES WITH MORE THAN EIGHT
C---     HITS? THE REFORMATTED BANK OCCUPIES 8 (BOS HEADER) + 2 (BANK
C---     DESCRIPTOR) + 98 (INTERNAL POINTERS) + 4*N INTEGER*2 WORDS,
C---     WHERE "N" IS THE TOTAL NUMBER OF HITS ON ALL WIRES, NOT COUNT-
C---     BEYOND THE 8TH HIT ON EACH WIRE. THIS IS 108 + 4*N I*2 WORDS.
C---     THE UNREFORMATTED BANK HAS 8 (BOS HEADER) + 2 (BANK DESCRIPTOR)
C---     I*2 WORDS PLUS THE HIT DATA. THE LARGEST POSSIBLE RATIO OF
C---     HITS TO UNREFORMATTED DATA LENGTH OCCURS IN THE CASE THAT THERE
C---     ARE EXACTLY 8 HITS PER WIRE, IN WHICH CASE THERE ARE 8 HITS
C---     PER 1 (NUMBER OF HITS) + 1 (WIRE NUMBER) + 3*8 = 26 DATA WORDS.
C---
C                                                 INITIALIZE POINTERS
      KEXTRA = 0
      ICELL0 = 0
      IADR0  =-1
      IPHDT0 = LEVB +  108
      IPHDT  = IPHDT0
C                                 GET RING POINTER
  120 CONTINUE
      IRING = IRING + 1
      IF(IRING.GT.3) GOTO 44
      LOOK = IPRNG(IRING)
      JRING=4-HWORK(LOOK-4)
      IRAMIN=384*(JRING-1)
      IRAMAX=IRAMIN+383
      IF(JRING.EQ.3) IRAMAX=1535
C---
C---     INITIALIZE LAST HIT COUNTER ADDRESS FOLLOWED BY REFORMATABLE
C---     DATA.
C---
      IPWR00=0
C
C                                                 INITIALIZE POINTERS
      IPWRK  = LOOK + 3
C---
C---     SUBTRACT 3 FROM IPWRK9 BELOW. WHEN IPWRK REACHES IPWRK9 NO
C---     FURTHER COMPLETE HIT IS POSSIBLE. THIS REDUCTION OF IPWRK9
C---     WILL AVOID SPURIOUS REFORMATTING ERRORS WHICH OCCUR WHEN
C---     "JETMRG" DELETES A -1 FROM THE MIDDLE OF A JETC BANK WHICH
C---     ALREADY HAS A TRAILING ZERO. THIS RESULTS IN TWO TRAILING
C---     ZEROES AT THE END OF THE UNREFORMATTED BANK AND A SPURIOUS
C---     ILLEGAL NHIT OF 0.
C---
C---                                   L.H. 0'NEILL
C---                                   05.08.79
C---
      IPWRK9 = HWORK(LOOK)*2 + LOOK - 3
      IPWBEN = IPWRK
   40 CONTINUE
      IF(IPWRK.GE.IPWRK9) GOTO 120
C                                                 LOOP OVER ALL ADC'S
  240 NHIT = HWORK(IPWRK)
C                                                 CHECK FOR BENCH MARK
      IF(NHIT.NE.16384) GOTO 140
         IPWBEN = IPWRK
C---
C---     SET LOWEST ADDRESS IN THE REFORMATTED DATA ARRAY TO WHICH
C---     ERROR RECOVERY MAY SEARCH BACKWARD LOOKING FOR THE PREVIOUS
C---     WIRE NUMBER. INITIALIZE DEAD LOOP PROTECTION COUNTER FOR
C---     THE REGION STARTING WITH THIS BENCH MARK.
C---
      IPHDTR=IPHDT
      KSPERC=0
         IPWRK = IPWRK + 1
         NHIT = HWORK(IPWRK)
C---
C---     COMPUTE MAXIMUM ALLOWED WIRE ADDRESS UNTIL THE NEXT BENCHMARK.
C---
         IABM1=HWORK(IPWRK+1)
         IADMAX=IRAMAX
         IF((IABM1.LE.IADR0).OR.(IABM1.GT.IRAMAX)) GO TO 140
         IRBMIN=IRAMIN
         IF(IABM1.GE.1152) IRBMIN=1152
         IBENCH=1+(IABM1-IRBMIN)/56
         IADMAX=56*IBENCH-1+IRBMIN
  140 IADR = HWORK(IPWRK+1)
      IF(NHIT.LE.0 .OR. NHIT.GT.127) GOTO 5073
      IF(NHIT.LE.8) GOTO 39
         IF(KEXTRA.GT.998) GOTO 38
         HSAVE(KEXTRA+1)=IADR
         HSAVE(KEXTRA+2)=NHIT
         KEXTRA=KEXTRA+2
   38    NHIT = 8
   39 CONTINUE
      IF(IADR.LT.0 .OR. IADR.GT.IADMAX) GOTO 5074
      IF(IADR.LE.IADR0) GOTO 5075
      IADR0 = IADR
      IWIR = IADR*8 + NHIT
      IPWRK = IPWRK + 2
      ICELL = SHFTR(IADR,4)+1
      IF(ICELL.EQ.ICELL0) GOTO 41
        ICELL0 = ICELL0 + 1
        IPDIF = IPHDT - IPHDT0 + 1
        DO 42 IC=ICELL0,ICELL
   42   HPCELL(IC) = IPDIF
        ICELL0 = ICELL
C
   41 CONTINUE
        IWIR = IWIR - 1
        HDATA(IPHDT+1) = IWIR
        HDATA(IPHDT+2) = HWORK(IPWRK  )
        HDATA(IPHDT+3) = HWORK(IPWRK+1)
        IF(HWORK(IPWRK+2).GT.255) GO TO 1946
        HDATA(IPHDT+4) = HWORK(IPWRK+2)
        IPWRK = IPWRK + 3
        IPHDT = IPHDT + 4
        NHIT = NHIT - 1
        IF(NHIT.NE.0) GOTO 41
        GOTO 40
C
   44   ICELL0 = ICELL0 + 1
        IPDIF = IPHDT - IPHDT0 + 1
        DO 43 IC=ICELL0,97
   43   HPCELL(IC) = IPDIF
C
      IF(KEXTRA.LT.2) GOTO 51
      IF(IPHDT+KEXTRA.GT.20000) GOTO 5076
      DO 49 I=1,KEXTRA
      IPHDT = IPHDT + 1
      HDATA(IPHDT) = HSAVE(I)
   49 CONTINUE
   51 HPCELL(98) = IPHDT - IPHDT0 + 1
C
      CALL MVCL(HDATA(IPHDT0-97),0,HPCELL(1),0,196)
C
      LENEVB = IPHDT - LEVB
      IF(LENEVB.LT.8) GOTO 600
C
C                                                SET BOS WORDS + POINTER
      IPNT( 7) = SHFTR(LEVB+8,1)
      NWORD = SHFTR(IPHDT+1,1)
      HDATA(LEVB+ 1) = HWORK(LOOK-7)
      HDATA(LEVB+ 2) = HWORK(LOOK-6)
      HDATA(LEVB+ 3) = 0
      HDATA(LEVB+ 4) = 0
      HDATA(LEVB+ 5) = 0
      HDATA(LEVB+ 6) = 0
      HDATA(LEVB+ 7) = 0
      HDATA(LEVB+ 8) = NWORD - IPNT(7)
      HDATA(LEVB+ 9) = HWORK(LOOK+1) + 100
      HDATA(LEVB+10) = IERRCD
C---
C---     ADD LIST OF WIRES WITH MORE THAN 8 HITS, AND NUMBERS OF HITS,
C---     TO THE END OF JETC BANK. INTERNAL POINTER 97 POINTS TO THE
C---     BEGINNING OF THIS LIST OF "HOT" WIRES AND INTERNAL POINTER
C---     98 POINTS TO THE LAST I*2 WORD OF THE BANK, PLUS ONE.
C---
  600 CONTINUE
C---  IF((IERRCD.NE.0).AND.(KERRCD.LT.20)) CALL LHODMP
      RETURN
C
C
C                                        *****************************
C                                        *       E R R O R S         *
C                                        *****************************
C
 5001 WRITE(JUSCRN,9051) NWORK,LOOK
 9051 FORMAT(' LENGTH ERROR:',2I10)
      GOTO 501
 5002 WRITE(JUSCRN,9052) ICHECK,LOOK
 9052 FORMAT(' BAD ICHECK',I10,' AT LOOK=',I10)
      GOTO 501
 5003 CONTINUE
      DATA NILLGH /0/
      NILLGH = NILLGH + 1
      IF(NILLGH.LE.1) WRITE(JUSCRN,9054) LENGH,LOOK
 9054 FORMAT(' ILLEGAL LENGTH',I10,' AT LOOK=',I10)
      GOTO 501
 5004 CONTINUE
      DATA NLONG /0/
      NLONG = NLONG + 1
      IF(NLONG.LE.1) WRITE(JUSCRN,9055) LENGH,LOOK,LEVB
 9055 FORMAT(' TOTAL EVENT GETTING TOO LONG. LENGH, LOOK, LEVB =',3I10)
      GOTO 501
C
 5010 WRITE(JUSCRN,9056) LOOK,LEVB,IBANK
 9056 FORMAT(' HEADER NOT FIRST BANK.',3I10)
      GOTO 501
C
 5061 WRITE(JUSCRN,9057) LOOK,LENGH
 9057 FORMAT(' ALGL/ATAG BANK HAS ILLEGAL LENGTH.',2I10)
      GOTO 501
 5062 CONTINUE
      DATA IEALG/0/
      IEALG=IEALG+1
      IF(IEALG.LE.1) WRITE(JUSCRN,9066) LOOK,LEVB,MAXALG
 9066 FORMAT(' REFORMATTED ALGL/ATAG MAY BECOME TOO LONG FOR IDATA:',
     ,         3I10)
      GOTO 501
 5063 WRITE(JUSCRN,9058) IPWRK,ICAMWD
 9058 FORMAT(' FIRST ADC WORD IS NOT AN ADDRESS.',2I10)
      GOTO 501
 5064 WRITE(JUSCRN,9001) IADD1,ICR
 9001 FORMAT(' ILLEGAL CRATE NUMBER',2I10)
      GOTO 501
 5065 ICR = SHFTR(IADD1,10)
      IF(ICR.GT.1) GOTO 5064
      WRITE(JUSCRN,9002) IADD1
 9002 FORMAT(' ILLEGAL CONVERTED ADC ADDRESS',I10)
      GOTO 501
 5067 WRITE(JUSCRN,9060) LOOK,I
 9060 FORMAT(' TWO ADC ADDRESSES IN A ROW.',2I10)
      GOTO 501
 5068 WRITE(JUSCRN,9061) IPWRK,IPHDT,IADD,IADD1
 9061 FORMAT(' NON-INCREASING ADC ADDRESS',4I10)
      GOTO 501
C
 5071 WRITE(JUSCRN,9062) IPWRK,LENGH
 9062 FORMAT(' ILLEGAL JETC LENGTH',2I10)
      IERRCD = LOR(IERRCD,2)
      GOTO 21
 5072 CONTINUE
      DATA IJETLN/0/
      IJETLN=IJETLN+1
      IF(IJETLN.LE.1) WRITE(JUSCRN,9067) IPWRK,LEVB,MAXJET
 9067 FORMAT(' JETC MAY BE TOO LARGE FOR IDATA.',3I10)
      IERRCD = LOR(IERRCD,2)
      MAXJET = MAXJET - MAXHIT
      GOTO 21
 5073 CONTINUE
      DATA KILGHT/0/
      KILGHT=KILGHT+1
      IF(KILGHT.LE.1) WRITE(JUSCRN,9063) IPWRK,IPHDT,NHIT
 9063 FORMAT(' ILLEGAL NHITS',3I10)
      GOTO 5078
 5074 CONTINUE
      DATA KILWRN/0/
      KILWRN=KILWRN+1
      IF(KILWRN.LE.1) WRITE(JUSCRN,9064) IPWRK,IPHDT,IADR
 9064 FORMAT(' ILLEGAL WIRE NUMBER',3I10)
      GOTO 5078
 5075 CONTINUE
      DATA KNONIW/0/
      KNONIW=KNONIW+1
      IF(KNONIW.LE.1) WRITE(JUSCRN,9065) IPWRK,IPHDT,IADR,IADR0
 9065 FORMAT(' NON-INCREASING WIRE NUMBER',4I10)
      GOTO 5078
 1946 CONTINUE
      DATA KILTIM/0/
      KILTIM=KILTIM+1
      IF(KILTIM.LE.1) WRITE(JUSCRN,1947) IPWRK,IPHDT,HWORK(IPWRK+2)
 1947 FORMAT(' ILLEGAL DRIFT TIME:',3I10)
      GOTO 5078
 5076 CONTINUE
      DATA KKEXT/0/
      KKEXT=KKEXT+1
      IF(KKEXT.LE.1) WRITE(JUSCRN,9068) IPWRK,LEVB,LENEVB,KOUNT,KEXTRA
 9068 FORMAT(' HOT WIRE LIST WILL MAKE JETC TOO LONG.',5I10)
      IERRCD = LOR(IERRCD,2)
      GOTO 51
C
C                                       ERROR RECOVERY USING BENCH MARKS

 5078 CONTINUE
      DATA KERRCD/0/
      KERRCD=KERRCD+1
      IF(KERRCD.LE.1) WRITE(6,9069) ICALL,HWORK(18),HWORK(19),KERRCD,
     1IERRCD
 9069 FORMAT(' ERROR RECOVERY: ICALL, RUN, EVENT, KERRCD, IERRCD = ',
     15I6)
      IERRCD = LOR(IERRCD,1)
C---
C---     SPECIAL "MORE SOPHISTICATED" ERROR RECOVERY INSTALLED 30-31
C---     OCTOBER, 1979 BY L.H. O'NEILL
C---     BEFORE JUMPING TO THE NEXT BENCH MARK, TRY TO SAVE THE
C---     INTERVENING DATA BY CHANGING THE LAST HIT COUNTER BEFORE
C---     THE ONE NOW POINTED TO BY IPWRK.
C---
C---     TRY ALL HIT NUMBERS FROM ONE TO EIGHT. IF THIS IS THE FIRST
C---     ERROR RECOVERY ATTEMPT SINCE "IADR0" WAS LAST INCREMENTED,
C---     I.E. SINCE THE LAST LEGAL HIT COUNTER - WIRE ADDRESS PAIR
C---     WAS FOUND, INITIALIZE THE TRIAL NUMBER OF HITS.
C---
      IF(IPWRK.GT.IPWR00) NHTRY=0
C---
C---     INCREMENT COUNTER FOR THE TOTAL NUMBER OF ERROR RECOVERY TRIES
C---     IN THIS RING. ( DEAD LOOP PROTECTION )
C---
      KSPERC=KSPERC+1
      IF(KSPERC.GT.100) GO TO 5080
      NHTRY=NHTRY+1
C---
C---     IF ALL POSSIBLE VALUES OF NHIT HAVE BEEN TRIED, GIVE UP.
C---
      IF(NHTRY.GT.8) GO TO 5090
      IF(NHTRY.GT.1) GO TO 5081
C---
C---     WE NOW HAVE THE FIRST TRIAL VALUE OF THE HIT COUNTER, NAMELY
C---     ONE. USE THE REFORMATTED DATA ARRAY TO DEDUCE HOW MUCH IPWRK
C---     MUST BE DECREMENTED IN ORDER TO GET IT TO POINT TO THE PREVIOUS
C---     HIT COUNTER IN THE UNREFORMATTED DATA ARRAY.
C---
C---     FIND THE NEXT BENCH MARK JUST TO BUILD IN SOME MORE SAFETY
C---     LIMITS.
C---
      IPWBNX=IPWBEN
 5091 IPWBNX=IPWBNX+1
      IF((HDATA(IPWBNX).NE.16384).AND.(IPWBNX.LE.(IPWRK9+3))) GO TO 509100084800
C---
C---     COUNT THE NUMBER OF HITS ON THE LAST WIRE WHOSE ADDRESS IS IN
C---     THE REFORMATTED ARRAY.
C---
      IPWR00=IPWRK
      NALSTR=0
      ILWADD=IPHDT-3
      ILWNUM=HDATA(ILWADD)/8
 5082 NALSTR=NALSTR+1
      ILWADD=ILWADD-4
C---
C---     DO NOT ALLOW SEARCH FOR A DIFFERENT WIRE NUMBER TO GO BELOW
C---     THE ADDRESS OF THE LAST BENCHMARK.
C---
      IF(ILWADD.LT.IPHDTR) GO TO 5083
      JLWNUM=HDATA(ILWADD)/8
      IF(JLWNUM.NE.ILWNUM) GO TO 5083
      GO TO 5082
C---
C---     COMPUTE WHERE THE POINTERS TO THE UNREFORMATTED AND REFOR-
C---     MATTED DATA ARRAYS, "IPWRK" AND "IPHDT" RESPECTIVELY, WERE
C---     WHEN THE HIT COUNTER WE ARE CHANGING WAS FIRST ENCOUNTERED.
C---
 5083 IPWSTR=IPWRK-2-3*NALSTR
      IPHDTS=IPHDT-4*NALSTR
      IF(IPWSTR.LT.(IPWBEN+1)) IPHDTS=IPHDTR
      IF(IPWSTR.LT.(IPWBEN+1)) IPWSTR=IPWBEN+1
      IPWSTQ=IPWSTR-1
      IF((IADR0.GE.0).AND.(IADR0.LE.1535)) ISPINW(IADR0+1)
     1=ISPINW(IADR0+1)+1
      IF((IADR0.GE.0).AND.(IADR0.LE.1535)) ISPINW(1540)=ISPINW(1540)+1
C---
C---     DECREMENT IADR0 SO THAT "NON-INCREASING WIRE NUMBER" ERROR
C---     DOES NOT OCCUR WHEN WE TRY A NEW NHIT.
C---
      IADR00=IADR0-1
C---
C---     FOR ALL TRIAL VALUES OF THE HIT COUNTER RESET THE POINTERS
C---     TO THE UNREFORMATTED AND REFORMATTED DATA TO THE VALUES THEY
C---     HAD WHEN THE HIT COUNTER BEING VARIED WAS FIRST ENCOUNTERED.
C---
 5081 IPWRK=IPWSTR
      IPHDT=IPHDTS
      IADR0=IADR00
      IF((IPWRK+2+3*NHTRY).GT.IPWBNX) GO TO 5090
      NHIT=NHTRY
      GO TO 140
 5090 CONTINUE
C---
C---     VARYING THE PREVIOUS HIT COUNTER HAS FAILED. NOW TRY THE
C---     HYPOTHESIS THAT THE HIT COUNTER IS MISSING. SIMPLY DECREMENT
C---     THE RESTARTING ADDRESS OF THE UNREFORMATTED DATA POINTER BY
C---     ONE, CHECK WHETHER THE CONTENTS OF THE ORIGINAL ADDRESS COULD
C---     POSSIBLY BE A WIRE NUMBER, AND IF SO REPEAT THE ABOVE PRO-
C---     CEDURE.
C---
      IF(IPWSTR.EQ.IPWSTQ) GO TO 5080
      DATA ISOPH/0/
      ISOPH=ISOPH+1
      IF(ISOPH.LE.1) WRITE(JUSCRN,6001) HWORK(18),HWORK(19)
 6001 FORMAT(' SOPHISTICATED ERROR RECOVERY FAILURE LEVEL ONE.',2I8)
      IF((HWORK(IPWSTR).LT.0).OR.(HWORK(IPWSTR).GT.1535)) GO TO 5080
      IPWSTR=IPWSTQ
      NHTRY=1
      GO TO 5081
C---
C---     "SOPHISTICATED" RECOVERY HAS FAILED. SKIP AHEAD TO THE NEXT
C---     BENCHMARK OR TO NEXT PROBABLE HIT COUNTER AS DETERMINED BY
C---     SIMPLE MINDED CRITERIA.
C---
 5080 IPWRK  = IPWBEN
      IPHDT=IPHDTS
      ISOPH=ISOPH+1
      IF(ISOPH.LE.1) WRITE(JUSCRN,6002) HWORK(18),HWORK(19)
 6002 FORMAT(' SOPHISTICATED ERROR RECOVERY FAILURE LEVEL TWO.',2I8)
C---
C---     GIVE IADR0 BACK THE 1 SUBTRACTED ABOVE.
C---
      IADR0=IADR00+1
 5079 CONTINUE
      IPWRK = IPWRK + 1
      IDSOPH=0
      IF((HWORK(IPWRK).EQ.16384).OR.(IPWRK.GE.IPWRK9)) IDSOPH=1
      ISOPH=ISOPH+IDSOPH
      IF((IDSOPH.EQ.1).AND.(ISOPH.LE.1)) WRITE(JUSCRN,6003)
     1HWORK(18),HWORK(19)
 6003 FORMAT(' SOPHISTICATED ERROR RECOVERY FAILURE LEVEL THREE.',2I8)
      IF(IPWRK.GE.IPWRK9) GOTO 120
      IF(HWORK(IPWRK).EQ.16384) GOTO 240
      IF(KSPERC.GT.100) GOTO 5079
      IF(IPWRK.LE.IPWSTR) GOTO 5079
C---
C---     SIMPLE MINDED SEARCH FOR PROBABLE HIT COUNTER.
C---
      NHYPHT=HWORK(IPWRK)
      IF((NHYPHT.LT.1).OR.(NHYPHT.GT.5)) GO TO 5079
      IF(HWORK(IPWRK+1).LE.IADR0) GO TO 5079
      IF(HWORK(IPWRK+1).GT.IADMAX) GO TO 5079
      IPWRL=IPWRK+2+3*NHYPHT
      IF(IPWRL.GE.IPWRK9) GO TO 5079
      NHYPHT=HWORK(IPWRL)
      IF((NHYPHT.LT.1).OR.(NHYPHT.GT.5)) GO TO 5079
      IF(HWORK(IPWRL+1).LE.(IADR0+1)) GO TO 5079
      IF(HWORK(IPWRL+1).GT.IADMAX) GO TO 5079
      GO TO 240
C
      END
