C   12/08/79 103151554  MEMBER NAME  EVFOLDKW (JADESR)      FORTRAN
      SUBROUTINE REFMAI
C
      IMPLICIT INTEGER*2 (H)
C---
C---     ALIASED FROM EVFOLDLH AND CHANGED TO CALL KAWABATA'S NEW
C---     BREAD RATHER THAN YEN'S UNPACK. 14.06. 12.08.79
C---

      COMMON/CMNF/IRUN,IREC,ISTAT,IFLAG,NWPR
      COMMON/CLHOST/NREADE,NFORME,IENT,ISRAW,ISREF,IHRAW(500),IHREF(500)
     1,IHBANK(128),ISPINW(1540)
      COMMON /CUNPK/ ND,NTOLD,NW1,NEV,LENG,N5001,INIT,NDR
      COMMON/CADDMS/IAERKT(10)
      COMMON/CANOM/NORDE,NCOMBN,NBADAD,NASKIP,IANRUN,IANEVN,JUNKRJ
      COMMON/CDFLAG/IDFLAG,LIMOUT,NRNMIN,NRNMAX
C
#include "cdata.for"
#include "cgraph.for"
      COMMON/CWORK/NWORK,IWORK(10000)
C
      DIMENSION LHON(16),LISTRN(9,50),NEVPRN(50),ITIME(6),H50ACT(2)
      EQUIVALENCE(N50ACT,H50ACT(1))
      DATA LHON/ 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,16/
      DATA LSTRN/0/
      DATA NEVPRN/50*0/
      DATA NRUNS/0/
      DATA NINT /2/, NOUT /3/
      DATA NEVIN /0/, NEVOUT /0/
      DATA ITROK /0/
C
C     CALL TMLOG(10,8HEVCONV  )
C
      JUSCRN=6
      NORDE=0
      NCOMBN=0
      NASKIP=0
      NBADAD=0
      NCOMWT=0
      NEVIN=0
      NEVOUT=0
      NREADE=0
      NFORME=0
      IENT=0
      ISRAW=0
      ISREF=0
      IDL8E=0
      IANRUN=0
      IANEVN=0
      JUNKRJ=0
C
      N5001 = 5001
      INIT = 0
C
      DO 900 ICLR=1,500
      IHRAW(ICLR)=0
      IHREF(ICLR)=0
  900 CONTINUE
      DO 899 ICLR=1,128
      IHBANK(ICLR)=0
  899 CONTINUE
      DO 896 ICLR=1,1540
      ISPINW(ICLR)=0
  896 CONTINUE
      CALL BADSPR(1)
C---     COUNT EVENTS ON FAST MULTIHADRON SELECTION FILE.
      MULTI0=0
      MULTI1=0
      MULLNG=0
      H50ACT(1)=0
      ITHRU=1
      KTHRU2=0
C---
C---  THE FOLLOWING STATEMENT TURNS OFF THE FASTSEL FEATURE.
C---                                   13.46 17 FEB 1981 L.O'NEILL
C---
      IF(ITHRU.EQ.1) GO TO 100
  902 CONTINUE
      CALL EVREA1(9,NWORK,IWORK,IRET)
      IF(IRET.EQ.2) GO TO 99
      IF(IRET.EQ.0) GO TO 904
      WRITE(6,903) MULTI0,ITHRU
  903 FORMAT(' **** ERROR ON FASTSEL AFTER',I4,' RECORDS, PASS',I2)
      MULTI0=-100
      GO TO 100
  904 CONTINUE
      MULTI0=MULTI0+2-ITHRU
      KTHRU2=KTHRU2+ITHRU-1
      MULLNG=MULLNG+4*(NWORK+1)*(2-ITHRU)
      IF(KTHRU2.GE.MULTI0) GO TO 100
      GO TO 902
   99 CONTINUE
      IF(ITHRU.EQ.2) GO TO 100
      ITHRU=2
      REWIND 9
      GO TO 902
 100  CONTINUE
      CALL EVREAD(NINT,IRET)
      IF(IRET.NE.2) NEVIN=NEVIN+1
      NWRD2 = NWORD*2
      IF(NWRD2.LT.220) NWRD2 = 220
C     PRINT 2001, NWRD2,IRET,(HDATA(I1),I1=1,NWRD2)
 2001 FORMAT(1H1,2I6,/,(1X,20I6))
      IF(NEVOUT.GE.LIMOUT) GOTO 300
      IF(IRET.EQ.2) GO TO 300
      IF(IRET.NE.0) GO TO 100
C---
C---     WRITE NORD 50 MULTIHADRONS TO FASTSEL DISK FILE.
C---
      IF(MULTI0.LT.0) GO TO 905
      H50ACT(2)=HDATA(34)
      IMN50=LAND(N50ACT,31)
      IF(IMN50.EQ.0) GO TO 905
      IF(MULLNG.GT.5000000) GO TO 905
         IF(MULTI0.GT.2000) REWIND 9
         IF(MULTI0.GT.2000) MULTI0=0
      CALL KALBNK(9,NWORD,IDATA)
      MULTI1=MULTI1+1
      MULLNG=MULLNG+4*(NWORD+1)
  905 CONTINUE
C---
C---     UPDATE RUN LIST.
C---
         IF(HDATA(18).EQ.LSTRN) GO TO 1948
         NRUNS=NRUNS+1
         ITIME(1)=HDATA(11)
         ITIME(2)=HDATA(12)
         ITIME(3)=HDATA(13)
         ITIME(4)=HDATA(14)
         ITIME(5)=HDATA(15)
         ITIME(6)=HDATA(16)
         LASTIM=0
         IDMTIM=KTMCON(ITIME,KTWRIT,LASTIM)
         NCRUN=HDATA(18)
         WRITE(8) NCRUN,IDMTIM,ITIME,KTWRIT
         IF(NRUNS.GT.50) GO TO 1947
         LISTRN(1,NRUNS)=HDATA(18)
         LISTRN(2,NRUNS)=IDMTIM
         LISTRN(3,NRUNS)=HDATA(11)
         LISTRN(4,NRUNS)=HDATA(12)
         LISTRN(5,NRUNS)=HDATA(13)
         LISTRN(6,NRUNS)=HDATA(14)
         LISTRN(7,NRUNS)=HDATA(15)
         LISTRN(8,NRUNS)=HDATA(16)
         LISTRN(9,NRUNS)=KTWRIT
 1947    LSTRN=HDATA(18)
 1948    CONTINUE
C---
         IF(NRUNS.LE.50) NEVPRN(NRUNS)=NEVPRN(NRUNS)+1
      IF(HDATA(20).GE.64) GO TO 1900
      IPNTR1=IDATA(55)
      IPNTR2=0
      IF(IPNTR1.GE.108) IPNTR2=IDATA(IPNTR1-1)
      IF((IPNTR1.GE.108).AND.(IPNTR2.GE.108)) GO TO 1900
      IF(ITROK.LT.100) WRITE(6,1901) HDATA(18),HDATA(19)
 1901 FORMAT(' *** NO TRIGGER BANK. RUN, EVENT = ',2I6,' *********',//)
      ITROK=ITROK+1
      CALL LHODMP
 1900 CONTINUE
         IPNJET=IDATA(61)
         IF(IPNJET.LT.1) GO TO 1950
         IPNERR=2*IPNJET+2
         IERRCD=HDATA(IPNERR)
         IF(IERRCD.EQ.0) GO TO 1950
         IDL8E=IDL8E+1
 1950 CONTINUE
C   THE EVENT IS STORED IN ARRAY ID, THE LENGTH OF THE EVENT
C   IS EQUAL TO (IARR(2)-3)/2 IN I*4 WORDS
C
      NEVOUT=NEVOUT+1
      IF(HDATA(23).GE.2) NCOMWT=NCOMWT+1
      CALL BADSPR(2)
      CALL BWRITE(NOUT,NWORD,IDATA)
C        KLOK=IUHR(1)
C        IF(KLOK.EQ.1) GO TO 898
C        WRITE(6,897)
C 897    FORMAT('0****** WARNING, TIMEOUT ******',//)
C        GO TO 300
C 898    CONTINUE
      GOTO 100
C
  300 CONTINUE
      CALL BADSPR(3)
      CALL BWTEND(NOUT)
      END FILE NOUT
      WRITE(6,894)
  894 FORMAT('1DL8 ERROR FREQUENCY VERSUS ADDRESS. LAST LOCATION HOLDS')
      WRITE(6,893)
  893 FORMAT(' TOTAL NUMBER OF ENTRIES.',/)
      DO 892 LINE=1,77
      IWIRF=20*(LINE-1)
      WRITE(6,891) IWIRF,(ISPINW(IWIRF+KLM),KLM=1,20)
  891 FORMAT(1X,I4,I8,19I6)
  892 CONTINUE
      SRAW=FLOAT(ISRAW)/FLOAT(IENT)
      SREF=FLOAT(ISREF)/FLOAT(IENT)
      WRITE(6,101) IENT,ISRAW,ISREF,SRAW,SREF
  101 FORMAT('0LENGTH HISTOGRAM ENTRIES, ETC. = ',3I10,2F10.2)
      WRITE(6,1779) (LHON(IJK),IJK=1,16)
 1779 FORMAT('0 BANKS',16I6,/)
      WRITE(6,1780) IHBANK
 1780 FORMAT(1X,I12,15I6)
      DO 901 IPAGE=1,2
      IF(IPAGE.EQ.1) WRITE(6,102)
  102 FORMAT(' DISTRIBUTIONS OF LENGTHS OF RAW RECORDS:',/)
      IF(IPAGE.EQ.2) WRITE(6,103)
  103 FORMAT('1DISTRIBUTIONS OF LENGTHS OF REFORMATTED RECORDS:',/)
      DO 901 LINE=1,50
      IWRT=100*(LINE-1)
      LIM1=10*(LINE-1)+1
      LIM2=LIM1+9
      IF(IPAGE.EQ.1) WRITE(6,104) IWRT,(IHRAW(LHO),LHO=LIM1,LIM2)
  104 FORMAT(' ',I5,I15,9I10)
      IF(IPAGE.EQ.2) WRITE(6,104) IWRT,(IHREF(LHO),LHO=LIM1,LIM2)
  901 CONTINUE
      WRITE(6,910) NRUNS
  910 FORMAT(1H0,I4,
     1' RUNS PROCESSED. THE RUN NUMBERS AND EVENTS PER RUN ARE:',//)
      IF(NRUNS.GT.50) NRUNS=50
      DO 912 JRUN=1,NRUNS
      WRITE(6,911) JRUN,LISTRN(1,JRUN),NEVPRN(JRUN),
     1(LISTRN(K,JRUN),K=2,9)
  911 FORMAT(1X,I4,I8,2I12,6I6,I12)
  912 CONTINUE
      WRITE(6,2008) NORDE
 2008 FORMAT(1H0,I10,' NORD PSEUDO EVENTS READ.')
      WRITE(6,2009) NEVIN
 2009 FORMAT(1X,I10,' TOTAL NORMAL AND EXTENDED EVENTS FROM EVREAD.')
      WRITE(6,2010) NEVOUT
 2010 FORMAT(1X,I10,' EVENTS WRITTEN.')
      WRITE(6,2011) NREADE
 2011 FORMAT(1X,I10,' INPUT TAPE READ ERRORS.')
      WRITE(6,2012) NFORME
 2012 FORMAT(1X,I10,' FAILURES TO REFORMAT.')
      WRITE(6,2013) NBADAD
 2013 FORMAT(1X,I10,' ERROR RETURNS FROM EVREAD DUE TO ADDON FAILURE.')
      WRITE(6,2014) NASKIP
 2014 FORMAT(1H0,I10,' EXTENDED EVENTS SKIPPED INTERNALLY BY EVREAD.')
      WRITE(6,2114) JUNKRJ
 2114 FORMAT(1H0,I10,' GARBAGE ENENTS WITH TYPE 128 REJECTED.')
      WRITE(6,2015) NCOMBN
 2015 FORMAT(1H0,I10,' EXTENDED EVENTS SUCCESSFULLY ASSEMBLED.')
      WRITE(6,2016) NCOMWT
 2016 FORMAT(1H0,I10,' EXTENDED EVENTS ACTUALLY WRITTEN.')
      WRITE(6,2017) MULLNG
 2017 FORMAT(1H0,' FASTSEL FILE IS NOW',I8,' BYTES LONG.')
      WRITE(6,2018) MULTI0,MULTI1
 2018 FORMAT(1H0,I4,' EVENTS WERE ON FASTSEL.',I4,' WERE ADDED.')
      WRITE(6,1915) IDL8E
 1915 FORMAT(1H0,' EVENTS WITH DL8 ERROR RECOVERIES:',I6)
      WRITE(6,1913) IANRUN,IANEVN
 1913 FORMAT(1H0,' RUN NUMBER AND EVENT NUMBER ANOMALIES:',2I6)
      WRITE(6,1912)
 1912 FORMAT(1H0,' NUMBERS OF THE VARIOUS ADDON ERRORS:')
      WRITE(6,1914) IAERKT
 1914 FORMAT(1X,10I6,/)
      IF(ITROK.EQ.0) WRITE(6,1910)
 1910 FORMAT(1H0,' TRIGGER BANKS WERE PRESENT FOR EVERY EVENT.')
      IF(ITROK.NE.0) WRITE(6,1911) ITROK
 1911 FORMAT(1H0,' WARNING. THERE WERE',I6,' MISSING TRIGGER BANKS.')
C
C     CALL TMLOG(0)
C
      RETURN
      END
      SUBROUTINE EVWRIT(NUNIT,NWORD,ARRAY)
      DIMENSION ARRAY(NWORD)
      WRITE(NUNIT) NWORD,ARRAY
      RETURN
      END
      SUBROUTINE EVREAD(NUNIT,IRET)
      IMPLICIT INTEGER *2 (H)
#include "cgraph.for"
#include "cdata.for"
      COMMON/CWORK1/NWORK1,IWORK1(10000)
      COMMON/CWORK/NWORK,IWORK(10000)
      COMMON/CANOM/NORDE,ICOMBN,NBADAD,NASKIP,IANRUN,IANEVN,JUNKRJ
      COMMON/CDFLAG/IDFLAG,LIMOUT,NRNMIN,NRNMAX
      DIMENSION HWORK(20000)
      EQUIVALENCE(IWORK(1),HWORK(1))
      COMMON/CLHOST/NREADE,NFORME,IENT,ISRAW,ISREF,IHRAW(500),IHREF(500)
     1,IHBANK(128)
      DATA NADMS/0/
      DATA ICALL/0/
      DATA LSTCDE/16/
      DATA LASTRN/-1/
      ICALL=ICALL+1
      NWORK1=0
      NADDON=0
      IADDFL=0
 1776 CONTINUE
      IRET=0
      CALL BREAD(NUNIT,NWORK,IWORK,&1000,&2000)
 3000 CONTINUE
      IF(IRET.NE.0) GO TO 1778
C---
C---     CHECKING THAT EVENT NUMBER INCREASES PROPERLY. INSTALLED
C---     11.20 22.10.79 BY L.H. O'NEILL.
C---
      NRUN=HWORK(18)
C---     FIXUP YEAR SCREWUP
         IF((NRUN.GE.2570).AND.(NRUN.LE.2802)) HWORK(16)=1980
      IF((NRUN.LT.NRNMIN).OR.(NRUN.GT.NRNMAX)) GO TO 1776
      NEVENT=HWORK(19)
 1900 CONTINUE
      IF(NRUN.NE.LASTRN) GO TO 1901
      IF(NEVENT.LE.LASTEV) GO TO 1902
      IF(NEVENT.GT.(LASTEV+100)) GO TO 1902
      GO TO 1910
 1901 CONTINUE
      LASTEV=-1
      IF((NRUN.NE.(LASTRN+1)).AND.(LASTRN.NE.-1)) GO TO 1903
      LASTRN=NRUN
      GO TO 1900
 1903 CONTINUE
      WRITE(6,1990) NRUN,LASTRN
 1990 FORMAT
     1(' *** ANOMALOUS RUN NUMBER SEQUENCE. NEW RUN, LAST RUN = ',2I8)
      IANRUN=IANRUN+1
      LASTRN=NRUN
      GO TO 1900
 1902 CONTINUE
      WRITE(6,1991) NRUN,NEVENT,LASTEV
 1991 FORMAT
     1(' *** ANOMALOUS EVENT NUMBER SEQUENCE. RUN, EVN, LAST EVN:',3I8)
      IANEVN=IANEVN+1
 1910 CONTINUE
      LASTEV=NEVENT
      NORDE=NORDE+1
      IF(HWORK(20).EQ.128) JUNKRJ=JUNKRJ+1
      IF(HWORK(20).EQ.128) GO TO 1776
      IOVERF=HWORK(23)
      IF(IOVERF.GE.2) IADDFL=1
      IF((IOVERF.LT.2).AND.(LSTCDE.EQ.16)) GO TO 1778
      LSTCDE=IOVERF
C---
C---     THE CURRENT EVENT MUST BE COLLECTED FROM SEVERAL NORD PSEUDO
C---     EVENTS.
C---
      CALL ADDON
C---
C---     IN CASE TERMINATOR VALUE "IOVERF=16" NEVER COMES AND "IOVERF"
C---     .LT.2 OCCURS FIRST, LET ADDON GENERATE ITS ERROR MESSAGE BUT
C---     SAVE THE CURRENT, NON-OVERFLOW EVENT.   17.32 11.08.79
C---
      IF(IOVERF.LT.2) NWORK1=0
      IF(IOVERF.LT.2) GO TO 1778
      NADDON=NADDON+1
      IF(IOVERF.EQ.16) GO TO 1777
C---
C---     SEND MESSAGE IF THERE ARE MORE THAN 10 CONTINUATIONS. THEN
C---     JUST SKIP FORWARD UNTIL NEXT NORMAL EVENT WITH OVERFLOW
C---     FLAG 0 OR 1.
C---
      IF(NADDON.LT.10) GO TO 1776
      NWORK1=-1
      NADMS=NADMS+1
      IF(NADMS.GT.10) GO TO 1776
      WRITE(6,1781) ICALL,HWORK(18),HWORK(19)
 1781 FORMAT('0ERROR: MORE THAN 10 CONTINUATIONS. ICALL, RUN, EVENT = ',
     13I8,//)
      CALL LHODMP
      GO TO 1776
 1777 CONTINUE
C---
C---     ADDON HAS BUILT UP THE TRUE EVENT IN CWORK1. MOVE IT BACK
C---     INTO CWORK.
C---
      IF(NWORK1.LT.1) GO TO 1778
      IADDFL=0
      ICOMBN=ICOMBN+1
      LMOVE=4*NWORK1
      CALL MVCL(IWORK(1),0,IWORK1(1),0,LMOVE)
      NWORK=NWORK1
      IF(NADDON.GT.2) HWORK(23)=NADDON
      IF(ICOMBN.GT.100) GO TO 1778
C---  WRITE(6,1790)
 1790 FORMAT('0EVENT EXTENDED OVER MULTIPLE NORD "EVENTS".')
C---  WRITE(6,1791) HWORK(18),HWORK(19),NADDON,NWORK
 1791 FORMAT
     1(' RUN NO., EVNT. NO., NUMB OF NORD "EVENTS", UNREFORM. I*4 LENGTH
     1',4I8,//)
 1778 CONTINUE
      LSTCDE=16
      IF(IRET.EQ.1) NREADE=NREADE+1
      IF((IRET.EQ.1).AND.(NREADE.LE.10)) WRITE(6,100) ICALL
  100 FORMAT(' ERROR FROM EVREA2. EVCONV NOT CALLED. ICALL=',I10)
      IF((IRET.EQ.1).AND.(NREADE.LE.20)) CALL LHODMP
      IREPLY=0
      IF(NWORK1.LT.0) IRET=1
      IF(NWORK1.LT.0) NBADAD=NBADAD+1
      IF(IRET.EQ.0) CALL EVCONV(IREPLY)
         IF(IDFLAG.EQ.0) GO TO 1946
         IPNJET=IDATA(61)
         IF(IPNJET.LT.1) GO TO 1946
         IPNERR=2*IPNJET+2
         IERRCD=HDATA(IPNERR)
         IF(IERRCD.EQ.0) GO TO 1946
         DATA KERREC/0/
         KERREC=KERREC+1
         IF(KERREC.GT.20) GO TO 1946
         CALL LHODMP
 1946    CONTINUE
      IF(IREPLY.NE.0) IRET=1
      IF(IREPLY.NE.0) NFORME=NFORME+1
      IF((IREPLY.NE.0).AND.(NFORME.LE.10)) WRITE(6,101) ICALL
  101 FORMAT(' REFORMATTING ERROR. ICALL=',I10)
      IF((IREPLY.NE.0).AND.(NFORME.LE.20)) CALL LHODMP
      NASKIP=NASKIP+IADDFL
      IF(IRET.NE.0) RETURN
      INRAW=(NWORK-1)/10+1
      IF(INRAW.LT.1) INRAW=1
      IF(INRAW.GT.500) INRAW=500
      INREF=(NWORD-1)/10+1
      IF(INREF.LT.1) INREF=1
      IF(INREF.GT.500) INREF=500
      IHRAW(INRAW)=IHRAW(INRAW)+1
      IHREF(INREF)=IHREF(INREF)+1
      IENT=IENT+1
      ISRAW=ISRAW+NWORK
      ISREF=ISREF+NWORD
      RETURN
 1000 IRET=2
      GO TO 3000
 2000 IRET=1
      GO TO 3000
      END
C
      SUBROUTINE LHODMP
C
      IMPLICIT INTEGER*2 (H)
C
      COMMON/CWORK/NWORK,HWORK(20000)
#include "cdata.for"
#include "cgraph.for"
C
      DATA ICALL /0/
      ICALL = ICALL + 1
      IF(ICALL.GT.0) RETURN
C
      DO 1 I=1,2
      IF(I.EQ.2) WRITE(6,103)
      IF(I.EQ.2) WRITE(6,103)
      IF(I.EQ.1) WRITE(6,101)
      IF(I.EQ.2) WRITE(6,102)
  101 FORMAT(' CAMAC EVENT:')
  102 FORMAT(' REFORMATTED EVENT:')
      WRITE(6,103)
  103 FORMAT('  ')
      IF(I.EQ.1) LENG=2*NWORK
      IF(I.EQ.2) LENG=2*HDATA(208)
      IF((LENG.GE.1).AND.(LENG.LE.20000)) GO TO 3
      WRITE(6,104) I,LENG
  104 FORMAT(' ILLEGAL LENGTH IN LHODMP. I, LENG=',2I10)
      GO TO 1
    3 CONTINUE
      LINES=1+(LENG-1)/20
      DO 2 LINE=1,LINES
      LIM1=20*(LINE-1)+1
      LIM2=LIM1+19
      IF(LIM2.GT.LENG) LIM2=LENG
      IF(I.EQ.1) WRITE(6,105) LIM1,(HWORK(LHO),LHO=LIM1,LIM2)
      IF(I.EQ.2) WRITE(6,105) LIM1,(HDATA(LHO),LHO=LIM1,LIM2)
  105 FORMAT(1X,I6,6X,20I6)
    2 CONTINUE
    1 CONTINUE
      RETURN
C
      END
