C   07/06/96 606071844  MEMBER NAME  GOREC    (S4)          FORTRAN
C   16/03/79 C9031701   MEMBER NAME  GOREC    (SRC)         FORTRAN
      SUBROUTINE GOREC(*,*)
C   06/02/79            MEMBER NAME  GOREC    (S)           FORTRAN
C   23/01/79 C9020601   MEMBER NAME  GOREC    (SRC)         FORTRAN
C   12/12/78 C9011001   MEMBER NAME  GOREC    (SRC)         FORTRAN
C   05/12/78 C8120601   MEMBER NAME  GOREC    (SRC)         FORTRAN
C   24/10/77 C8111201   MEMBER NAME  GOREC    (PLULIBS)     FORTRAN
C
C
C     LIEST EVENTS VON SEQ. BZW. LSB (FT01 WEITERE FTNUMMERN
C     SIND MIT DER DATENKARTE
C     RUNI SECFT THIRDFT
C     WOBEI SECFT ETC DIE FTNUMMERN DER EINHEITEN SIND, DIE NACH
C     FT01 GELESEN WERDEN) UND DIRECTACCESSDATEIEN (FT30-39).
C     MISCHUNG VON DA UND SEQ EINGABE IST NICHT MOEGLICH.
C     ZUR BESCHEIBUNG DER EINGABE GIBT ES
C     SEQEX        VOREINSTELLUNG
C     SEQMC        FUER MONTE-CARLO-DATEN
C     DAEX NUNIT NA NB   NA UND NB SIND DIE GRENZEN ZWISCHEN DENEN
C     DAMC NUNIT NA NB   DER DIRECT-ACCESS-DATENSATZ GELESEN WIRD
C                        NUNIT=FORTRANEINHEIT, MEHRERE TRIPEL MOEGLICH
C     RFTN               ALS EINGABEKARTE SCHALTET AUF LESEN MIT
C                        FORTRAN UM (ANSTELLE VON ASSEMBLER)
C
C     ZUR STEUERUNG DER EINGABE GIBT ES DIE KARTEN
C     RECSKIP NREC  BENUTZE DIE ERSTEN NREC RECORDS NICHT
C     SKIP    NRUN1..NRUN2-NRUN3  BENUTZE DIESE RUNS NICHT
C     USE     NRUN1..NRUN2-NRUN3  BENUTZE NUR DIESE RUNS
C
C     DIE STEUERUNG KANN AUCH UEBER SUBROUTINE-CALLS ERFOLGEN
C     CALL SKRUN   UEBERSPRINGE RUN
C     CALL SKREST  UEBERSPRINGE REST DES DATENSATZES
C     CALL SPECEV(&1)  ERMOEGLICHT DIE AUSWAHL VON BESTIMMTEN
C                  EVENTS,DIE ROUTINE NIMMT DEN NORMALEN
C                  AUSGANG FUER ALLE EVENTS,DIE AUF
C     $RUN NRUN NEV1 NEV2  VERZEICHNET SIND, SONST RETURN 1.
C
C     ES IST MOEGLICH NUR RUNS BESTIMMTER ENERGIE ZUZULASSEN
C     DIE SELEKTION ERFOLGT AUTOMATISCH, WENN FOLGENDE KARTE DA IST
C     SELE EBEAM1-EBEAM2 EBEAM3-EBEAM4 ...(EBEAM IN GEV)
C     DIE SUBROUTINE MONCOU ADDIERT DIE KORRIGIERTEN MONITOR-COUNTS
C     AUF UND SPEICHERT DIE LUMINOSITAETEN IN 1/NB AUF DER BANK
C     (NANO,0). DAZU MUSS VOR DEM AUFRUF VON GOREC (ABER NACH BINT)
C     CALL MONCOU  GERUFEN WERDEN.NOETIG IST EINE STEUERKARTE
C     EBEAM   EBEAM1 EBEAM2 EBEAM3 ....
C     DANN WIRD IN DEN INTERVALLEN 0-EBEAM1 (1.INTERVALL) EBEAM1-
C     EBEAM2 (2.INTERVALL) .. DIE LUMINOSITAET AUFADDIERT.
C     CALL SELMON (I,ALUM)  LIEFERT DANN DIE NUMMER DES INTERVALLS FUER
C     DEN GERADE LAUFENDEN RUN, ALUM DIE LUMINOSITAET. DIE STEUERKARTE
C     PRMO  LIEFERT AUSFUEHRLICHE INFORMATIONEN UEBER DEN MONITOR
C     DER RUNBEREICH, IN DEM ADDIERT WIRD MUSS DURCH EINE ODER
C     MEHRERE STEUERKARTEN
C     RUNS NRUN1 NRUN2
C     SPEZIFIZIERT WERDEN
C
C     DIE STEUERKARTE *LISTE DIENT ZUM FESTLEGUNG DER BANKS, DIE
C     AUSGESCHRIEBEN BZW. ZERSTOERT WERDEN SOLLEN. SIE IST NUR
C     NOETIG, WENN WAEHREND DES JOBS VOM USER NEUE BANKS ERZEUGT
C     WERDEN.
C     FORMAT
C     *LISTE 5 7 '(7(1X,A4))
C      HEAD EV15 EV30 AREV EV31 COPH TEIS
C     BEDEUTUNG  DIE ERSTEN 5 NAMEN DER LISTE WERDEN AUSGESCHRIEBEN
C     ALLE 7 BANKS WERDEN NACH JEDEM EVENT VERNICHTET. BEI VERWENDUNG
C     DER *LISTE-KARTE MUESSEN UNBEDINGT ALLE VORKOMMENDEN BANKNAMEN
C     ALS ZU ZERSTOEREND ERKLAERT WERDEN.
C     ALS ALTERNATIVE GIBT ES DIE AUFRUFE
C     CALL BSAW(N,'NAM1NAM2....NAMN') FUER AUSZUSCHREIBENDE BANKS
C     CALL BSAT(N,'NAM1NAM2....NAMN') FUER NICHT ZU SCHREIBENDE BANKS
C
C     DIE AUSGABE VON EVENTS KANN AUF SEQUENTIELLE (FT08),
C     DIRECT-ACCESS (FT02) SOWIE LSB-DATEIEN (FT09) SOWIE AUF
C     DEN KARTENSTANZER (FT07) ERFOLGEN. STEUERKARTEN
C     SEQWRT
C     DAWRT NA NB
C     LSBWRT
C     ZUSAETZLICH GIBT ES FOLGENDE SUBROUTINE-CALLS
C     CALL SEQWRT   DIE ROUTINEN KOENNEN AUCH MEHRFACH
C     CALL SEQNOW   PRO EVENT GERUFEN WERDEN,AUSSCHLAG-
C     CALL DAWRT    GEBEND IST DER LETZTE AUFRUF.
C     CALL DANOW    VOREINSTELLUNG  SEQWRT DANOW
C     CALL LSBWRT   VOREINSTELLUNG  LSBNOW
C     CALL LSBNOW
C     CALL PUNEVT SCHREIBT RUNNUMMER UND EVENTNUMMER IM
C                 FORMAT, WELCHES VON 'SPECEV' ERWARTET WIRD
C                 BEGRENZUNG AUF LIM EVENTS ERFOLGT MIT
C     CALL PUNLIM(LIM) VOREINSTELLUNG 100
C     WENN KEINE WEITERE AUSGABE AUF FT02 ODER FT09 ERWARTET
C     KANN DER OUTPUT ABGESCHLOSSEN WERDEN MIT DEM AUFRUF
C     CALL LSBCLS(IUNIT)        IUNIT=2,9
C
C     DIE STEUERUNG DES AUSDRUCKS ERFOLGT MIT
C     CALL PRIEVT SCHREIBT EIN EVENT MIT ALLEN BANKS AUF FT06
C     CALL PRILIM(LIM) BEGRENZUNG AUF LIM (10) EVENTS
C     PRHD        BEWIRKT DEN AUSDRUCK JE EINER ZEILE FUER
C                 RUNBEGINN UND RUNENDE
C     PRSH        BEWIRKT VERKUERZTEN AUSDRUCK(10 RUNS / ZEILE)
C     LIMIT NREC NSEC NERR  BEWIRKT DEN ABBRUCH DES JOBS
C                 NACH NREC (ALLE) EVENTS  NSEC (2) SEKUNDEN VOR
C                 TIME OVERFLOW  NACH NERR (5) LESEFEHLERN
C
C     MIT DER DATENKARTE
C     NORB   WIRD VERHINDERT,DASS GOREC DEN
C     RUN AUF DER RUNBIBLIOTHEK SUCHT (TESTBETRIEB)
C
C     DIE EVENT-DATEN AB OKTOBER 1977 HABEN ALS KENNUNG DIE BANK
C     (HEAD,0)     LAENGE 10 PLATZ 1 RUNNUMMER PLATZ 2 EVENTNUMMER
C     NICHT-EVENTDATEN(BANKS TE01 CH03 MO04 ETC.) WERDEN WIE EIN
C     RECORD BEHANDELT, GOREC VERZWEIGT JEDOCH ZUR SUBROUTINE
C     SPECRC(INIR,NTOT) INIR  INDEX DES 1. WORTES, NTOT *4-WORDCOUNT
C     DIE VOM USER GESCHRIEBEN WERDEN MUSS, WENN DIESE BANKS
C     BEHANDELT WERDEN SOLLEN.
C
C     BENOETIGT WERDEN DIE BIBLIOTHEKEN
C     F14LUE.PLULIB  LKED.SYSLIB
C     PLUTOS.PDADAT  GO.FT14F001 FUER EXP. DATEN
C     F33BAC.RNBIBBA GO.FT15F001 FUER MONTE CARLO '76
C     F33MOC.RUNBIB  GO.FT15F001 FUER MONTE CARLO '78 - '80
C     PLUTOS.DABANK  GO.FT17F001 FUER EICHUNG SHOWER/MYON/HADRON ABS
C
      EXTERNAL PUNEVT,PRIEVT,SBYT,JFUL,LDBIT
C     BENUTZTE COMMON-BEREICHE
      COMMON/BCS/IW(1000)
      REAL RW(1000)
      INTEGER*2 IW2(2)
      EQUIVALENCE (IW(1),IW2(1))
      EQUIVALENCE(IW(1),RW(1))
C     ALLGEMEINER DATENSPEICHER
      INTEGER*2 IPAR
      COMMON/IPAR64/IPAR(64)
      INTEGER JPAR(32)
      EQUIVALENCE (IPAR(1),JPAR(1))
C     SPEICHERUNG VON DATEN AUS DER RUNBIBLIOTHEK
      COMMON/FLAGMC/MONTE
C     FLAGGE FUER MONTE CARLO
      COMMON/BLISTE/NLD,NLW
C     N1 UND N2 AUS *LISTE-STEUERKARTEN
      COMMON/STIMES/JSEC
C     COMMON AUS ZEITABBRUCHROUTINE JUHR
      COMMON/RUBIBL/ LMAX,IUNGRN,NR0,LRECL,NRPAR
C     COMMON FUER RUNBIB
C
      REAL CP/0./,HNULL/0./,EBEAM/0./
      LOGICAL DA/.FALSE./,END/.FALSE./,MONTE,HEADLG
      LOGICAL CURR/.FALSE./,SKIP/.FALSE./,PRHD/.FALSE./
      LOGICAL DAW/.FALSE./,SEQW/.FALSE./,SEQWC/.FALSE./
      LOGICAL DAWRTC/.FALSE./,EOF/.FALSE./,ERR/.FALSE./
      LOGICAL LRECSK/.FALSE./,PRSH/.FALSE./,DAWRTL/.FALSE./
      LOGICAL LSBW/.FALSE./,LSBWC/.FALSE./,NORB/.FALSE./
      LOGICAL EVE,NOFOR/.FALSE./,FIXFOR/.FALSE./
      INTEGER IKATA/0/,PROP/'PROP'/,INUNIT/1/
      INTEGER LIM(3)/0,3,5/,NRUN/0/,LRUN/0/,IWR/8/,IOLD/0/
      INTEGER IEV/0/,NEVT/0/,NERR/0/,JR/0/,HEAD/'HEAD'/,HIDD/'HIDD'/
      INTEGER RECSKI/0/,RECSKP/0/,SPEC/0/
      INTEGER TEXT(3,6)/'END ','OF D','S   ','EVEN','T LI','MIT ',
     1'TIME','LIMI','T   ','ERRO','R LI','MIT ',
     2'INSU','FF.S','PACE','USER',' CAL','L   '/
C
C     ENDE VEREINBARUNGSTEIL
C
C     INITIALISIERUNG
      IF (CURR) GOTO 30
C
C     BLOBELS NEW TIME-OVERFLOW ROUTINE
C     NOT USED
C     CALL AAAA
      MONTE=.FALSE.
      CALL BLOC (IND,'SEQM',0,&1)
      MONTE=.TRUE.
      GOTO 3
1     CALL BLOC (IND,'DAMC',0,&2)
      INUNIT=IW(IND+1)
      MONTE=.TRUE.
      DA=.TRUE.
      GOTO 3
2     CALL BLOC (IND,'DAEX',0,&3)
      INUNIT=IW(IND+1)
      DA=.TRUE.
3     IF (MONTE) WRITE (6,1002)
      IF (DA) WRITE (6,1004)
      CALL BLOC (IND,'LIMI',0,&5)
      NW=IW(IND)
      IF (NW.EQ.0) GOTO 5
      IF (NW.GE.4) NW=3
      DO 4 I=1,NW
4     LIM(I)=IW(IND+I)
5     CALL BLOC (IND,'PRHD',0,&6)
      PRHD=.TRUE.
      CALL BDLS ('PRHD',0)
6     CALL BLOC (IND,'SEQW',0,&7)
      SEQW=.TRUE.
7     CALL BLOC (IND,'DAWR',0,&8)
      DAW=.TRUE.
      CALL BWRO(2,1609,2)
8     CALL BPOS ('*LIS')
      CALL BNXT (IND,&9)
      NLD=IW(IND)
      NLW=IW(IND-2)
9     CONTINUE
      CALL BLOC(IND,'VREA',0,&9005)
      NOFOR=.TRUE.
9005  CONTINUE
      CALL BLOC(IND,'RECS',0,&10)
      RECSKI=IW(IND+1)
      RECSKP=RECSKI
      CALL BDLS ('RECS',0)
10    CONTINUE
      CALL BLOC(IND,'PRSH',0,&11)
      PRSH=.TRUE.
      CALL BDLS ('PRSH',0)
      PRHD=.FALSE.
11    CONTINUE
      CALL BLOC(IND,'DAWL',0,&12)
      DAWRTL=.TRUE.
      DAW=.TRUE.
12    CONTINUE
      CALL BLOC(IND,'LSBW',0,&13)
      LSBW=.TRUE.
      CALL BWRO(9,1609,2)
13    CONTINUE
      CALL BLOC(IND,'NORB',0,&14)
      NORB=.TRUE.
14    CONTINUE
      CALL BLOC(IND,'RFTF',0,&15)
      FIXFOR=.TRUE.
15    CONTINUE
      CURR=.TRUE.
C     CALL PRIPS
C
C     ENDE INITIALISIERUNG
C
30    IF (END) GOTO 102
      IF (LRUN.NE.0.AND.LRUN.NE.NRUN) GOTO 62
C
C     AUSSCHREIBEN EINES EVENTS (SEQUENTIELL)
C
      IF (.NOT.SEQW) GOTO 42
      IF (.NOT.SEQWC) GOTO 42
      CALL BSLW
      CALL BWRITE(8)
42    SEQWC=.TRUE.
C
C     AUSSCHREIBEN DIRECT-ACCESS
C
      IF (.NOT.DAW) GOTO 44
      IF (.NOT.DAWRTC) GOTO 44
      IF (DAWRTL) CALL BSLW
      IF (.NOT.DAWRTL) CALL BMLT(10,'HEADPROPGEOMVTYPEV00EV15EV30AREVMYC
     *OEV31')
      CALL CNTPOP(&44)
43    CALL BWRS(2,NTOT,INIR)
      IF (INIR.EQ.0) GOTO 44
      CALL PREPOP(NRECO,&435)
      CALL FWRTDB(2,NRECO,NTOT,IW(INIR))
      GOTO 43
435   DAW=.FALSE.
      GOTO 43
44    DAWRTC=.FALSE.
C
C     AUSSCHREIBEN LSB
C
      IF (.NOT.LSBW) GOTO 48
      IF (.NOT.LSBWC) GOTO 48
      CALL BSLW
      CALL BWRITE(9)
48    LSBWC=.FALSE.
C
C     LETZTES EVENT ENTFERNEN
C
      CALL BSLT
      CALL BDLM
      CALL BGAR(IGA)
C
C     VORGEGEBENE GRENZEN ERREICHT
C     USE OLD IUHR
50    IF(IUHR(LIM(2)).EQ.2) GOTO 93
C 50    IF (JSEC.LE.LIM(2)) GOTO 93
      LRECSK=.FALSE.
      IF (LIM(1).NE.0.AND.NEVT.GE.LIM(1)) GOTO 92
C
C     EINLESEN
C
      IF (RECSKI.EQ.0) GOTO 51
      RECSKI=RECSKI-1
      IF (RECSKI.EQ.0) WRITE (6,1018) RECSKP
      LRECSK=.TRUE.
51    CONTINUE
515   CALL BRDS(INUNIT,NTOT,INIR)
      IF (INIR.EQ.0) GOTO 56
      IF (DA) GOTO 54
      IF (NOFOR) GOTO 517
      CALL BFRD(INUNIT,IW(INIR),IW(INIR+1))
      IF (IW(INIR)) 91,72,515
517   CONTINUE
      CALL VBUFF(MIN0(32000,NTOT*4))
52    CALL VREAD(IW(INIR),IW(INIR+1),&91)
C     NTOT=(NTOT+3)/4
      IF (IW(INIR+1).EQ.HEAD.OR.IW(INIR+1).EQ.HIDD) GOTO 55
      NTOT=(NTOT+1)/2
      IF (NTOT.LT.20) SPEC=SPEC+1
      IF (NTOT.LT.20) GOTO 52
      IF (IW(INIR+9).NE.PROP) GOTO 53
      IW(INIR+5)=IW2(INIR*2+1)
      IW(INIR+1)=HEAD
      IW(INIR+2)=0
      IW(INIR+3)=0
      IW(INIR+4)=4
      IW(INIR+6)=IW2(INIR*2+3)
      IW(INIR+7)=0
      IW(INIR+8)=0
      IOLD=IOLD+1
      GOTO 55
53    IKATA=IKATA+1
      IF (IKATA.GT.20) GOTO 52
      WRITE (6,1024) INIR
      CALL UWP(IW,INIR,INIR+20)
      GOTO 52
54    CONTINUE
      CALL PREPIP(INUNIT,NRECI,&91)
      CALL FRDDA(INUNIT,NRECI,IW(INIR),IW(INIR+1),&91)
55    CONTINUE
      GOTO 515
56    CONTINUE
C
C     CHECK SPECIAL RECORD
C
      EVE=.TRUE.
      CALL LENHEA(&95)
      CALL BLOC(IHEAD,'HEAD',0,&72)
      IF (IW(IHEAD+4).EQ.0) GOTO 58
      EVE=.FALSE.
      SPEC=SPEC+1
C     CALL SPECCO(INIR,NTOT)
      CALL SPECRC(INIR,NTOT)
      IF (LRECSK) RECSKI=RECSKI+1
C     GOTO 30
58    CONTINUE
      IF (LRECSK) GOTO 48
C
C     EVENT INPUT
C
      NRUN=IW(IHEAD+1)
      IF (NRUN.EQ.LRUN.AND.SKIP) GOTO 48
      CALL BLOC(ILW,'*LIS',NLW,&59)
      CALL BSAT (NLD,IW(ILW+1))
      CALL BSAW(NLW,IW(ILW+1))
      CALL BSAW(1,'HEAD')
59    CONTINUE
      IF (NRUN.NE.LRUN) GOTO 60
      IF (EVE) IEV=IEV+1
      IF (EVE) NEVT=NEVT+1
C     CALL LENVTY(&95)
      IF (PRSH) CALL RUNC
      GOTO 101
C
C     RUNBIBLIOTHEK
C
60    IF (LRUN.EQ.0) GOTO 62
      IF (SKIP) GOTO 62
61    IF (PRHD) WRITE (6,1006) LRUN,IEV
      GOTO 102
62    LRUN=NRUN
      IF (NORB) GOTO 67
      CALL BSPC(IA,LB,IDM1,IDM2)
      IF (LB.LT.1610) GOTO 95
C
C     AUTOMATIC MC - RECOGNITION
C
      CALL BLOC(IHD,'HEAD',0,&635)
      HEADLG=.FALSE.
      IF (IW(IHD+14).NE.0) HEADLG=.TRUE.
      IF((MONTE.AND.HEADLG).OR.((.NOT.MONTE).AND.(.NOT.HEADLG)))GOTO 63500037200
      MONTE=HEADLG
C     WRITE (6,1030) MONTE
      CALL CAPITL('FROM NOW',8,6)
      CALL CAPITL('READING ',8,6)
      IF (MONTE) CALL CAPITL('M CARLO',8,6)
      IF (.NOT.MONTE) CALL CAPITL('REAL    ',8,6)
      CALL CAPITL('EVENTS  ',8,6)
      IF (MONTE) GOTO 635
      IUNGRN=14
      NR0=220
  635 CONTINUE
C
      IRETC=2
      IF (MONTE) GOTO 64
      CALL GETRUN(LRUN,IPAR,IW(IA),&70,&71)
      GOTO 66
64    CONTINUE
      CALL MCGRUN(LRUN,IPAR,IW(IA),&70,&71)
66    CONTINUE
C
C     NEUER RUN
C
67    CALL SELRUN(SKIP,NRUN)
      IF (SKIP) GOTO 44
      IEV=0
      IF (NORB) GOTO 69
      HNULL=IPAR(26)
      HNULL=0.001*HNULL
      CP=HNULL*3.0E-5
      EBEAM=FLOAT(JPAR(6))/1000.
      CALL SELEN(EBEAM/1000.,'SELE',NEB)
      IF (NEB.NE.1) GOTO 68
      SKIP=.TRUE.
      GOTO 44
68    CONTINUE
      CALL BDLS('RUN ',0)
      CALL BCRE (IRN,'RUN ',0,50,&95,IER)
      SCHLAN=0.
      IF(LRUN.LT.15000) SCHLAN=0.012
      IW(IRN+1)=LRUN
      RW(IRN+2)=HNULL
      RW(IRN+3)=CP
      RW(IRN+4)=EBEAM
      RW(IRN+16)=0.0
      RW(IRN+17)=2.0*EBEAM*SCHLAN/1000.
      RW(IRN+18)=0.0
      RW(IRN+19)=2.0*EBEAM/1000.
69    CONTINUE
      IF (EVE) IEV=IEV+1
      IF (EVE) NEVT=NEVT+1
      IF (PRHD) WRITE (6,1008) LRUN,HNULL,CP,EBEAM
      IF (PRSH) CALL RUNC
C     CALL LENVTY(&95)
      GOTO 100
C
C     SPECIAL CONDITIONS-  RUNLIB NOT OKAY
C
70    CONTINUE
      IRETC=1
71    CONTINUE
      WRITE (6,1010) LRUN,IRETC
      SKIP=.TRUE.
      GOTO 44
C
C     READ ERROR
C
72    NERR=NERR+1
      IF (NERR.GT.LIM(3)) GOTO 94
      GOTO 44
C
C     ABBRUCHKRITERIEN
C
98    JR=JR+1
97    JR=JR+1
96    JR=JR+1
95    JR=JR+1
94    JR=JR+1
93    JR=JR+1
92    JR=JR+1
91    JR=JR+1
      IF (JR.NE.1) GOTO 89
      CALL BLOC(IR,'RUNI',0,&89)
      JLEN=IW(IR)
      IF (JLEN.LE.0) GOTO 89
      DO 90 KK=1,JLEN
      IF (IW(IR+KK).LT.0) GOTO 90
      WRITE (6,1028) INUNIT,IW(IR+KK)
      CALL BSTA
      CALL BDLS('+BUF',INUN IT)
      CALL BDLS('$BUF',INUN IT)
      INUNIT=IW(IR+KK)
      IW(IR+KK)=-INUNIT
      JR=0
      CALL VPARM(INUNIT,32767,1,1,10)
      GOTO 30
90    CONTINUE
89    CONTINUE
      END=.TRUE.
      GOTO 61
C
C
      ENTRY GOBEG(*)
C
      IF (.NOT.END) GOTO 101
      IF (JR.NE.1) END=.FALSE.
      WRITE(6,1014) NEVT,NERR,(TEXT(I,JR),I=1,3)
      IF (IOLD.GT.0) WRITE (6,1020) IOLD
      IF (IKATA.GT.0) WRITE (6,1026) IKATA
C     CALL BLOC(IJOBC,'JOBC',0,&20005)
C     IF (JR.EQ.1) CALL JOBCFI(-NEVT)
C     IF (JR.NE.1) CALL JOBCFI(NEVT)
C0005 CONTINUE
      CALL PUNFIN
      IF (SPEC.GT.0) WRITE (6,1022) SPEC
      IF (PRSH) CALL RUNE
      IUCLS=0
      GOTO 200
      ENTRY LSBCLS(I29)
      IUCLS=I29
200   CALL BMLT(0,BLA)
      IF (.NOT.LSBW) GOTO 210
      IF (IUCLS.EQ.0.OR.IUCLS.EQ.9) CALL BWRITE(9)
210   CONTINUE
      IF (.NOT.DAW) GOTO 220
      INIW=0
      IF (IUCLS.EQ.0.OR.IUCLS.EQ.2) CALL BWRS(2,NTOT,INIW)
      IF (INIW.EQ.0) GOTO 220
      CALL LSTPOP(NREC,&220)
      CALL FWRTDB(2,NREC,NTOT,IW(INIW))
220   CONTINUE
      GOTO 100
C
C
      ENTRY SKRUN
C
      IF (PRHD) WRITE (6,1012) LRUN
      SKIP=.TRUE.
      GOTO 100
C
C
      ENTRY SKREST
C
      JR=6
      END=.TRUE.
      GOTO 100
C
C
      ENTRY SEQWRT
C
      SEQWC=.TRUE.
      GOTO 100
C
C
      ENTRY DAWRT
C
      DAWRTC=.TRUE.
      GOTO 100
C
C
      ENTRY SEQNOW
C
      SEQWC=.FALSE.
      GOTO 100
C
C
      ENTRY DANOW
C
      DAWRTC=.FALSE.
      GOTO 100
C
C
      ENTRY LSBWRT
C
      LSBWC=.TRUE.
      GOTO 100
C
C
      ENTRY LSBNOW
C
      LSBWC=.FALSE.
      GOTO 100
C
C               GOREC          GOBEG
100   RETURN
C               RUNBEGINN      ENDE
101   RETURN 1
C               EVENT          NAECHSTER RUN
102   RETURN 2
C               RUNENDE
C
C
1002  FORMAT (' -------- READING MONTE CARLO EVENTS')
1004  FORMAT (' -------- READING FROM DIRECT-ACCESS-DATASET')
1006  FORMAT (' -------- RUN',I8,' ENDED',I11,'EVENTS')
1008  FORMAT (' -------- RUN',I8,' STARTED  H0 = ',F7.3,
     1'  CP = ',E12.4,'  EBEAM = ',F10.3)
1010  FORMAT (' -------- RUN',I8,' SKIPPED EXIT',I2,' FROM GETRUN')
1012  FORMAT (' -------- RUN',I8,' SKIPPED(USER)')
1014  FORMAT (' -------- TOTAL',I10,' EVENTS',I4,' READ ERRORS',
     14X,'REASON FOR END IS ',3A4)
1018  FORMAT (' -------- RECORD  1 UNTIL',I8,' HAVE BEEN SKIPPED')
1020  FORMAT (' -------- NUMBER OF EVENTS WITH OLD DATAFORMAT',I7)
1022  FORMAT (' -------- NUMBER OF SPECIAL RECORDS',I7)
1024  FORMAT (' -------- GOREC  FATAL DATA ERROR  INIR',I10)
1026  FORMAT (' -------- NUMBER OF DATA ERRORS WITH UNKNOWN FORMAT',I7)
 1028 FORMAT(' --------   END READING FROM UNIT',I3,/,
     1      ' -------- START READING FROM UNIT',I3)
      END
      SUBROUTINE FWRTDB(IUN,NREC,LREC,IW)
      DEFINE FILE 2 (20000,1610,U,LX)
      INTEGER IW(LREC)
      WRITE (IUN'NREC,END=101,ERR=102)  IW
      RETURN
  101 WRITE (6,110)
      RETURN
  102 WRITE (6,111)
      RETURN
  110 FORMAT(' ATTEMPT TO WRITE PAST EOF ON UNIT 2')
  111 FORMAT(' WRITE ERROR ON UNIT 2')
      END
