C   27/03/97 703271227  MEMBER NAME  JEOSUM1  (JMC.S)       FVS
C   27/03/97 703271158  MEMBER NAME  $HISTORY (JMC.S)       FVS
         JMC.S HISTORY
         =============  (THE EARLIER HISTORY IS FOUND IN $HISTOR0)

-----------------------------------------------------------------------I
I  A LARGE NUMBER OF CHANGES INTRODUCED, AFFECTING THE TRACKING,       I
I  SMEARING AND TRIGGER SIMULATION. FOR DETAILS, SEE                   I
I           JADE COMPUTER NOTE 66                                      I
I----------------------------------------------------------------------I
16-08-83 BLDAT         CORRECTION OF SOME GEOMETRICAL AND
                       PHYSICAL PROPERTIES
16-08-83 EVTINI        SUBROUTINE DAY2 NOW CALLED HERE ONCE PER
                       EVENT AND NOT FOR EVERY PARTICLE IN SUBROTINE
                       JIPATR.COMMON / CDAY / INTRODUCED
16-08-83 JIPATR        SUBROUTINE DAY2 NOW CALLED ONLY ONCE PER EVENT
                       IN SUBROUTINE EVTINI. COMMON / CDAY / INTRODUCED
16-08-83 JINIT         CHANGED RADIUS S OF RADIAL SYMMETRIC ELECTRIC
                       FIELD AROUND SIGNAL WIRES
16-08-83 RDRDMH        RANDOM HITS OUTSIDE CELLS ARE NOW NOT POSSIBLE.
                       MAXIMUM DRIFTSPACE DRIMAX FOR EACH RING
                       SET IN A DATA STATEMENT.
17-08-83 RDMTCO        CHANGED WITH INTRODUCTION OF NEW COMMON /CTRIGG/
                       CALL TO RDTRIG AND RDHEAD IN RDJETC PART. LOGICAL
                       ERROR IN RDTRG SEQUENCE THEREBY CORRECTED.
                       SEVERAL OTHER CHANGES IN DETAILS.
17-08-83 RDTRIG        CHANGED VERSION OF RDTRG, DOES NOT CALL RDTRG1,2
                       INCLUDES TRIGGER VERSION OF 1982 AS DEFAULT. NEW
                       COMMON /CTRIGG/ INTRODUCED.
17-08-83 RDHEAD        CALLED IN RDJETC BEFORE RDTRIG. SAVES HEAD WORDS
                       6-8 (DATE) INTO HEAD WORDS 96-98.
17-08-83 RDTRG1        CHANGED TO CALL RD82T1 FOR 1982 AND LATER. A BUG
                       IN TOF WIDE COPLANAR TRIGGER CORRECTED.
17-08-83 RDTRG2        CHANGED TO CALL RD82T2 FOR 1982 AND LATER. A BUG
                       IN T2 COPLANARITY SIMULATION CORRECTED.
17-08-83 RDRESO        CHANGED TO PERFORM THE NEW SMEARING SCHEME,
                       SEE JADE COMPUTER NOTE 66.
18-08-83 MUCONW        OLD VERSION REJECTED, BECAUSE THE MACRO 'F22ALL.
                       JADEMUS(CMUEDWRK) WAS MISSING TO DIMENSION THE
                       TWO ARRAYS 'HLOC' AND 'HUPDAT'. NOW THE STANDARD
                       VERSION OF MUCONW ON 'F22ALL.JADEMUS' IS USED.
19-08-83 RDMTCO        SMALL CHANGE TO THE TP FUDGE PART
23-08-83 MUCONW        MUCONW IS IDENTICAL TO THE F22ALL.JADEMUS VERSION
                       IT IS NOW DELETED, LINK F22ALL.JADEMUL INSTEAD.
23-08-83 RDMTCO        PRINT UPDATED.
23-08-83 EVREAD        NO TEST ON IREADM VARIABLE FOR CALL TO RDMTCO
23-08-83 EVWRIT        COMPLETE UPDATE FOR MTCO BANK WRITING
23-08-83 RDDATE        SET DATE OF APRIL 1982 IN HEAD BANK
23-08-83 RDTRIG        BLOCK DATA FOR IHIST NOW APRIL 1982
23-08-83 #COPY         FAST READ AND WRITE BOS PROGRAM FOR COPY WITHOUT
                       SMEARING. ORIGINAL VERSION FROM E.ELSEN.
23-08-83 JOBINFO       TEXT MEMBER FOR INFORMATION ON VARIOUS JCL.
23-08-83 RDPETERS      DELETED, SINCE OUTDATED
23-08-83 TEXT          DELETED, SINCE OUTDATED
25-08-83 EVTINI        COMMON /CWSET/ INCREASED TO ALLOW 4000 JETC HITS
25-08-83 JSPOIN        COMMON /CWSET/ INCREASED TO ALLOW 4000 JETC HITS
25-08-83 JIPATR        COMMON /CWORK/ CHANGED TO ALLOW 400 HITS/TRACK
                       IN HLIST. THIS ARRAY ONLY HOLDS THE HITS FOR THE
                       CURRENT TRACK NOW. ARRAY POINTERS THUS SIMPLIFIED
25-08-83 TRCDET        COMMON /CWORK/ CHANGED AS ABOVE. CALLS JHITIN
                       (AS BEFORE) BUT NOW HAS AN ALTERNATIVE RETURN
                       IF 4000 JETC HITS EXCEEDED.
25-08-83 JRING         COMMON /CWORK/ CHANGED AS ABOVE. NEW COMMON
                       /C4VHIT/ ADDED ALONG WITH CODE TO STORE THE
                       ASSOCIATION OF 4 VECTOR TRACKS WITH JETC HITS.
                       SOME EXISTING CODE SIMPLIFIED.(STAGE 1)
25-08-83 JHITIN        COMMON /CWORK/ CHANGED AS ABOVE. NEW COMMON
                       /C4VHIT/ ADDED ALONG WITH CODE TO STORE THE
                       ASSOCIATION OF 4 VECTOR TRACKS WITH JETC HITS
                       AFTER THE HITS ARE SORTED. ALTERNATIVE RETURN
                       OCCURS IF MORE THAN 4000 HITS WERE TO BE ADDED
                       TO HITAR ARRAY BY EXECUTING THIS ROUTINE.
25-08-83 WRTMCB        COMMON /C4VHIT/ ADDED AND CODE TO CREATE THE
                       NEW 'HITL' BANK (NUMBER 8). S/R MVCL CALLED
                       TO COPY THE BYTES INTO BOS STORAGE AS S/R MVC
                       DOES NOT WORK PROPERLY. OLD 'HEAD' POINTER
                       SYSTEM REMOVED.
27-08-83 BRVECT        NEW VERSION WITH EXPANDED /CPROD/ COMMON.
                       IT NOW CALLS STPALL AFTER STVECT TO PRODUCE
                       THE 'PALL' BANK (CONTAINING ALL MC PARTICLES).
27-08-83 STVECT        NEW VERSION WITH EXPANDED /CPROD/ COMMON.
27-08-83 STPALL        NEW ROUTINE LIKE STVECT BUT CREATES THE 'PALL'
                       BANK FROM INFORMATION IN /CPROD/.
30-08-83 MCJADE,JGETEV CHANGED TO MAKE A CORRECT EVENT COUNT. ALSO
                       CHANGED SO THAT BY PRIVATE CHANGE OF PARAMETERS
                       IEVMIN AND IEVMAX IN JGETEV IT IS POSSIBLE TO
                       TRACK ONLY A SELECTED SECTION ON THE INPUT FILE,
                       E.G. EVENTS 201 - 400.
01-10-83 JHITIN        COMMENT CHANGED. FOR A GIVEN WIRE IN JETC BANK,
                       THE HITS ARE STORED IN ORDER OF DECREASING DRIFT
                       TIME. THE CODE WAS RIGHT BUT THE COMMENT WAS NOT.
04-10-83 RDMERG        MODIFIED TO HANDLE THE NEW 4V PARTICLE/JETC HIT
                       ASSOCIATION INFORMATION IN THE 'HITL' BANK.
                       STAGE 2
04-10-83 RDDOUB        MODIFIED AS FOR RDMERG
04-10-83 RDPOIN        MODIFIED AS FOR RDMERG
04-10-83 RDMODN        MODIFIED AS FOR RDMERG. CREATES NEW 'HTSL' BANK
                       WHICH ASSOCIATES THE UNSMEARED HITS WITH THE
                       SMEARED HITS.
04-10-83 MCTR4V        THIS NEW ROUTINE CREATES THE 'TR4V' BANK
                       WHICH STORES THE 4 VECTOR PARTICLE ORIGIN OF
                       EVERY 'PATR' TRACK  - STAGE 3
06-10-83 RDTRIG        TO CURE OVERLAY PRINT PROBLEM, LOCAL PRINT
                       IS NOW STEERED FROM COMMON /CPRIPR/, BLOCK DATA
                       SET IN RDTRIG.    J.O.
06-10-83 RDMTCO        ENTRY RDJETC CHANGED TO INCLUDE CREATION OF
                       UNSMEARED 'JETC'/9 BANK BEFORE CALL TO RDRESO.
06-10-83 RDMODN        'JETC'/9 CREATION CODE DELETED (NOW IN RDJETC)
06-10-83 MCTR4V        CORRECTED VERSION REPLACED EARLIER VERSION.
                       ALSO MCTR4V HAS 2 ARGUMENTS NOW TO HANDLE ERRORS
                       AND STEER ROUTINE WHEN A 'TR4V' BANK ALREADY
                       EXISTS.
13-10-83 @TPMAIN1      CORRECTED VERSION OF @TPMAIN, WITH CORRECT
                       HANDLING OF CONSTANTS RECORDS. CORRESPONDING JCL
                       IN MEMBER #TPMAIN1.         J.OLSSON
13-10-83 RDDOUB        BUG CORRECTED IN CASE WHERE SEVERAL HITS ARE LOST
                       IN DOUBLE HIT CUT.
17-10-83 RDDOUB        ABSORBED HITS NOW HAVE A NEGATIVE POINTER TO THE
                       SMEARED HITS THAT ABSORBED THEM.
17-10-83 RDPOIN        HANDLES THE NEGATIVE POINTER DESCRIBED ABOVE.
17-10-83 MCTR4V        HANDLES THE NEGATIVE POINTER DESCRIBED ABOVE.
                       THIS ROUTINE WILL PROBABLY BE MOVED TO JADEGS/L.
17-10-83 RDMTCO        THE GENERATION OF JETC/9 IS NOW CONDITIONAL ON
                       THE VALUE OF VARIABLE IJETCI, IN /CADMIN/
                       ALSO /CBINMC/ HAS BEEN ADDED.
17-10-83 EVREAD        VARIABLE IJETCI ADDED IN /CADMIN/ BLOCK DATA. IT
                       STEARS THE GENERATION OF JETC/9 IN RDMTCO.
17-10-83 TRCOIL        ERROR PRINT INSTALLED TO TRAP NEGATIVE SQRT.
18-10-83 @TPMAIN       OLD VERSION SCRATCHED, @TPMAIN1 RENAMED. THE JCL
                       MEMBER #TPMAINC CHANGED ACCORDINGLY.
18-10-83 BLDAT         UPDATED WITH MACROS CGEO2,CGEO3. CHANGED CJDRCH
                       AND CGEO1 INTO USE OF MACROS. UPDATED CJTRIG.
18-10-83 CPROD         THE MACRO WAS INTRODUCED AND CHANGED TO DIMENSION
         STPALL        500,300. BRVECT AND STVECT CHANGED TO USE MACRO
  BRVECT,STVECT        STPALL CHANGED TO THESE DIMENSIONS, NOT JET MACRO
 #RCPROD,GENMU,GENEE   ALSO #RCPROD,GENMU AND GENEE CHANGED ACCORDINGLY.
18-10-83 RDMTCOGS      THESE MEMBERS CONTAIN ALL ROUTINES FOR SMEARING
         RDTRIGGS      AND TRIGGER SIMULATION. THEY ARE INTENDED FOR USE
                       ON JADEGS,JADEGL; TOGETHER WITH RDDATE THEY MAKE
                       A FAST COPY OF ALL THE ROUTINES POSSIBLE.
                       THUS ANY CHANGE TO SMEAR AND TRIGGER SIMULATION
                       ROUTINES SHOULD BE DUPLICATED IN THESE MEMBERS.
19-10-83 MCTR4V        DELETED,AS IT WILL NOW RESIDE ON F11LHO.JADEGS/L
19-10-83 RDDATE        SMEARING MONTH CHANGED TO MAY.
19-10-83 CPROD         CPROD CHANGED BACK TO NATURAL ARRAY TYPES
         BRVECT        AND THE OTHER ROUTINES MODIFIED ACCORDINGLY
         STVECT        INCLUDING LOCAL ARRAY EQUIVALENCE WITH CPROD.
         STPALL        ALSO COMMENTING IMPROVED.
20-10-83 EVREAD,EVWRIT DELETED AFTER LIBRARY RENAMING, NOW ON JADEGS,GL
         TPINITX       DELETED AFTER LIBRARY RENAMING, NOW ON TPSOURCE,L
         #TPMAINC      CHANGED REFERENCE F22ELS.JMC.S1 TO JMC.S
20-10-83 CPROD         IPHI AND ITHETA CHANGED TO PHI AND THETA
         BRVECT         "    "     "      "     "  "   "    "
         STVECT        IPHI EQUIVALENCED TO PHI. ITHETA EQUIV. THETA
         STPALL         "         "       "  "     "      "      "
20-10-83 TRCOIL        NEGATIVE SQRT ERROR CORRECTED, NOW RETURN1 J.O.
24-10-83 RDRESO        IN THE OLD VERSION THERE WERE CASES WHERE FOR
                       HITS NEAR WIRE PLANE THE SMEARED DRIFTTIME GOT
                       NEGATIVE. NOW ONLY POSITIVE DRIFTTIMES ARE
                       POSSIBLE.
25-10-83 #TPMAINC      MISPRINTS CORRECTED (UNIT=FAST <-> DISP=SHR)
25-10-83 WRTMCB        ERROR CORRECTED. 'PALL' HAS TO BE PUT INTO THE
                       SPECIAL LIST FOR THE FIRST EVENT AS THE LIST IS
                       CLEARED IN ORDER TO OUTPUT THE CALIBRATION.
25-10-83 MCNEWS        NEWS UPDATED.
26-10-83 MCJADE,TRCOIL SMALL ERRORS CORRECTED IN THESE ROUTINES.
 TRCDET,JPRABS,MCNEWS
26-10-83 WRTMCB        ERROR RETURN (IN PALL CORRECTION ABOVE) CORRECTED
27-10-83 STPALL,MCNEWS IFLAVR  ==> IABS( IFLAVR ) ; MCNEWS FORMAT NICER
28-10-83 #TPMAINC      NAME CHANGE: F11LHO.TAGGING.L -> F11LHO.TAGG.L
28-10-83 TRCOIL        TYPING ERROR FROM 26.10 CORRECTED, CAUSE
                       OF DIVIDE CHECK IN TRLGL...     W.BARTEL,J.OLSSON
28-10-83 TRLGL         REMOVE MUONS INTERACTING IN LEAD GLASS W.BARTEL
28-10-83 #TPMAINC      SUBR. DUMMY INCLUDED AGAIN,CALLED BY TPSPRV
31-10-83 @TPMAIN       THE CALL TO BSAW, WITH THE LIST OF OUTPUT BANKS,
                       REINSTALLED AGAIN. IT IS NECESSARY, SINCE BSAW IS
                       NOT CALLED AT CREATION OF TPTR,TPVX,TPEV...
31-10-83 @TPMAIN       COMMENTING ALTERED TO CONFORM WITH TPSOURCE
                       VERSION IN ORDER TO MAKE COMPARISONS EASIER.
10-11-83 #TPMAINC      DUMMY AND @TPMAIN REMOVED - FORMER IS DEAD
                       WHILE THE LATTER IS CALLED AS A LOAD MODULE.
10-11-83 #PRODMU       DNAGLIB IN LKED.SYSLIB NOW
10-11-83 WRTMCB        BSAW CALLED FOR 'MUCH' AND 'MUHC' BANKS
14-11-83 RD-ROUTINES   THEY WERE SCRATCHED FROM JMC.S AND JMC.L, SINCE
 SCRATCHED WERE:       THEY ARE KEPT ON JADEGS,JADEGL. ON JADEGS, THEY
 RDMTCO,RDRESO,RDRDMH, ARE FOUND IN THE MEMBERS RDMTCO,RDTRG1,RDTRG2,
 RDPOIN,RDPATR,RDMODN, RDTRIG,RDDATE,RDHEAD.
 RDDDCL,RDINEF,RDDOUB,   THE SCRATCHED MEMBERS ARE STILL PRESENT ON THE
 RDMERG,RDALGN,RDDATE,   BACKUP F22ELS.ZZ.JMC.S.B831114
 RDHEAD,RDTRG1,RDTRG2,
 RDTRIG.
15-11-83 BRVECT0       OLD VERSION SCRATCHED
18-11-83 TOFMAK        LONG STANDING MISTAKE CORRECTED IN BANK DESCR.
DEC   83 #MCJADE,BLDAT,GENEE,GENMU,JELOSS,JGETEV,JGETVC,MCJADE,TRLGL,
         TRKGAM
                       KANZAKI ENERGY LOSS IN LEAD GLASS
                       TRACKING OF NEUTRONS AND K0L
                       3 DIM SHOWER FOR E/GAM (OPTIONAL, USE LFLAG(4))
                       BREMSSTRAHLUNG LOSS WITH EYGES EQUATION
                       START/STOP EVENT SET THROUGH /CIEV/
06-02-84 MCJADE        USES NEW JADEBD BLOCK DATA
         JGETEV        SMALL COUNTING ERROR CORRECTED
         MCVALI        IMPROVED ROUTINE. DOES NOT REJECT EVENTS WITH LOW
                       ENERGY PHOTONS (< 200 MEV) THAT ARE E/P/M WRONG.
         #PRODMU       NOW HAS ALL NECESSARY DATE/SEEDING CODE
         #MCJADE       BROUGHT UP TO DATE
09-02-84 BLDAT         SCRATCHED
09-02-84 JMULSC        NEW VERSION IMPLEMENTED FROM F22HAG.MCARL
16-02-84 MCVALI        PTOT=EBEAM NOW LEGAL
27-02-84 MCVALI        NO INPUT CHECKING FOR PARTONS AT ALL NOW.
28-02-84 MCVALI        .LT. ==> .LE. FOR TEST 9
28-02-84 MCVSUM        CORRECT PRINTOUT
25-03-84 MCREDU        BETTER VERSION FROM F22ELS.CS11 IMPLEMENTED
11-05-84 #MCJADE       CERN.KERNLIB4 UPDATE  J.O.
12-10-84 MCVALI        BEAM ENERGY TEST UPPER LIMIT NOW 32.767 GEV
                       BECAUSE HEAD BANK STORES EBEAM IN SIGNED I*2 WORD
12-10-84 MOST JOBS     CERN.KERNLIB4 UPDATE   C.B.
09-11-84 JTRNTR        IMPROVED VERSION FROM K-H.H (K DECAY BETTER)
         TRCDET           "        "      "    "    "   "      "
         TRKADC        NEW ROUTINE FROM K-H.H FOR K DECAY
06-11-85 MCTAG-ROUTINES   COPIED FOLLOWING ROUTINES FROM
                       F22FIN.MCTAG.S :    (ACC. TO J.C.N.  86)
      MCTAGI,MCTAGM,MCTAGB,MCTAGC,MCTAGS,MCTAGR,MCTAGF,MCTAGE,NINT
         IN ADDITION, EVTINI AND STATAG AND MCJADE WERE COPIED INTO
         MEMBERS EVTINI1,STATAG1 AND MCJADE1
         JOB MEMBER #MCJADE1 ALSO INSTALLED.
         THE LATTER 4 SHOULD BE RENAMED INTO THE STANDARD MEMBERS WHEN
         THE CHANGEOVER TAKES PLACE (7.11.85 OR LATER)    J.O.
07-11-85    THE ABOVE MENTIONED RENAMING WAS DONE. IN ADDITION, THE
         SUBROUTINE TAGS2H WAS COPIED FROM F11LHO.TAGG.S, IN ORDER
         TO PREVENT COLLAPS OF JOBS WHICH STILL HAS THE OLD JCL, WITHOUT
         LINKING F11LHO.TAGG.L, WHICH IS NOW REQUIRED. AFTER SOME TIME
         TAGS2H SHOULD BE DELETED FROM JMC.S AND JMC.L    J.O.
15-02-86    INSTALMENT OF TRKGAM9 AND STHEAD9, IN PREPARATION FOR THE
         CORRECTION OF PHOTON TRACKING ERROR, DESCRIBED IN JCN 87. J.O.
15-03-86    INSTALMENT OF TRKGMV9, IN PREPARATION FOR JCN 87   J.O.
06-06-86    INSTALMENT OF WEGAS (SAME AS VEGAS IN TRLGSH)
            WEGAS IS COMMON FOR THE SF5 (TRLGSH) AND SF6 (TRLGS6)
            INSTALMENT OF LIMINT, ALSO A COMMON ROUTINE OF TRLGSH AND
            TRLGS6.  FURTHER TRLGL9 INSTALLED TO ACCOUNT FOR BRANCHING
            BETWEEN THE 2 VERSIONS OF TRLGSH/6.  UNDER THE NAME OF
            TRLGS5, TRLGSH HAS VEGAS AND LIMINT REMOVED, CALL TO WEGAS
            INTRODUCED. BOTH TRLGS5 AND TRLGS6 HAVE FUNCTION ELSMR REMO-
            VED, SINCE IT IS IDENTICAL TO FUNCTION ELSMR IN TRLGL. THE
            BLOCKDATA FOR LFLAG HAS ALSO BEEN REMOVED IN BOTH VERSIONS,
            SINCE ANOTHER BLOCK DATA ALREADY EXISTS AND ANY EXPLICIT
            STATEMENT OVERRIDES THE BLOCK DATA. #MCJADE HAS A WRITTEN
            COMMENT THAT LFLAG(4)=.TRUE. SHOULD ALSO HAVE LFLAG(2)=.TRUE
                                          J.OLSSON / N.MAGNUSSEN
09-06-86    MCJADE CHANGED TO INSURE LFLAG(2) TRUE IF LFLAG(4) TRUE J.O.
10-06-86      PREPARATION FOR TURN OVER TO HAGEMANN VERSION OF TRACKING.
            INSTALLED NEW VERSIONS: EVTINI9,JCHAMB9,JINIT9,JPRABS9,
                                    JPRFRE9,JPRTHI9,JPRTLO9,JRCHCK9,
                                    JRING9,JSTEP9,JTRAPZ9,MCJADE9,
                                    MCMAIN9,MCNEWS9,TRCDET9,WRTMCB9
                                    JTRKGM9
            INSTALLED NEW MEMBERS: JFTEST,JVDTIM,JVTXCH,TRCDTV,#MCJADEM
                                   #MCPAIR
            REMOVED BLOCK DATA IN TRLGKA, UPDATED $JOBINFO,#MCJADE
 TURN OVER:  0-VERSIONS OF ALL 9 VERSIONS ABOVE INSTALLED, ALSO TRLGSH0
            STHEAD0, TRKGAM0 AND TRLGL0
            RENAMED ALL 9-VERSIONS TO STANDARD, TRLGS5 TO TRLGSH
             HOPE IT IS ALL DONE CORRECTLY!       J.OLSSON
11-06-86    TRKGAM,TRKGMV: CORRECTED RADIATION LENGTHS  J. HAGEMANN
11-06-86    STHEAD  SETTING OF HEAD WORD 17              J. OLSSON
11-06-86    TRLGS6,TRLGSH PRINT STATEMENTS COMMENTED OUT  J. OLSSON
11-06-86    MCJADE: T.O. LIMIT DEPENDS ON LFLAG(4)        J. OLSSON
02-07-86    TRLGSH: BUG, KILLING ALL PHOTONS, REMOVED     J. OLSSON
03-07-86    TRLGSH,TRLGS6  RATIO ESEEN/ENERGY ERROR CORR. J. OLSSON
17-07-86    STLATC UPDATED VERSION ADDED                  J. HAGEMANN
17-07-86    TRLGSH AND TRLGS6 WERE CORRECTED FOR 2 BUGS: POSITION
            VECTOR FOR ENDCAP PHOTONS AND ELECTRONS IS NOW UPDATED.
            PREVIOUSLY NO UPDATE, LEADING TO DOUBLE TRACKING OF THESE
            PARTICLES. ALSO THE SCALING OF BLOCK ENERGIES DUE TO READ-
            OUT THRESHOLD HAS BEEN REMOVED.          J.OLSSON
04-09-86    TRLGSHE INSTALLED FOR TEST PURPOSE, WITH OLD ERRORS  J.O.
            TRLGLE INSTALLED FOR TEST PURPOSE  J.O.
            UPDATED TRLGSH AND TRLGS6 ENDCAP POSVECTOR WITH 20 % EXTRA
            TO AVOID PRECISION PROBLEM IN TRLGL CUTS   J.OLSSON
15-09-86    CORRECT BUG IN MCVALI (EL.MASS .000551)  J.O./U.SCHNEEKL.
19-01-87    TRLGSH AND TRLGS6 UPDATED, WITH NEW VALUES OF THE INTERNAL
            PARAMETERS FACMC AND FNORM. THESE ARE PROBABLY NOT FINAL
            VALUES, EXTENSIVE STUDIES AT VARIOUS ENERGIES ARE STILL
            NEEDED. SHOULD BE OK FOR ORDINARY USE, THOUGH
                                       J.OLSSON  AND  N.MAGNUSSEN
30-01-87    TRLGS6 WITH THE FUNCTION SF65 WAS CORRECTED, AFTER A NEG.
            ARGUMENT APPEARED IN ALOG. THIS SHOULD BE VERY RARE, IF
            NOT IMPOSSIBLE. A DEBUG PRINT HAVE ALSO BEEN INTRODUCED,
                                       J.OLSSON  AND  N.MAGNUSSEN
02-02-87    SIMILAR UPDATE OF FUNC. SF56        J.O.  N.M.
             ( THE TRLGS6 FROM 30.1 KEPT AS TRLGS61 )
10-02-87    UPDATE OF MCTAGF, ACC. TO WISHES FROM A.FINCH
            OLD VERSION KEPT AS MCTAGF0                     J.O.
12-02-87    SIGN CORRECTION IN SF65,TRLGS6            N.M.(J.O.)
01-04-87    INCREASE DIMENSION LISTBL BLCFRC IN TRLGS6,TRLGSH
                                                      D.P. J.O.
13-04-87    TRLGS6,TRLGSH CHANGED: BLCFRC CORRECTED BY AVGSUM, IN ORDER
            TO KEEP RESOLUTION                        D.P. J.O.
02-05-87    TRLGS6,TRLGSH CHANGED: PROTECT AGAINST DIVIDE CHECK FOR THE
            CASE THAT AVGSUM = 0.                          J.O.
07-05-87    TRLGS6 FORMAT ERRORS CORRECTED           C.B,J.O.
10-05-87    PRINT STATEMENT IN TRKGMV COMMENTED OUT      J.O.
10-09-87    CORRECTED BUG IN STATAG      P.HILL, J.OLSSON
09-11-87    DATEMC NOW SETS DATE ACCORDING TO TODAY. E ELSEN
18-12-87    DATEMC PRODUCES CURRENT TIME AS BEFORE
            STHEAD CHANGED TO LOG PRODUCTION DATE AND
            CONFIGURATION DATE                       E ELSEN
21-12-87    REMOVED MULTIPLE VERSIONS OF DATEMC.
            NO DIFFERENECE FOR THE USER.             E ELSEN
22-12-87    UPDATED NVERT ACCORDING TO SPEC FROM C.KLEINWORT   J.O.
20-01-88    MCJADE NOW CALLS JBWTOR, ENABLES OPERATOR TO STOP LONG JOBS
            J.O. AND A. WEGENER
31-01-88    SOME MINOR BUGS AND INCONSISTENCIES WERE CHANGED IN THE
            FOLLOWING ROUTINES:   MCTAGM9, MCTAGB9, MCTAGR9, MCTAGS9
            THE STANDARD VERSIONS ARE NOT YET CHANGED, AND THE NEW ONES
            HAVE TO BE INCLUDED. THE TAGGING EFFICIENCY CHANGES BY C:A
            + 5 %, WHEN USING THE CORRECTED VERSIONS.
            THE NEW VERSIONS SHOULD BE CHECKED BY THE TAGGING EXPERTS,
            BEFORE THEY ARE MADE STANDARD.             J.OLSSON
16-04-88    INSTALLED MCTAGB8: ALEX FINCH PROVIDED IT TO ACCOUNT FOR
            THE WRONG DIMENSION OF MARKIII TAGGER. TEST VERSION!  J.O.
02-03-89    RENAMED MCTAGR, MCTAGS AND MCTAGB TO 0-VERSIONS.
            RENAMED MCTAGR9 AND MCTAGS9 TO STANDARD VERSIONS. SEE NOTE
            ABOVE (01/88) ON ERRORS IN THESE ROUTINES. RENAMED MCTAGB8
            TO STANDARD VERSION.  MCTAGB9 TO BE FORGOTTEN.
            MCTAGM WAS UPDATED (X0 FOR MARK III). MCTAGM9 ALSO TO BE
            FORGOTTEN. FOR PROPER HANDLING OF EDGE EFFECTS, USE GEANT MC
            BY CHRIS HOWARTH INSTEAD.                      J.O.
06-03-89    UPDATE MCTAGM: PV-VECTOR IS NOW UPDATED TO 0., FOR CASES
            OF HITTING TAGGER.
            UPDATE MCTAGB LANGUAGE TO FORTRAN IV, WAS F-77.   J.O.

C   27/03/97 703271158  MEMBER NAME  $HISTOR0 (JMC.S)       FVS
         JMC.S HISTORY     (8.1980   -   7.1982)
         =============

19-08-80 EVTINI     INITS FWD COMMON CGGRAW
19-08-80 INIFWD     DUMMY VERSION ON JMC.L
19-08-80 FWDDET     DUMMY VERSION ON JMC.L
19-08-80 WRTMCB     ATAG BANKS WRITTEN NOW
21-08-80 STATAG     CREATES ARRAY FOR ATAG BANK, CALLED IN WRTMCB

21-08-80 MCJADE     COMMON /CJTRLE/ CHANGED
21-08-80 TRCDET     COMMON /CJTRLE/ CHANGED + ADDITIONS
21-08-80 PRJABS     COMMON /CJTRLE/ CHANGED + ADDITIONS

22-08-80 TRKGAM     TOF TRACK LENGTH CORRECTED

22-08-80 COORD      COPIED FROM 'F22HOW.MCGAMGAM.S'
22-08-80 GGBLNO     COPIED FROM 'F22HOW.MCGAMGAM.S'

25-08-80 FWDDET     VERSION FROM 'F22HOW.MCGAMGAM.S(FWDDET)'
25-08-80 RDSTAT     NEW
25-08-80 RDTRG1     CREATES LATC NOW.

22-02-81 STALGN     EXTENDED FOR ADDITIONAL FLAG HANDLING

06-05-81 MCNEWS     CALLED IN MCJADE TO PRINT NEWS

08-05-81 LGINIT     CALLED IN MCJADE
08-05-81 TRLGL      NEW VERSION INCORPORATING O'NEILL'S SHOWER CALCULA.
                    THE ROUTINE REFERENCES OTHER NEW ROUTINES
08-05-81 JINIT      LGINIT, MUTRAK, INIFWD CALL FROM MCJADE NOW HERE
26-05-81 RDMTCO     JETC RANDOM HITS EVEN IF NO JETC BANK IN RAW EVENT
26-05-81 RDMODN     JETC RANDOM HITS EVEN IF NO JETC BANK IN RAW EVENT

13-11-81 JSTEP      MADE SAVE AGAINST MAG FILED < 0
13-11-81 JIPATR     MADE SAVE AGAINST MAG FILED < 0
13-11-81 BLDAT      BKGAUS NEGATIVE

19-11-81 BLDAT      XRCOIL ETC.
19-11-81 RDMESS         NEW VERSIONS OF RD-ROUTINES
19-11-81 RDMTCO         MAIN CHANGE IS INTRODUCTION OF
19-11-81 RDSTAT         NEW COLLINEAR TRIGGER FOR 1981
19-11-81 RDSTAT0179
19-11-81 RDSTAT0180
19-11-81 RDSTAT0280
19-11-81 RDSTAT0181
19-11-81 RDTRG1
19-11-81 RDTRG2
19-11-81 RDALGN        NEW ROUTINE TO LG-READOUT THRESHOLD

04-01-82 RDALGN        ERROR IN POINTER SETTING CORRCTED

04-02-82 MCJADE        TYPE < -100 NOT TRACKED

                       FOLLOWING ROUTINES NEW OR CHANGED TO
15-02-82 BRVECT        ALLOW FOR SECOND VECT BANK AND LATER
15-02-82 EVTINI        EXTENSIONS.
15-02-82 GENEE
15-02-82 JCHAMB
15-02-82 JELOSS
15-02-82 JGETEV
15-02-82 JGETVC
15-02-82 JPRABS
15-02-82 JRCHCK
15-02-82 JRING
15-02-82 JTRAPZ
15-02-82 JTRKGM
15-02-82 MCJADE
15-02-82 MCNEWS
15-02-82 STHEAD
15-02-82 STVECT
15-02-82 SVECT1
15-02-82 TRCDET
15-02-82 WRTMCB

15-02-82 JTRKGM        CONVERTED GAMMAS STILL DEPOSITED ENERGY DIRECTLY

                       THE FOLLOWING CHANGES ARE RELATED TO MAKING
                       THE SCHEME COMPATIBLE TO NEW MUON MONTE CARLO.
13-05-82 MUASOR        SCRATCHED
13-05-82 MUCONE        SCRATCHED
13-05-82 MUDEDX        SCRATCHED
13-05-82 MUENDP        SCRATCHED
13-05-82 MUERRZ        SCRATCHED
13-05-82 MUINIT        SCRATCHED
13-05-82 MUINTA        SCRATCHED
13-05-82 MULTSC        SCRATCHED
13-05-82 MUMATR        SCRATCHED
13-05-82 MUMESZ        SCRATCHED
13-05-82 MUPIDK        SCRATCHED
13-05-82 MUROT         SCRATCHED
13-05-82 MURTNE        SCRATCHED
13-05-82 MUSCAT        SCRATCHED
13-05-82 MUSIG         SCRATCHED
13-05-82 MUSTEP        SCRATCHED
13-05-82 MUSTOR        SCRATCHED
13-05-82 MUTRAK        SCRATCHED
13-05-82 MUYOKE        SCRATCHED
13-05-82 MUZERO        SCRATCHED
13-05-82 MUCONM        DUMMY VERSION NOW
13-05-82 MUMIPR        DUMMY VERSION NOW
13-05-82 MUORDR        DUMMY VERSION NOW
13-05-82 MUMESS        ATTACHED TO MUCONM
13-05-82 MUERRY        ATTACHED TO MUCONM
13-05-82 MCJADE        CHANGED TO ALLOW FOR MUON CALLS
13-05-82 EVTINI        CALLS TO MU ROUTINES REMOVED
13-05-82 JINIT         CALLS TO MU ROUTINES REMOVED
13-05-82 WRTMCB        MUCONW CALL INTRODUCED
13-05-82 MUCONW        COPIED FROM F22ALL.JADEMUS

13-05-82 RDMTCO        RDTRG CALL INTRODUCED
13-05-82 RDTRG1        CALLED IN RDTRG NOW
13-05-82 RDTRG2        NOW CALLED IN RDTRG
13-05-82 RDTRG         PICKS UP TRIGGER STATUS ACCORDING TO HEAD-DATE

03-06-82 TRCDET        PCUT BEFORE PIKDEC CALL INTRODUCED

21-07-82 WRTMCB        ZET-CHAMBER NOW WRITTEN
-----------------------------------------------------------------------I
I  THE CONTINUATION OF THE HISTORY FOLLOWS IN $HISTORY                 I
I----------------------------------------------------------------------I
C   27/03/97 703271158  MEMBER NAME  $JOBINFO (JMC.S)       FVS
***********************************************************************
*                                                                     *
*   INFORMATION ABOUT VARIOUS JCL MEMBER ON F22ELS.JMC.S              *
*                                                                     *
***********************************************************************

#COPY:          FAST READ AND WRITE PROGRAM FOR THE COPY OF BOS EVENTS
                WITHOUT SMEARING, ETC.

#JBLKMP         THIS JOB USES MEMBER MCMAIN TO MAKE A LINKING OF THE
                TRACKING PROGRAM.  THE LKED OUTPUT IS STORED ON A DISK-
                FILE WHICH CAN BE USED BY THE GRAPHICS PROGRAM LKEDXREF,
                TO PRODUCE LINK-TREES, SEARCH FOR CALLS, ETC.

#MCMUMU         THIS JOB CREATES 4-VECTORS FOR E+E- ---> MU+ MU- AND
                TRACKS THEM THROUGH DETECTOR. THESE EVENTS ARE USEFUL
                FOR RESOLUTION STUDIES. THE ROUTINE GENMU IS USED.

#MCPAIR         THIS JOB CREATES 4-VECTORS FOR E+E- ---> MU+ MU-,
                E+ E-, PI+ PI-  ETC. ANDTRACKS THEM THROUGH DETECTOR.
                THESE EVENTS ARE USEFUL FOR RESOLUTION STUDIES.
                THE ROUTINES GENMU OR GENEE ARE USED.

#MCJADE         GENERAL TRACKING JOB, USING THE ROUTINE MCJADE. THE JOB
                CONTAINS SEVERAL OPTIONS FOR INPUT AND OUTPUT AND IS A
                MERGED COMBINATION OF THE PREVIOUS JOB-MEMBERS #PROCT
                AND #PRCTJOB.

#MCJADEM        GENERAL TRACKING JOB, USING THE ROUTINE MCJADE. THE JOB
                CONTAINS SEVERAL OPTIONS FOR INPUT AND OUTPUT AND IS
                SIMILAR TO THE PREVIOUS #MCJADE BUT WITH MUON TRACKING.

#PRODUCT        SPECIAL VERSION OF THE PREVIOUS #MCJADE, USING AN EXTRA
                COPY STEP TO MOVE 4-VECTOR EVENTS TO A TEMPORARY DISK-
                FILE, THEN TRACK IN A SECOND STEP AND WRITE OUTPUT DATA
                ON A TAPE.

#PRODMU         PROGRAM TO USE THE GENERAL MUON FILTER TRACKING PROGRAM.
                THE JCL IS SIMILAR TO THE PREVIOUS #PRODUCT. IT HAS BEEN
                UPDATED TO NOT USE THE OUTDATED ASTART0, ASTART1 FILES.

#RCPROD         PROGRAM TO READ AND WRITE 4-VECTOR EVENTS IN THE CPROD-
                FORMAT.

                                               LAST UPDATE 10.06.1986
C   27/03/97 703271158  MEMBER NAME  #JBLKMP  (JMC.S)       FVS
//F11BAR   JOB MSGLEVEL=(1,0),CLASS=E,TIME=(0,10)
//*MAIN RELPRI=MED,ORG=EXT,LINES=(2)
//LKTREE EXEC LKED,PARM.LKED='MAP,LIST,XREF'
//SYSPRINT DD UNIT=FAST,DSN=F11BAR.MCLOAD,
// DCB=(BLKSIZE=968,LRECL=121,RECFM=FBA),
// DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(20,5),RLSE)
//LKED.SYSLIB DD DSN=F11BAR.JMC.L,DISP=SHR
//            DD DSN=JADELG.LOAD,DISP=SHR
//            DD DSN=F11LHO.JADEGL,DISP=SHR
//            DD DSN=F22ALL.JADEMUL,DISP=SHR
//IPSLOADS DD DSN=R02SCH.TSOIPS.LOAD,DISP=SHR
 INCLUDE SYSLIB(MCMAIN)
 ENTRY MAIN
//
C   27/03/97 703271158  MEMBER NAME  #MCJADE  (JMC.S)       FVS
//F22ELS   JOB          CLASS=E,MSGLEVEL=(2,0),TIME=(0,15)
//*MAIN RELPRI=HIG
//*
//**********************************************************************
//*                                                                    *
//*         M C J A D E   TRACKING JOB  (WITHOUT MUON TRACKING)        *
//*                                                                    *
//*         THIS JOB USES CERN STYLE JCL                               *
//*                                                                    *
//*            NEW VERSION OF TAGGING TRACKING INSTALLED               *
//*             DETAILS, SEE J.C.N. 86, BY A. FINCH                    *
//*                                                                    *
//**********************************************************************
//*
//TRACK EXEC FORTCG,CPRM=XL,LPRM='LIST,NOMAP',GRGN=550K
//*
//C.SYSIN DD *
C-----------------------------------------------------------------------
      COMMON / BCS / IW(33000)
C
      LOGICAL*1  LFLAG
      COMMON/CFLAG/LFLAG(10)
C
C          LFLAG(1) = SMEAR GAMMA AND ELECTRON ENERGIES
C          LFLAG(2) = GAMMA CONVERSION IN OUTER TANK AND COIL (TRKGAM)
C          LFLAG(3) = ABSORPTION LOSSES
C          LFLAG(4) = 3 DIM SHOWER PROFILE FIT TO EGGS CODE SLOW!!!!!
C          LFLAG(5) = .TRUE.   -->  WITH VERTEX CHAMBER TRACKING
C                   = .FALSE.  -->  WITHOUT VERTEX CHAMBER TRACKING
C                                   BUT OLD BEAM PIPE GEOMETRY AND
C                                 BEAM PIPE COUNTERS (BEFORE MAI 84)
C
C                     ===> DEFAULT .TRUE.,.FALSE.,.TRUE.,.FALSE.,.FALSE.
C
      COMMON / CIEVS  / KIEV,IEVMIN,IEVMAX
C
C          IEVMIN = FIRST EVENT TO BE READ FROM INPUT FILE
C          IEVMAX = LAST  EVENT TO BE READ FROM INPUT FILE
C
C                   ==== > DEFAULT IEVMIN = 1
C                                  IEVMAX = 9999999
C
      INTEGER*2 HDATE
      COMMON /TODAY/ HDATE(6)
C
      HDATE(1) = 1
      HDATE(2) = 1
      HDATE(3) = 1
      HDATE(4) = 1
      HDATE(5) = 5
      HDATE(6) = 1985
C
      CALL BINT( 33000,10000, 500, 0 )
      CALL MCJADE( 0, 10 )
      CALL BSTA
      CALL PALL
      STOP
      END
//G.SYSLIB DD DSN=SYS1.FORTLIB,DISP=SHR
//         DD DSN=DESYLIB,DISP=SHR
//         DD DSN=F22ELS.JMC.L,DISP=SHR,UNIT=FAST,VOL=SER=STOR05
//         DD DSN=F11LHO.TAGG.L,DISP=SHR,UNIT=FAST,VOL=SER=STOR05
//         DD DSN=JADELG.LOAD,DISP=SHR,UNIT=FAST,VOL=SER=STOR05
//         DD DSN=F22ALL.JADEMUL,DISP=SHR,UNIT=FAST,VOL=SER=STOR05
//         DD DSN=F11LHO.JADEGL,DISP=SHR,UNIT=FAST,VOL=SER=STOR05
//         DD DSN=R01UTL.CERN.KERNLIB4,DISP=SHR
//         DD DSN=F1EBLO.BOSLIB.L,DISP=SHR
//*
//* UNIT3  INPUT:    4-VECTOR EVENTS IN THE CPROD-FORMAT
//*
//G.FT03F001 DD DISP=SHR,
//        DSN=F22HAG.FAST.VEC4.B436.T180D
//*G.FT03F001 DD DISP=OLD,UNIT=TAPE,
//*       DSN=F22PET.TRIJET.GBD2
//*
//* UNIT2  OUTPUT:    JADE EVENTS IN BOS FORMAT
//*
//G.FT02F001 DD DISP=(NEW,CATLG,CATLG),UNIT=FAST,DCB=R01DCB.VBS,
//       DSN=F11OLS.TESTNWMD,SPACE=(TRK,(20,10),RLSE)
//*G.FT02F001 DD DISP=(NEW,CATLG,DELETE),DCB=R01DCB.VBS,
//*    DSN=F11OLS.XXXXXX.YYYYYY,
//*         MSVGP=VTMP,UNIT=3330V
//*G.FT02F001 DD DUMMY
//*G.FT02F001 DD UNIT=TAPE,DISP=(,CATLG,DELETE),
//*        DCB=R01DCB.VBS,
//*        DSN=F22ELS.T2TRIJET.GBD2
C   27/03/97 703271158  MEMBER NAME  #MCJADEM (JMC.S)       FVS
//         JOB          CLASS=A,MSGLEVEL=(2,0),TIME=(1,00)
//*MAIN RELPRI=MED
//*
//**********************************************************************
//*                                                                    *
//*         M C J A D E M   TRACKING JOB  (WITH MUON TRACKING)         *
//*                                                                    *
//*         THIS JOB USES CERN STYLE JCL                               *
//*                                                                    *
//*            NEW VERSION OF TAGGING TRACKING INSTALLED               *
//*             DETAILS, SEE J.C.N. 86, BY A. FINCH                    *
//*                                                                    *
//**********************************************************************
//*
//TRACK EXEC FORTCG,CPRM=XL,LPRM='LIST,NOMAP',GRGN=912K
//*
//C.SYSIN DD *
C-----------------------------------------------------------------------
      IMPLICIT INTEGER*2 (H)
C
      COMMON / TODAY / HDATE(6)
      COMMON / BCS / IW(33000)
C
      LOGICAL*1  LFLAG
      COMMON / CFLAG / LFLAG(10)
C
C          LFLAG(1) = SMEAR GAMMA AND ELECTRON ENERGIES
C          LFLAG(2) = GAMMA CONVERSION IN OUTER TANK AND COIL (TRKGAM)
C          LFLAG(3) = ABSORPTION LOSSES
C          LFLAG(4) = 3 DIM SHOWER PROFILE FIT TO EGGS CODE (SLOW !!!!)
C          LFLAG(5) = .TRUE.   -->  WITH VERTEX CHAMBER TRACKING
C                   = .FALSE.  -->  WITHOUT VERTEX CHAMBER TRACKING
C                                   BUT OLD BEAM PIPE GEOMETRY AND
C                                 BEAM PIPE COUNTERS (BEFORE MAI 84)
C
C                     ===> DEFAULT .TRUE.,.FALSE.,.TRUE.,.FALSE.,.FALSE.
C
      COMMON / CIEVS  / KIEV,IEVMIN,IEVMAX
C
C          IEVMIN = FIRST EVENT TO BE READ FROM INPUT FILE
C          IEVMAX = LAST  EVENT TO BE READ FROM INPUT FILE
C                   ==== > DEFAULF IEVMIN = 1
C                          IEVMAX = 9999999
C
C
C                  SET DATE AND TIME OF RUN  - 12 NOON ON 1ST MAY 1981
C                  ALSO SET MUON RANDOM NUMBER GENERATOR USING MUSEED
C                  WITH ANY INTEGER (DIFFERENT FOR EACH JOB).
C
      HDATE(1)=1
      HDATE(2)=1
      HDATE(3)=1
      HDATE(4)=1
      HDATE(5)=5
      HDATE(6)=1985
C
      CALL BINT( 33000,10000,100,100)
C                                               SEED GENERATOR
      CALL MUSEED(301)
C                            COMMENTED TO USE OLD HARDWARE
CCC   LFLAG(5) = .TRUE.
C
      CALL MCJADE(0,5)
      CALL BSTA
      CALL PALL
      STOP
      END
//G.SYSLIB DD DSN=SYS1.FORTLIB,DISP=SHR
//         DD DSN=DESYLIB,DISP=SHR
//         DD DSN=F22RJB.RLMC.L,DISP=SHR
//         DD DSN=F22ELS.JMC.L,DISP=SHR
//         DD DSN=F11LHO.JADEGL,DISP=SHR
//         DD DSN=JADELG.LOAD,DISP=SHR
//         DD DSN=F22ALL.JADEMUL,DISP=SHR
//         DD DSN=R01UTL.CERN.KERNLIB4,DISP=SHR
//         DD DSN=SYS1.NAGLIB,DISP=SHR,UNIT=FAST
//         DD DSN=SYS1.DNAGLIB,DISP=SHR,UNIT=FAST
//         DD DSN=F1EBLO.BOSLIB.L,DISP=SHR
//         DD DSN=F11LHO.TAGG.L,DISP=SHR
//*
//* UNIT3  INPUT:    4-VECTOR EVENTS IN THE CPROD-FORMAT
//*
//*G.FT03F001 DD DISP=SHR,
//*        DSN=F22MIN.LUNBVECT.GGG44.NORAD.FAST200
//*G.FT03F001 DD DISP=OLD,UNIT=TAPE,
//*       DSN=F22PET.TRIJET.GBD2
//*
//* UNIT2  OUTPUT:    JADE EVENTS IN BOS FORMAT
//*
//*G.FT02F001 DD DISP=(NEW,CATLG,CATLG),UNIT=FAST,DCB=R01DCB.VBS,
//*       DSN=F22ELS.XXXXYYYY,SPACE=(TRK,(80,10),RLSE)
//*G.FT02F001 DD DISP=(NEW,CATLG,DELETE),DCB=R01DCB.VBS,
//*    DSN=F11OLS.XXXXXX.YYYYYY,
//*         MSVGP=VTMP,UNIT=3330V
//*G.FT02F001 DD DUMMY
//*G.FT02F001 DD UNIT=TAPE,DISP=(,CATLG,DELETE),
//*        DCB=R01DCB.VBS,
//*        DSN=F22ELS.T2TRIJET.GBD2
//*                 CONSTANTS
//G.FT22F001 DD UNIT=FAST,DISP=SHR,DSN=F11LHO.AUPDAT1
//* 13/01/88 902131934  MEMBER NAME  #MCJGEAN (S)           JCL
//*
//*        JOB: JADE MC WITH GEANT
//*
//F11OLS    JOB CLASS=K,TIME=(02,00),MSGLEVEL=(2,0),NOTIFY=F22CPH
//*
//*MAIN RELPRI=HIG
//*                              SIEMENS FORTRAN 77:
//  EXEC JFORTCG,GRGN=2200K,
//*                     GRGN=2000K NOT SUFFICIENT 16.12.87
//*                                      UP TO 15 LOAD-LIBS
//       LLB1='F22CPH.GEANT.L',
//       LLB2='F22ELS.JMC.L',
//       LLB3='JADELG.LOAD',
//       LLB4='F22ALL.JADEMUL',
//       LLB5='F11LHO.JADEGL',
//       LLB6='F1EBLO.BOSLIB.L',
//       LLB7='DESYLIB',
//       LLB8='R01UTL.CERN.DLIBF77',
//       LLB9='R01UTL.CERN.PACKF77'
C
      IMPLICIT INTEGER*2 (H)

      COMMON / BCS / IW (40000)

      LOGICAL  LDEBUG
      COMMON / CDEBUG / LDEBUG

      CHARACTER*80 DATIN,DATOUT
C
      LOGICAL*1  LFLAG
      COMMON / CFLAG / LFLAG (10)
C
C        LFLAG(1) = SMEAR GAMMA AND ELECTRON ENERGIES (TRLGL)
C                   SET = .TRUE. TO AVOID SMEARING IN TP-STEP
C        LFLAG(2) = GAMMA CONVERSION IN OUTER TANK AND COIL (TRKGAM)
C                   SET = .TRUE.
C        LFLAG(3) = ABSORPTION LOSSES = .TRUE.
C        LFLAG(4) = 3 DIM SHOWER PROFILE FIT TO EGS CODE, SLOW!!!!!
C        LFLAG(5) = .TRUE.   -->  WITH VERTEX CHAMBER TRACKING
C                 = .FALSE.  -->  WITHOUT VERTEX CHAMBER TRACKING
C                                 BUT OLD BEAM PIPE GEOMETRY AND
C                                 BEAM PIPE COUNTERS (BEFORE MAI 84)
C        LFLAG(6) = TOKYO-MC, NOT AVAILABLE
C        LFLAG(7) = GEANT LG TRACKING FOR HADRONS, NOT RECOMMENDED
C
      COMMON / CIEVS  / KIEV,IEVMIN,IEVMAX
C
C     IEVMIN = FIRST EVENT TO BE READ FROM INPUT FILE
C     IEVMAX = LAST  EVENT TO BE READ FROM INPUT FILE
C
      COMMON / TODAY / HDATE (6)
C ---                     DATE = SEC,MIN,HOUR,DAY,MON,YEAR
      HDATE(1) = 1
      HDATE(2) = 1
      HDATE(3) = 1
      HDATE(4) = 14
      HDATE(5) = 7
      HDATE(6) = 1986

      LFLAG(1) = .TRUE.
      LFLAG(2) = .TRUE.
      LFLAG(3) = .TRUE.
      LFLAG(4) = .FALSE.
      LFLAG(5) = .TRUE.
      LFLAG(6) = .FALSE.
C
      INQUIRE ( UNIT=3, NAME=DATIN  )
      INQUIRE ( UNIT=2, NAME=DATOUT )
      PRINT 31, DATIN, DATOUT
  31  FORMAT(//1X,'INPUT  : ',A80/1X,'OUTPUT : ',A80//)

C---                             FIRST AND LAST EVENT # TO BE TRACKED
      IEVMIN =    1
      IEVMAX =    1
CCC   IEVMAX =   999999

CCC   LDEBUG = .TRUE.
      LDEBUG = .FALSE.

      PRINT 32, IEVMIN, IEVMAX
 32   FORMAT ( /T2, 'FIRST AND LAST EVENT # TO BE TRACKED: ',2I8 / )

C---                                BOS-INITIALIZATION:
      CALL BINT( 40000,10000, 500, 0 )

C---                           GEANT-MC-JADE:
      CALL MCJADE ( 0,  5 )
C---                           BOS-STATISTICS:
      CALL BSTA
C---
      CALL PALL


      END
C   25/11/83 902091216  MEMBER NAME  MCJADE   (S)           FORTRAN
C
C-----------------------------------------------------------------------
      SUBROUTINE MCJADE( NREVS, IPRINT )
C-----------------------------------------------------------------------
C
C   AUTHOR:   E. ELSEN    11/05/79 :  MC TRACKING PROGRAM
C
C      MOD  E. ELSEN    10/06/82 :
C      MOD  J. OLSSON   30/08/83 :  SUBSET TRACKED & EVENT COUNTING
C      MOD  W. BARTEL   25/10/83 :  PARTICLES BEYOND COIL NOT TRACKED
C      MOD  C. BOWDERY  17/11/83 :  CALL TO MCVSUM FOR ERROR SUMMARY
C      MOD  C. BOWDERY  24/11/83 :  DELETE CALL TO TRCOIL FOR PHOTONS
C      MOD  W. BARTEL   29/11/83 :  IEVMIN/MAX (/CIEVS/) DEFLT. IN BLDAT
C      MOD  W. BARTEL   29/11/83 :  INTRODUCE N AND K0L TRACKING
C      MOD  W. BARTEL   29/11/83 :  EXTERNAL JADEBD  INSTEAD OF BLDAT
C      MOD  J. HAGEMANN 28/08/84 :  VERTEX CHAMBER TRACKING FACILITY
C           R. RAMCKE               IMPLEMENTED
C      MOD  J. HAGEMANN 19/04/86 :  FWDDET REPLACED BY MCTAGM
C      MOD  J.OLSSON    09/06/86 :  LFLAG(2) IS TRUE IF LFLAG(4) IS TRUE
C      MOD  J.OLSSON    11/06/86 :  NSEC T.O. LIMIT DEPENDS ON LFLAG(4)
C LAST MOD  J.O, A.WEG. 20/01/88 :  JBWTOR INSTALLED FOR OPERATOR STOP
C
C    ALLOWS SECTIONS OF THE INPUT FILE TO BE TRACKED.
C    MINIMUM AND MAXIMUM NR OF EVENT SET IN SUBR. JGETEV
C    EVENT COUNT PASSED VIA /CIEVS/ KIEV,IEVMIN,IEVMAX
C
C    WRITE NREVS MTC EVENTS ON UNIT 2. TAKE INPUT FOUR VECTORS
C    FROM ROUTINE JGETVC.
C    IF NREVS .EQ. 0, EVENTS ARE WRITTEN UNTIL EOF OR TIME OUT.
C    INPUT FOUR VECTORS FOR THE FIRST IPRINT ARE PRINTED.
C
C-----------------------------------------------------------------------
C
      IMPLICIT INTEGER*2 (H)
C                                      JADE BLOCK DATA IS NOW JADEBD
      EXTERNAL JADEBD
C
      COMMON / CJTCDC / IBANK, IPART
      COMMON / CIEVS  / KIEV,IEVMIN,IEVMAX
      COMMON / CGEO1  / BKGAUS, RPIP,DRPIP,XRLPIP, RBPC,DRBPC,XRLBPC,
     *                  RITNK,DRITNK,XRLTKI, R0ROH,DR0ROH,XR0ROH,
     *                  R1ROH,DR1ROH,XR1ROH, R2ROH,DR2ROH,XR2ROH,
     *                  R3ROH,DR3ROH,XR3ROH, ROTNK,DROTNK,XRLTKO,
     *                  RTOF,DRTOF,XRTOF, RCOIL, DRCOIL, XRCOIL,
     *                  ZJM,DZJM,XRZJM, ZJP,DZJP,XRZJP,
     *                  ZTKM,DZTKM,XRZTKM, ZTKP,DZTKP,XRZTKP,
     *                  ZBPPL,ZBPMI,ZTOFPL,ZTOFMI,
     *                  XRJETC,
     *                  RLG,ZLGPL,ZLGMI,OUTR2,CTLIMP,CTLIMM,DELFI,
     *                  BLXY,BLZ,BLDEP,ZENDPL,ZENDMI,DEPEND,
     *                  XHOL1,XHOL2,YHOL1,YHOL2
C
      DIMENSION PV(10),R0(5),RR(5)
      DIMENSION PVSAVE(10),R0SAVE(3)
C
      DATA NSEC / 4 /
      DATA NUNIT / 2 /
C
      LOGICAL*1 LFLAG
      COMMON/CFLAG/LFLAG(10)
C
C        LFLAG(1) = SMEAR GAMMA AND ELECTRON ENERGIES
C        LFLAG(2) = GAMMA CONVERSION IN OUTER TANK AND COIL (TRKGAM)
C        LFLAG(3) = ABSORPTION LOSSES
C        LFLAG(4) = 3 DIM SHOWER PROFILE FIT TO EGGS CODE
C        LFLAG(5) = .TRUE.   -->  WITH VERTEX CHAMBER TRACKING
C                 = .FALSE.  -->  WITHOUT VERTEX CHAMBER TRACKING
C                                 BUT OLD BEAM PIPE GEOMETRY AND
C                                 BEAM PIPE COUNTERS (BEFORE MAI 84)
C
      INTEGER*2 HDATE
      COMMON /TODAY/ HDATE(6)
C
C------------------  C O D E  ------------------------------------------
C
C                                           PRINT NEWS
      CALL MCNEWS
C
C     ***** JBWTOR ENABLE OPERATOR TO CANCEL IN ORDERED FASHION *****
C             INITIALIZE
C
      CALL JBWTOR(&2727)
      GO TO 2728
C
2727  WRITE(6,2729)
2729  FORMAT(/,'========== JBWTOR INIT ERROR =======')
2728  CONTINUE
C
C
C   LFLAG(2) MUST BE TRUE IF MEIER/MAGNUSSEN LG TRACKING IS USED
C
      IF(LFLAG(4).AND..NOT.LFLAG(2)) WRITE(6,681)
681   FORMAT(' ### WARNING ###  LFLAG(2) SET TRUE, SINCE LFLAG(4) TRUE')
      IF(LFLAG(4).AND..NOT.LFLAG(2)) LFLAG(2) = .TRUE.
C IF 3-D EGS CODE IS USED, LARGER TIME OUT LIMIT IS NEEDED
      IF(LFLAG(4)) NSEC = 6
C
C  LFLAG(5) MUST BE TRUE IF VERTEX CHAMBER GEOMETRY IS USED
C
      IF(LFLAG(5).AND.(HDATE(6).GT.1984.OR.
     $   (HDATE(6).EQ.1984.AND.HDATE(5).GE.5))) GO TO 692
      IF(.NOT.LFLAG(5).AND.(HDATE(6).LT.1984.OR.
     $   (HDATE(6).EQ.1984.AND.HDATE(5).LT.5))) GO TO 692
      IF(HDATE(6).GT.1984.OR.
     $   (HDATE(6).EQ.1984.AND.HDATE(5).GE.5)) LFLAG(5) = .TRUE.
      IF(HDATE(6).LT.1984.OR.
     $   (HDATE(6).EQ.1984.AND.HDATE(5).LT.5)) LFLAG(5) = .FALSE.
      WRITE(6,691)
691   FORMAT('  #####  WARNING ####  LFLAG(5) HAS BEEN SWITCHED TO AGREE
     $ WITH COMMON /TODAY/ SETTING OF DETECTOR HARDWARE')
692   CONTINUE
C                                           INPUT OF MUCHAMBER CALIBRATI
      CALL MUCONM
C
C                                           INITIALIZE PROGRAM
 2200 NEVTS = NREVS
      IF( NEVTS .EQ. 0 ) NEVTS = 999999
C
      IWRT = 0
      CALL BWRO( NUNIT, 1558, 2 )
      CALL JINIT
C
      CALL GEANTI
C
      IF(LFLAG(4)) WRITE(6,111)
  111 FORMAT(//,1X,'***********************************************',/,
     *          1X,'* LEAD GLASS SIMULATION IS DONE USING         *',/,
     *          1X,'*        F11MEI.MCSHOWS(TRLG3)                *',/,
     *          1X,'*                                             *',/,
     *          1X,'* CONTAINING :                                *',/,
     *          1X,'*                                             *',/,
     *          1X,'*     - EM. SHOWERS FROM INTEGRATION OVER     *',/,
     *          1X,'*       3 DIM SHOWER FUNCTION FOR PARTICLES   *',/,
     *          1X,'*       ABOVE 100 MEV                         *',/,
     *          1X,'*     - STANDARD EM-SHOWER PROCEDURE FOR      *',/,
     *          1X,'*       FOR LOW ENERGY PARTICLES              *',/,
     *          1X,'*     - HADRON INTERACTION USING THE KANZAKI  *',/,
     *          1X,'*       SCHEME BASED ON THE KEK MEASURMENTS   *',/,
     *          1X,'*       LIGHT GUIDES ARE INCLUDED FOR BARREL  *',/,
     *          1X,'*                                             *',/,
     *          1X,'*                           VERSION 20/09/83  *',/,
     *          1X,'***********************************************',//)
C
      IF(LFLAG(5)) WRITE(6,112)
  112 FORMAT(///,4X,'***********************************************',/,
     *           4X,'* -> V E R T E X  C H A M B E R  TRACKING <-  *',/,
     *           4X,'*               SWITCHED  O N                 *',/,
     *           4X,'*                           VERSION 28/08/84  *',/,
     *           4X,'***********************************************',/)
C
      DO 1001 IEV=1,NEVTS
C
C TEST FOR OPERATOR STOP
C
      CALL JBWTOR(&92)
C
      IF( JUHR(NSEC) .NE.50 ) GO TO 1011
      IF( JUHR(NSEC) .NE.50 ) GO TO 1011
      GO TO 90
C                                           INITIALISE EVENT
1011  CALL EVTINI
      IJETCP = 0
      IFWHIT = 0
      IPRI = 1
      IF( IWRT .GT. IPRINT-1 ) IPRI= 0
C                                           GET EVENT
      CALL JGETEV( &91 )
C
 1002 CONTINUE
C                                           NEXT PARTICLE
      CALL JGETVC( PV, R0, ICODE, IPRI )
      IF( ICODE .GT. 0 ) GO TO 1003
C
C                                           CHECK TIME FOR PARTICLES
C                                           NECESSARY IF MUONS INCLUDED
      IF( JUHR(NSEC) .NE.50 ) GO TO 1012
      IF( JUHR(NSEC) .NE.50 ) GO TO 1012
      KIEV = KIEV - 1
      GO TO 90
C
C     DON'T TRACK PARTICLES WHICH START ONLY BEYOND THE COIL OR
C     THE END CAP LEAD GLASS ARRAY
C                                   OCT. 25. 1983 W.BARTEL
C
1012  R4 = SQRT( R0(1)*R0(1) + R0(2)*R0(2) )
      IF( R4 .GT. RCOIL) GO TO 1000
      IF( ABS(R0(3)) .GT. ZENDPL) GO TO 1000
C
C                                           FWD TRACKING
CCC   CALL FWDDET( PV, R0, IFWHIT )
      CALL MCTAGM( PV, R0)
C                                           BRANCH ACCORDING
C                                           TO CHARGE OF PARTICLE
C                                           PHOTONS
      IF( PV(7) .EQ. 0. .AND. PV(8).LT.2.) GO TO 3
C                                           BRANCH OFF K0L AND N
      IF( PV(7) .EQ. 0. .AND. ABS(PV(8)-5.) . LT. 1.E-5) GO TO 4
      IF( PV(7) .EQ. 0. .AND. ABS(PV(8)-6.) . LT. 1.E-5) GO TO 4
C
C***********************************************************************
C                                           CHECK IF VERTEX CHAMBER
C                                           TRACKING IS WANTED
      IF( .NOT. LFLAG(5) )  CALL TRCDET(PV,R0,RR,&1004)
      IF(  LFLAG(5) )  CALL TRCDTV(PV,R0,RR,&1004)
C***********************************************************************
C
      IF( PV(6) .LT. .001 ) GO TO 1000
C
      CALL TRCOIL(PV,RR,&992 )
  992 R0(1) = RR(1)
      R0(2) = RR(2)
      R0(3) = RR(3)
      GO TO 996
C
C                                           TRACK PHOTONS
    3 CALL JTRKGM(PV,R0,&1000)
      GO TO 996
C                                           TRACK K0L , N
    4 CALL JTRNTR(PV,R0,&1000)
C                                           SAVE VECTORS
  996 R0SAVE(1) = R0(1)
      R0SAVE(2) = R0(2)
      R0SAVE(3) = R0(3)
      DO 995 ISA = 1,10
  995 PVSAVE(ISA) = PV(ISA)
C                                           LEAD GLASS
      CALL TRLGL(PV,R0,&997)
C
  997 CONTINUE
C
  998 IF( PV(6) .LT. .001 ) GO TO 1000
      CALL MURTNE(PVSAVE,R0SAVE)
      GO TO 1000
C
 1004 IF( IJETCP .GT. 0 ) GO TO 1000
      IJETCP = 1
      WRITE(6,151) IEV, IPART
  151 FORMAT(5X,' TOO MANY JET-CHAMBER HITS AT EVENT',I5,' TRACK',I4)
      GO TO 1000
C
C
 1000 CONTINUE
      GO TO 1002
C
 1003 CONTINUE
C
C***********************************************************************
C                                           SORT VERTEX CHAMBER HITS
      IF( LFLAG(5) ) CALL JSTORE
C***********************************************************************
      CALL JSPOIN
      CALL ORDLG
      CALL MUORDR
      CALL TOFMAK
      CALL WRTMCB( NUNIT )
      IWRT = IWRT + 1
C
 1001 CONTINUE
C                                           NO MORE EVENTS REQUESTED
C
      WRITE(6,9105)
 9105 FORMAT(/' --  END OF REQUESTED DATA  --')
      GO TO 91
C
C
C                                          OPERATOR STOP
C
   92 CONTINUE
      WRITE(6,9102)
 9102 FORMAT(/'======== OPERATOR STOP=========')
      GO TO 91
C
C
C                                           TIME OUT
C
   90 CONTINUE
      WRITE(6,9101)
 9101 FORMAT(/' ========= TIME OUT =========')
C
C                                           END OF DATA
   91 CONTINUE
      CALL BMLT( 0, DUMMY )
      CALL BWRITE( NUNIT )
C
C                                           PRINT INPUT ERROR SUMMARY
C
      CALL MCVSUM
C
      ILAST = IEVMIN + KIEV - 1
      WRITE(6,109) NEVTS, IEVMIN,ILAST,KIEV, IWRT
  109 FORMAT(//1X,I6,' EVENT(S) REQUESTED TO BE TRACKED.'/
     +  1X,I6,' IS RECORD NO. OF FIRST REQUESTED EVT FROM INPUT FILE.'/
     +  1X,I6,' IS RECORD NO. OF LAST EVENT READ FROM INPUT FILE.'/
     +  1X,I6,' EVENT(S) READ FROM THE INPUT FILE.'/
     +  1X,I6,' EVENT(S) WRITTEN OUT.'//)
      RETURN
      END
      SUBROUTINE GUOUT
C=======================================================================
C.
C.    *
C.    *       User routine called at the end of each event
C.    *
C.
      INTEGER*2 HGG

      COMMON/GCFLAG/IDEBUG,IDEMIN,IDEMAX,ITEST,IDRUN,IDEVT,IEORUN
     +        ,IEOTRI,IEVENT,ISWIT(10),IFINIT(20),NEVENT,NRNDM(2)
      COMMON/GCTRAK/VECT(7),GETOT,GEKIN,VOUT(7),NMEC,LMEC(30),NAMEC(30)
     + ,NSTEP ,MAXNST,DESTEP,SAFETY,SLENG ,STEP  ,SNEXT ,SFIELD,SNPHYS
     + ,TOFG  ,GEKRAT,IGNEXT,INWVOL,ISTOP ,IDECAD,IEKBIN
C
      COMMON /GCVOLU/ NLEVEL, NAMES(15), NUMBER(15),
     + LVOLUM(15),LINDEX(15),GTRAN(3,15),GRMAT(10,15),
     + NGPAR(15),GPAR(50,15),GONLY(15),GLX(3),
     + NJNEXT(2),JNEXT(15),INEXT(15),NNEXT(15)
C
      COMMON / GENPAR / WEIT(3),CNORM(3)
      COMMON / CEBLOK / EBLOCK(16,3)
C
#include "cmctag.for"
C
CC    CALL TVNEXT
CC    CALL GDRAWC( 'TAGS', 3,-300., 10., 10., 0.3, 0.3)
CC    CALL GDXYZ(0)
C                      Z-X-VIEW THROUGH WHOLE VOLUME
CC    CALL TVNEXT
CC    CALL GDRAWC ( 'TAGS', 2, 0.0, 10.0, 10.0, 0.025,0.2)
CC    CALL GDXYZ(0)
CC    CALL TVEND
C                      Z-X-VIEW THROUGH WHOLE VOLUME
CC    CALL TVNEXT
CC    CALL GDRVOL (2,NAMES,NUMBER,0,90.0,0.,0.0,10.0,10.0,0.025,0.2)
CC    CALL GDXYZ(0)
CC    CALL TVEND
C
      MARKMC = 3
      WRITE(6,*) '  '
      ETOTAL=0.0
      DO 10 ISEG=1,16
         DO 20 IRING=1,3
C
C---AZIMUTHAL PARAMETRISATION OF ENERGY RESPONSE
C
            CALL AZIRES(ISEG,IRING)
C
C---SMEAR THE ENERGIES
            CALL RANNOR(GRAN1,GRAN2)
            ESMEAR=GRAN1*.024*CNORM(IRING)
            EBLOCK(ISEG,IRING)=EBLOCK(ISEG,IRING)+ESMEAR
            WRITE(6,8001) ESMEAR,EBLOCK(ISEG,IRING)
 8001       FORMAT(1X,'ESMEAR ',F8.4,' EBLOCK ',F8.4)
C
C---NORMALISE AND WEIGHT THE ENERGIES
            EBLOCK(ISEG,IRING) =
     &           WEIT(IRING)*EBLOCK(ISEG,IRING)
            WRITE(6,8002) WEIT(IRING),CNORM(IRING),EBLOCK(ISEG,IRING)
 8002       FORMAT(1X,' WEIT ',F8.4,' CNORM ',F8.4,' EBLOCK ',F8.4)
C
C---CALCULATE TOTAL ENERGY DEPOSITED IN CALORIMETER
            ETOTAL=ETOTAL+EBLOCK(ISEG,IRING)
            WRITE(6,8003) ETOTAL
 8003       FORMAT(1X,' ETOTAL ',F8.4)
C
C---FILL IN HGG ARRAY ACCORDING TO STANDARD MARK III FORM
C   NOTE THE ARRAY CONSISTS OF ENERGIES
C
C--- -Z END
         IF(ISEG.GT.8) THEN
      IF(IRING.EQ.1) HGG(ISEG+3)=1000.*EBLOCK(ISEG,IRING)
      IF(IRING.EQ.2) HGG(ISEG+19)=1000.*EBLOCK(ISEG,IRING)
      IF(IRING.EQ.3) HGG(ISEG+35)=1000.*EBLOCK(ISEG,IRING)
C--- +Z END
         ELSE
            IOFF=+4
            IF(ISEG.GT.4) IOFF=-4
      IF(IRING.EQ.1) HGG(ISEG+IOFF+51)=1000.*EBLOCK(ISEG+IOFF,IRING)
      IF(IRING.EQ.2) HGG(ISEG+IOFF+67)=1000.*EBLOCK(ISEG+IOFF,IRING)
      IF(IRING.EQ.3) HGG(ISEG+IOFF+83)=1000.*EBLOCK(ISEG+IOFF,IRING)
         ENDIF
 20      CONTINUE
 10   CONTINUE
      WRITE(6,8004) (HGG(I),I=1,192)
 8004 FORMAT(18(11(I6,1X)/))
      RETURN
      END
C***********************************************************************
C SUBROUTINE TO MODIFY RECORDED ENERGY ACCORDING TO AN AZIMUTHAL
C PARAMETRISATION
C
      SUBROUTINE AZIRES(ISEG,IRING)
C
      COMMON / CEBLOK / EBLOCK(16,3)
      COMMON / PATDAT / PATVEC (10), PATPOS (3)
      COMMON / AZIPAR / AZIFIT
      PI=3.14159
C
C---CALCULATE INCIDENT PHI ANGLE
C
      PHI=ATAN(ABS(PATVEC(2)/PATVEC(1)))
      IF(PATVEC(1).LT.0.AND.PATVEC(2).GT.0) PHI=PI-PHI
      IF(PATVEC(1).LT.0.AND.PATVEC(2).LT.0) PHI=PI+PHI
      IF(PATVEC(1).GT.0.AND.PATVEC(2).LT.0) PHI=2*PI-PHI
C
      WRITE(6,8001) PATVEC(1),PATVEC(2),PHI
 8001 FORMAT(1X,'PX ',F8.4,' PY ',F8.4,' PHI ',F8.4)
      WRITE(6,8012) ISEG,IRING
 8012 FORMAT(1X,'ISEG ',I2,' IRING ',I2)
C
C---CONVERT TO DEG.
      PHI=360.*PHI/(2*PI)
C
      WRITE(6,8002) PHI
 8002 FORMAT(1X,' PHI (DEG) ',F8.4)
C
C---DETERMINE IN WHICH PHI GAP THE PARTICLE WAS INCIDENT
C
      DO 10 IGAP=1,8
         IF(IGAP.EQ.1) THEN
            PHIMIN=337.5
            PHIMAX=22.5
         ELSE
            PHIMIN=-22.5+(IGAP-1)*45.
            PHIMAX=22.5+(IGAP-1)*45.
         ENDIF
         IF(PHI.GT.PHIMIN.AND.PHI.LT.PHIMAX) THEN
            PHITRN=PHI-(IGAP-1)*45.
            GOTO 20
         ENDIF
 10   CONTINUE
C
C---CALCULATE CORRECTION FACTOR FROM PHI COORDINATE
C
C---CONVERT BACK TO RAD
 20   WRITE(6,8003) IGAP,PHIMIN,PHIMAX,PHITRN
 8003 FORMAT(1X,' IGAP ',I2,' PHIMIN ',F8.4,' PHIMAX ',
     &       F8.4,' PHITRN ',F8.4)
      PHITRN=2*PI*PHITRN/360.
      WRITE(6,8004) PHITRN,EBLOCK(ISEG,IRING)
 8004 FORMAT(1X,' PHITRN (MRAD) ',F8.4,' EBLOCK BEF COR ',F8.4)
C
      AZRES=(PI/8.0-AZIFIT*ABS(PHITRN))*8.0/PI
      EBLOCK(ISEG,IRING)=EBLOCK(ISEG,IRING)*AZRES
      WRITE(6,8005) AZIFIT,AZRES,EBLOCK(ISEG,IRING)
 8005 FORMAT(1X,' AZIFIT ',F8.4,' AZRES ',F8.4,' EBLOCK ',F8.4)
C
      RETURN
      END
//*
//**********************************************************************
//*  INPUT UNIT 3 :  4-VECTOR EVENTS IN THE CPROD-FORMAT
//**********************************************************************
//*
//G.FT03F001 DD DISP=SHR,
//   DSN=F22CPH.MC4V.PHI350A.MGEV17H.T50MRAD
//*
//**********************************************************************
//*  OUTPUT UNIT 2    JADE EVENTS IN BOS FORMAT
//**********************************************************************
//*
//*G.FT02F001 DD DUMMY
//*
//G.FT02F001 DD DSN=F22CPH.TESTGEAN.NR4,
//*      DISP=SHR
//*                SPACE: 4  TRACKS FOR 30  BHABHA-EVENTS
//    UNIT=FAST,SPACE=(TRK,(10,5),RLSE),
//    DISP=(NEW,CATLG,CATLG),
//    DCB=R01DCB.VBS
//*     MSVGP=VJAD,UNIT=3330V,
//*     MSVGP=VTMP,UNIT=3330V,
//*     UNIT=TAPE
//*
//*    OUTPUT PICTURES
//*
//* PICTURES ON UNIT 4
//*   ALLOCATE DATASET WITH
//*   DCB=R01DCB.VBS ;DSORG: PS ;  SPACE: 1 OR 2 TRACKS IS ENOUGH
//*   LOGON GRAPHIC TERMINAL:  IPS (TXPLOT) GA(---)
//*
//G.FT11F001 DD DUMMY
//*
//*G.FT11F001 DD DSN=F22CPH.TXPLOT.JADE,DISP=SHR
C   27/03/97 703271158  MEMBER NAME  #MCMUMU  (JMC.S)       FVS
//         JOB 10622622,MSGLEVEL=(2,0),CLASS=E,TIME=(,01)
//*MAIN ORG=EXT,RELPRI=MED
//*
//*
//*                    THIS USES THE CERN STYLE JCL PROCEDURE
//*
//*                          F O R T C G
//*
//TRACK EXEC FORTCG,CPRM=XL,LPRM='NOMAP,LIST',GRGN=800K
//*
//C.SYSIN DD *
C-----------------------------------------------------------------------
      LOGICAL*1  LFLAG
C
      COMMON / BCS / IW(30000)
      COMMON / TODAY / HDATE(6)
      COMMON / CFLAG / LFLAG(10)
C
C          LFLAG(1) = SMEAR GAMMA AND ELECTRON ENERGIES
C          LFLAG(2) = GAMMA CONVERSION IN OUTER TANK AND COIL (TRKGAM)
C          LFLAG(3) = ABSORPTION LOSSES
C          LFLAG(4) = 3 DIM SHOWER PROFILE FIT TO EGGS CODE (SLOW !!!!)
C
C                   ===> DEFAULT .TRUE.,.FALSE.,.TRUE.,.FALSE.
C
      COMMON / CIEVS  / KIEV,IEVMIN,IEVMAX
C
C          IEVMIN = FIRST EVENT TO BE READ FROM INPUT FILE
C          IEVMAX = LAST  EVENT TO BE READ FROM INPUT FILE
C                   ==== > DEFAULF IEVMIN = 1
C                          IEVMAX = 9999999
C
C
C                  SET DATE AND TIME OF RUN  - 12 NOON ON 1ST MAY 1981
C                  ALSO SET MUON RANDOM NUMBER GENERATOR USING MUSEED
C                  WITH ANY INTEGER (DIFFERENT FOR EACH JOB).
C
      HDATE(1)=0
      HDATE(2)=0
      HDATE(3)=12
      HDATE(4)=1
      HDATE(5)=5
      HDATE(6)=1981
C
      CALL MUSEED(301)
      CALL BINT( 30000, 5000, 500, 0 )
      CALL MCJADE(  30, 50 )
      CALL BSTA
      CALL PALL
      STOP
      END
C
C----------------------------------------------------------------------
      SUBROUTINE JGETEV( * )
C----------------------------------------------------------------------
C
C   AUTHOR    E. ELSEN    02/11/81 :  PRODUCE NEXT EVENT
C
C   LAST MOD  J. HAGEMANN 20/12/83 :  SHORT VERSION OF SUBROUTINE
C                                     JGETEV TO BE USED IN MEMBER
C                                     #MCMUMU
C
C   PRODUCE NEXT EVENT BY CALLING GENMU OR GENEE.
C
C   RETURN 1 IF MAXIMUM NUMBER OF EVENTS TO BE PRODUCED IS REACHED
C
C----------------------------------------------------------------------
C
      IMPLICIT INTEGER*2 (H)
      COMMON / BCS / IW(1)
C
      COMMON / CIEVS  / KIEV,IEVMIN,IEVMAX
C
      DATA ICALL / 0 /
C
      LOGICAL VALID
C
C------------------  C O D E  -----------------------------------------
C
      ICALL = ICALL + 1
      IF(ICALL.NE.1) GO TO 10
      IEV = 0
      KIEV = 0
10    IEV = IEV + 1
C
      CALL GENMU( &1000 )
C
C                                           CHECK INPUT
C
      CALL MCVALI( VALID )
      IF( .NOT. VALID ) GO TO 10
C                                           CONTINUE HERE FOR VALID DATA
      KIEV = KIEV + 1
C
C                                           CREATE VECT BANK
C
      CALL LHVECT( LENGTH )
      CALL BCRE( IND, 'VECT', 0, LENGTH, &1000, IER )
      CALL STVECT( LENGTH, IW(IND+1) )
C
C                                           CREATE PALL BANK
C
      CALL LHPALL( LENGTH)
      CALL BCRE( NPALL, 'PALL', 0, LENGTH, &1000, IER )
      CALL STPALL( LENGTH, IW(NPALL + 1) )
      CALL BSAW( 1, 'PALL' )
      RETURN
 1000 IEV = IEV - 1
      RETURN 1
      END
#include "genee.for"
//G.SYSLIB DD DSN=SYS1.FORTLIB,DISP=SHR
//         DD DSN=DESYLIB,DISP=SHR
//         DD DSN=F22RJB.RLMC.L,DISP=SHR
//         DD DSN=F22ELS.JMC.L,DISP=SHR
//         DD DSN=F11LHO.JADEGL,DISP=SHR
//         DD DSN=JADELG.LOAD,DISP=SHR
//         DD DSN=F22ALL.JADEMUL,DISP=SHR
//         DD DSN=R01UTL.CERN.KERNLIB4,DISP=SHR
//         DD DSN=SYS1.NAGLIB,DISP=SHR
//         DD DSN=SYS1.DNAGLIB,DISP=SHR
//         DD DSN=F1EBLO.BOSLIB.L,DISP=SHR
//*
//*                 OUTPUT
//*
//*.FT02F001 DD UNIT=FAST,DISP=(,CATLG,DELETE),
//*       DCB=R01DCB.VBS,SPACE=(TRK,(20,2),RLSE),
//*       DSN=F22ELS.MCTEST3
//G.FT02F001 DD DUMMY
//*.FT02F001 DD UNIT=FAST,DISP=SHR,DSN=F22ELS.MCTEST3
//*
//*                 CONSTANTS
//*
//G.FT22F001 DD UNIT=FAST,DISP=SHR,DSN=F11LHO.AUPDAT1
C   27/03/97 703271158  MEMBER NAME  #MCPAIR  (JMC.S)       FVS
//         JOB                MSGLEVEL=(0,0),CLASS=E,TIME=(,10)
//*MAIN ORG=EXT,RELPRI=MED
//*
//**********************************************************************
//*                                                                    *
//*         M C P A I R   TRACKING JOB  (WITHOUT MUON TRACKING)        *
//*                       GENERATES 4-VECTORS OF PARTICLE PAIRS        *
//*                       (E+E-, MU+MU-, PI+PI- ETC.) AND TRACKS       *
//*                       THEM THROUGH DETECTOR                        *
//*                                                                    *
//*                    THIS USES THE CERN STYLE JCL PROCEDURE          *
//*                                                                    *
//*                          F O R T C G                               *
//*                                                                    *
//**********************************************************************
//TRACK EXEC FORTCG,CPRM=XL,LPRM='NOMAP,LIST',GRGN=912K
//*
//C.SYSIN DD *
C-----------------------------------------------------------------------
      LOGICAL*1  LFLAG
      COMMON / CFLAG / LFLAG(10)
      COMMON / TODAY / HDATE(6)
C
      COMMON / BCS / IW(33000)
C
C        LFLAG(1) = SMEAR GAMMA AND ELECTRON ENERGIES
C        LFLAG(2) = GAMMA CONVERSION IN OUTER TANK AND COIL (TRKGAM)
C        LFLAG(3) = ABSORPTION LOSSES
C        LFLAG(4) = 3 DIM SHOWER PROFILE FIT TO EGGS CODE SLOW!!!!!
C        LFLAG(5) = .TRUE.   -->  WITH VERTEX CHAMBER TRACKING
C                 = .FALSE.  -->  WITHOUT VERTEX CHAMBER TRACKING
C                                 BUT OLD BEAM PIPE GEOMETRY AND
C                                 BEAM PIPE COUNTERS (BEFORE MAI 84)
C
C                     ===> DEFAULT .TRUE.,.FALSE.,.TRUE.,.FALSE.,.FALSE.
C
      COMMON / CIEVS  / KIEV,IEVMIN,IEVMAX
C
C          IEVMIN = FIRST EVENT TO BE READ FROM INPUT FILE
C          IEVMAX = LAST  EVENT TO BE READ FROM INPUT FILE
C
C                   ==== > DEFAULF IEVMIN = 1
C                                  IEVMAX = 9999999
C
      CALL BINT( 33000, 10000, 500, 0 )
C
      HDATE(1)=1
      HDATE(2)=1
      HDATE(3)=1
      HDATE(4)=1
      HDATE(5)=5
      HDATE(6)=1984
C                            COMMENTED TO USE OLD HARDWARE
CCC   LFLAG(5) = .TRUE.
C
      CALL MCJADE(   0, 50 )
      CALL BSTA
      CALL PALL
      STOP
      END
C
C----------------------------------------------------------------------
      SUBROUTINE JGETEV( * )
C----------------------------------------------------------------------
C
C   AUTHOR    E. ELSEN    02/11/81 :  PRODUCE NEXT EVENT
C
C   LAST MOD  J. HAGEMANN 20/12/83 :  SHORT VERSION OF SUBROUTINE
C                                     JGETEV TO BE USED IN MEMBER
C                                     #MCMUMU
C
C   PRODUCE NEXT EVENT BY CALLING GENMU OR GENEE.
C
C   RETURN 1 IF MAXIMUM NUMBER OF EVENTS TO BE PRODUCED IS REACHED
C
C----------------------------------------------------------------------
C
      IMPLICIT INTEGER*2 (H)
      COMMON / BCS / IW(1)
C
      COMMON / CIEVS  / KIEV,IEVMIN,IEVMAX
C
      DATA ICALL / 0 /
C
      LOGICAL VALID
C
C------------------  C O D E  -----------------------------------------
C
      ICALL = ICALL + 1
      IF(ICALL.NE.1) GO TO 10
      IEV = 0
      KIEV = 0
10    IEV = IEV + 1
C
      CALL GENMU( &1000 )
C
C                                           CHECK INPUT
C
      CALL MCVALI( VALID )
      IF( .NOT. VALID ) GO TO 10
C                                           CONTINUE HERE FOR VALID DATA
      KIEV = KIEV + 1
C
C                                           CREATE VECT BANK
C
      CALL LHVECT( LENGTH )
      CALL BCRE( IND, 'VECT', 0, LENGTH, &1000, IER )
      CALL STVECT( LENGTH, IW(IND+1) )
C
C                                           CREATE PALL BANK
C
      CALL LHPALL( LENGTH)
      CALL BCRE( NPALL, 'PALL', 0, LENGTH, &1000, IER )
      CALL STPALL( LENGTH, IW(NPALL + 1) )
      CALL BSAW( 1, 'PALL' )
      RETURN
 1000 IEV = IEV - 1
      RETURN 1
      END
#include "genee.for"
//G.SYSLIB DD DSN=SYS1.FORTLIB,DISP=SHR
//         DD DSN=DESYLIB,DISP=SHR
//         DD DSN=F22ELS.JMC.L,DISP=SHR
//         DD DSN=F11LHO.JADEGL,DISP=SHR
//         DD DSN=JADELG.LOAD,DISP=SHR
//         DD DSN=F22ALL.JADEMUL,DISP=SHR
//         DD DSN=R01UTL.CERN.KERNLIB4,DISP=SHR
//         DD DSN=SYS1.NAGLIB,DISP=SHR
//         DD DSN=SYS1.DNAGLIB,DISP=SHR
//         DD DSN=F1EBLO.BOSLIB.L,DISP=SHR
//         DD DSN=F11LHO.TAGG.L,DISP=SHR
//*                 OUTPUT
//*G.FT02F001 DD UNIT=FAST,DISP=(,CATLG,DELETE),
//*       DCB=R01DCB.VBS,SPACE=(TRK,(20,2),RLSE),
//*       DSN=F22ELS.MCTEST3
//*G.FT02F001 DD DUMMY
//*G.FT02F001 DD UNIT=FAST,DISP=SHR,DSN=F22ELS.MCTEST3
//*                 CONSTANTS
//G.FT22F001 DD UNIT=FAST,DISP=SHR,DSN=F11LHO.AUPDAT1
C   27/03/97 703271158  MEMBER NAME  #PRODMU  (JMC.S)       FVS
//         JOB 10622622,MSGLEVEL=(2,0),CLASS=E,TIME=(0,01)
//*MAIN RELPRI=MED
//*
//**********************************************************************
//*                                                                    *
//*         M C J A D E   TRACKING JOB  (INCLUDING MUON TRACKING)      *
//*                                                                    *
//**********************************************************************
//*                                                                    *
//*         THIS VERSION IS SLOW AND SHOULD BE USED ONLY               *
//*         WHERE MUON RESULTS ARE REALLY NEEDED.                      *
//*         IF NOT USE MEMBER #PRODUCT.                                *
//*                                                                    *
//**********************************************************************
//*                                                                    *
//*  FIRST STEP      COPY INPUT 4 VECTORS TO DISK                      *
//*                                                                    *
//**********************************************************************
//*
//COPY EXEC PGM=IEBGENER
//*
//*        INPUT DATASET
//*
//SYSUT1 DD UNIT=TAPE,DISP=SHR,
//        DSN=F22PET.ALIJET.C30
//*
//SYSUT2 DD UNIT=DISK,DISP=(,PASS),
//       DCB=R01DCB.VBS,
//       SPACE=(CYL,(50,0)),DSN=&&SCRTCH1
//SYSPRINT DD SYSOUT=*
//SYSIN DD DUMMY
//*
//**********************************************************************
//*                                                                    *
//*  SECOND STEP     TRACKING             CERN STYLE JCL               *
//*                                                                    *
//**********************************************************************
//*
//MUTRACK EXEC FORTCG,CPRM='XL,NOSOURCE',LPRM='LIST,NOMAP',GRGN=912K
//*
//C.SYSIN DD *
C-----------------------------------------------------------------------
      IMPLICIT INTEGER*2 (H)
C
      COMMON / TODAY / HDATE(6)
      COMMON / BCS / IW(30000)
C
      LOGICAL*1  LFLAG
      COMMON / CFLAG / LFLAG(10)
C
C          LFLAG(1) = SMEAR GAMMA AND ELECTRON ENERGIES
C          LFLAG(2) = GAMMA CONVERSION IN OUTER TANK AND COIL (TRKGAM)
C          LFLAG(3) = ABSORPTION LOSSES
C          LFLAG(4) = 3 DIM SHOWER PROFILE FIT TO EGGS CODE (SLOW !!!!)
C
C                   ===> DEFAULT .TRUE.,.FALSE.,.TRUE.,.FALSE.
C
      COMMON / CIEVS  / KIEV,IEVMIN,IEVMAX
C
C          IEVMIN = FIRST EVENT TO BE READ FROM INPUT FILE
C          IEVMAX = LAST  EVENT TO BE READ FROM INPUT FILE
C                   ==== > DEFAULF IEVMIN = 1
C                          IEVMAX = 9999999
C
C
C                  SET DATE AND TIME OF RUN  - 12 NOON ON 1ST MAY 1981
C                  ALSO SET MUON RANDOM NUMBER GENERATOR USING MUSEED
C                  WITH ANY INTEGER (DIFFERENT FOR EACH JOB).
C
      HDATE(1)=0
      HDATE(2)=0
      HDATE(3)=12
      HDATE(4)=1
      HDATE(5)=5
      HDATE(6)=1981
C
      CALL BINT( 30000,5000,100,100)
      N = JUHR(2)
C                                               SEED GENERATOR
      CALL MUSEED(301)
      CALL MCJADE(0,5)
      CALL BSTA
      CALL PALL
      STOP
      END
//G.SYSLIB DD DSN=SYS1.FORTLIB,DISP=SHR
//         DD DSN=DESYLIB,DISP=SHR
//         DD DSN=F22RJB.RLMC.L,DISP=SHR,UNIT=FAST
//         DD DSN=F22ELS.JMC.L,DISP=SHR,UNIT=FAST,VOL=SER=STOR05
//         DD DSN=JADELG.LOAD,DISP=SHR,UNIT=FAST,VOL=SER=STOR05
//         DD DSN=F22ALL.JADEMUL,DISP=SHR,UNIT=FAST,VOL=SER=STOR05
//         DD DSN=F11LHO.JADEGL,DISP=SHR,UNIT=FAST,VOL=SER=STOR05
//         DD DSN=R01UTL.CERN.KERNLIB4,DISP=SHR
//         DD DSN=F1EBLO.BOSLIB.L,DISP=SHR
//         DD DSN=SYS1.NAGLIB,DISP=SHR
//         DD DSN=SYS1.DNAGLIB,DISP=SHR
//*
//*                 INPUT
//*
//G.FT03F001 DD UNIT=DISK,DISP=(OLD,PASS),DSN=&&SCRTCH1
//*
//*                 OUTPUT
//*
//G.FT02F001 DD UNIT=TAPE,DISP=(NEW,CATLG,DELETE),
//        DCB=R01DCB.VBS,
//        DSN=F22ELS.T1ALIJET.C30
//*
//*                 CALIBRATION FOR THE MUON SYSTEM
//*
//G.FT22F001 DD UNIT=FAST,VOL=SER=STOR05,DISP=SHR,DSN=F11LHO.AUPDAT1
C   27/03/97 703271158  MEMBER NAME  #PRODUCT (JMC.S)       FVS
//         JOB 10622622,MSGLEVEL=(2,0),CLASS=E,TIME=(0,01)
//*MAIN RELPRI=MED
//*
//**********************************************************************
//*                                                                    *
//*         M C J A D E   TRACKING JOB  (WITHOUT MUON TRACKING)        *
//*                                                                    *
//**********************************************************************
//*                                                                    *
//*  FIRST STEP      COPY INPUT 4 VECTORS TO DISK                      *
//*                                                                    *
//**********************************************************************
//*
//COPY EXEC PGM=IEBGENER
//*
//*        INPUT DATASET
//*
//SYSUT1 DD UNIT=TAPE,DISP=SHR,
//        DSN=F22PET.ALIJET.C30
//*
//SYSUT2 DD UNIT=DISK,DISP=(,PASS),
//       DCB=R01DCB.VBS,
//       SPACE=(CYL,(50,0)),DSN=&&SCRTCH1
//SYSPRINT DD SYSOUT=*
//SYSIN DD DUMMY
//*
//**********************************************************************
//*                                                                    *
//*  SECOND STEP     TRACKING           CERN STYLE JCL                 *
//*                                                                    *
//**********************************************************************
//*
//TRACK EXEC FORTCG,CPRM=XL,LPRM='LIST,NOMAP',GRGN=550K
//*
//C.SYSIN DD *
C-----------------------------------------------------------------------
      COMMON / BCS / IW(30000)
C
      LOGICAL*1  LFLAG
      COMMON/CFLAG/LFLAG(10)
C
C        LFLAG(1) = SMEAR GAMMA AND ELECTRON ENERGIES
C        LFLAG(2) = GAMMA CONVERSION IN OUTER TANK AND COIL (TRKGAM)
C        LFLAG(3) = ABSORPTION LOSSES
C        LFLAG(4) = 3 DIM SHOWER PROFILE FIT TO EGGS CODE SLOW!!!!!
C ===> DEFAULT .TRUE.,.FALSE.,.TRUE.,.FALSE.
C
      COMMON / CIEVS  / KIEV,IEVMIN,IEVMAX
C
C     IEVMIN = FIRST EVENT TO BE READ FROM INPUT FILE
C     IEVMAX = LAST  EVENT TO BE READ FROM INPUT FILE
C ==== > DEFAULF IEVMIN = 1
C                IEVMAX = 9999999
C
      CALL BINT( 30000, 5000, 500, 0 )
      CALL MCJADE( 0, 5 )
      CALL BSTA
      CALL PALL
      STOP
      END
//G.SYSLIB DD DSN=SYS1.FORTLIB,DISP=SHR
//         DD DSN=DESYLIB,DISP=SHR
//         DD DSN=F22ELS.JMC.L,DISP=SHR,UNIT=FAST,VOL=SER=STOR05
//         DD DSN=JADELG.LOAD,DISP=SHR,UNIT=FAST,VOL=SER=STOR05
//         DD DSN=F11LHO.JADEGL,DISP=SHR,UNIT=FAST,VOL=SER=STOR05
//         DD DSN=F22ALL.JADEMUL,DISP=SHR,UNIT=FAST,VOL=SER=STOR05
//         DD DSN=R01UTL.CERN.KERNLIB4,DISP=SHR
//         DD DSN=F1EBLO.BOSLIB.L,DISP=SHR
//         DD DSN=SYS1.NAGLIB,DISP=SHR
//*
//*                 INPUT
//*
//G.FT03F001 DD UNIT=DISK,DISP=(OLD,PASS),DSN=&&SCRTCH1
//*
//*                 OUTPUT
//*
//G.FT02F001 DD UNIT=TAPE,DISP=(NEW,CATLG,DELETE),
//        DCB=R01DCB.VBS,
//        DSN=F22ELS.T1ALIJET.C30
C   27/03/97 703271158  MEMBER NAME  #RCPROD  (JMC.S)       FVS
//F22ELS   JOB 10622622,F22ELS,CLASS=A,MSGLEVEL=(0,0),TIME=(2,0)
//*MAIN ORG=EXT,RELPRI=MED
// EXEC FCLG
      COMMON/CPROD/ NR,BEAM,PT,XNC,XNN,ECM,
     *        NP,NC,NN,PP(4,500),XM(500),ICH(500),ITP(500),IP(500,2),
     *        NF,NCF,NNF,PF(4,300),XMF(300),ICF(300),ITF(300),
     *        PSTRT(3,300)
C
CCC  INITIALISE PROGRAM
      NEVTS = 100000
      DO 1001 IEV=1,NEVTS
      IF( JUHR(NSEC) .EQ. 2 ) GO TO 90
C
CCC  READ EVENTS FROM TAPE
      READ(3,ERR=1005,END=90) NR,BEAM,PT,XNC,XNN,ECM,
     *     NP,NC,NN,((PP(I4,N),I4=1,4),XM(N),ICH(N),ITP(N),
     *     (IP(N,I2),I2=1,2),N=1,NP),
     *     NF,NCF,NNF,((PF(I4,N2),I4=1,4),XMF(N2),ICF(N2),ITF(N2),
     *     (PSTRT(I3,N2),I3=1,3),N2=1,NF)
C
CCC  WRITE EVENTS TO DISC
      WRITE(2) NR,BEAM,PT,XNC,XNN,ECM,
     *     NP,NC,NN,((PP(I4,N),I4=1,4),XM(N),ICH(N),ITP(N),
     *     (IP(N,I2),I2=1,2),N=1,NP),
     *     NF,NCF,NNF,((PF(I4,N2),I4=1,4),XMF(N2),ICF(N2),ITF(N2),
     *     (PSTRT(I3,N2),I3=1,3),N2=1,NF)
C
      IF( IEV .GT. 20 ) GO TO 1001
      WRITE(6,9101) NR,BEAM,PT,XNC,XNN,ECM,
     *     NP,NC,NN,((PP(I4,N),I4=1,4),XM(N),ICH(N),ITP(N),
     *     (IP(N,I2),I2=1,2),N=1,NP)
 9101 FORMAT(1X,I10,5F10.3/1X,3I10/(1X,5F10.3,2I10,3F10.3,2I10))
      WRITE(6,9102)
     *     NF,NCF,NNF,((PF(I4,N2),I4=1,4),XMF(N2),ICF(N2),ITF(N2),
     *     (PSTRT(I3,N2),I3=1,3),N2=1,NF)
 9102 FORMAT(1X,3I10/(1X,5F10.3,2I10,3F10.3))
      GO TO 1001
C
 1005 WRITE(6,9107)
 9107 FORMAT(' **** READ ERROR *** IEV=',I8)
C
 1001 CONTINUE
C
   90 STOP
      END
//*                        INPUT:
//GO.FT03F001 DD UNIT=FAST,DISP=SHR,DSN=F22PET.QQGBOD.A34
//*                        OUTPUT:
//GO.FT02F001 DD UNIT=TAPE,DCB=R01DCB.VBS,DISP=(,CATLG,),
//    DSN=F22ELS.QQGBOD.A34
C   27/03/97 703271158  MEMBER NAME  #TESTLGL (JMC.S)       FVS
//    JOB         CLASS=E,MSGLEVEL=(1,0),TIME=(0,30)
//*MAIN ORG=EXT,LINES=(2),RELPRI=MED
//*
//* GENERAL TRACKING JOB
//*
// EXEC GEP,REGION=800K,
//  DN=DUMMY
      COMMON / BCS / IW(33000)
C
      LOGICAL*1  LFLAG
      COMMON/CFLAG/LFLAG(10)
C
C        LFLAG(1) = SMEAR GAMMA AND ELECTRON ENERGIES
C        LFLAG(2) = GAMMA CONVERSION IN OUTER TANK AND COIL (TRKGAM)
C        LFLAG(3) = ABSORPTION LOSSES
C        LFLAG(4) = 3 DIM SHOWER PROFILE FIT TO EGGS CODE SLOW!!!!!
C ===> DEFAULT .TRUE.,.FALSE.,.TRUE.,.FALSE.
C
      COMMON / CIEVS  / KIEV,IEVMIN,IEVMAX
C
C     IEVMIN = FIRST EVENT TO BE READ FROM INPUT FILE
C     IEVMAX = LAST  EVENT TO BE READ FROM INPUT FILE
C ==== > DEFAULF IEVMIN = 1
C                IEVMAX = 9999999
C
      LFLAG(4) = .FALSE.
      CALL BINT( 33000,10000, 500, 0 )
      CALL MCJADE( 0, 10 )
      CALL GEPW
      CALL BSTA
      CALL PALL
      STOP
       END
#include "mist.for"
//LKED.SYSLIB DD
//            DD
//            DD
//            DD
//            DD
//            DD DSN=F11BAR.JMC.L,DISP=SHR
//            DD DSN=JADELG.LOAD,DISP=SHR
//            DD DSN=F22ALL.JADEMUL,DISP=SHR
//            DD DSN=R02BUT.CERNLIB,DISP=SHR
//            DD DSN=F1EBLO.BOSLIB.L,DISP=SHR
//*
//* UNIT3  INPUT:    4-VECTOR EVENTS IN THE CPROD-FORMAT
//*
//GO.FT03F001 DD DISP=SHR,
//*       DSN=F22PET.LND51.TEST100
//        DSN=F11MEI.PIC500
//*
//* UNIT2  OUTPUT:    JADE EVENTS IN BOS FORMAT
//*
//GO.FT02F001 DD DUMMY
//*GO.FT02F001 DD DISP=(,CATLG,DELETE),UNIT=FAST,DCB=R01DCB.VBS,
//*       DSN=F11BAR.TEST.TRCK04,SPACE=(TRK,(10,10),RLSE)
C   27/03/97 703271158  MEMBER NAME  #TESTMC  (JMC.S)       FVS
//    JOB         CLASS=E,MSGLEVEL=(1,0),TIME=(0,30)
//*MAIN ORG=EXT,LINES=(2),RELPRI=MED
//*
//* GENERAL TRACKING JOB
//*
// EXEC FCLG,PARM.FORT=XL,PARM.LKED='LIST,MAP',
//  REGION.GO=512K
      COMMON / BCS / IW(33000)
C
      LOGICAL*1  LFLAG
      COMMON/CFLAG/LFLAG(10)
C
C        LFLAG(1) = SMEAR GAMMA AND ELECTRON ENERGIES
C        LFLAG(2) = GAMMA CONVERSION IN OUTER TANK AND COIL (TRKGAM)
C        LFLAG(3) = ABSORPTION LOSSES
C        LFLAG(4) = 3 DIM SHOWER PROFILE FIT TO EGGS CODE SLOW!!!!!
C ===> DEFAULT .TRUE.,.FALSE.,.TRUE.,.FALSE.
C
      COMMON / CIEVS  / KIEV,IEVMIN,IEVMAX
C
C     IEVMIN = FIRST EVENT TO BE READ FROM INPUT FILE
C     IEVMAX = LAST  EVENT TO BE READ FROM INPUT FILE
C ==== > DEFAULF IEVMIN = 1
C                IEVMAX = 9999999
C
      LFLAG(4) = .TRUE.
      CALL BINT( 33000,10000, 500, 0 )
      CALL MCJADE( 0, 10 )
      CALL BSTA
      CALL PALL
      STOP
       END
//LKED.SYSLIB DD
//            DD
//            DD DSN=F11BAR.JMC.L,DISP=SHR
//            DD DSN=JADELG.LOAD,DISP=SHR
//            DD DSN=F22ALL.JADEMUL,DISP=SHR
//            DD DSN=R02BUT.CERNLIB,DISP=SHR
//            DD DSN=F1EBLO.BOSLIB.L,DISP=SHR
//*
//* UNIT3  INPUT:    4-VECTOR EVENTS IN THE CPROD-FORMAT
//*
//GO.FT03F001 DD DISP=SHR,
//        DSN=F22PET.LND51.TEST100
//*
//* UNIT2  OUTPUT:    JADE EVENTS IN BOS FORMAT
//*
//*GO.FT02F001 DD DUMMY
//GO.FT02F001 DD DISP=(,CATLG,DELETE),UNIT=FAST,DCB=R01DCB.VBS,
//       DSN=F11BAR.TEST.TRCK04,SPACE=(TRK,(10,10),RLSE)
