      SUBROUTINE START
 
C-----------------------------------------------------------------------
C  START
C
C  PERFORMS INITIALISATIONS AND CHECKS AT THE BEGINNING OF RUN.
C  CALLS DATAC TO READ IN DATA CARDS.
C  CHECKS AND INITIALIZES SELECTED HADRONIC INTERACTION MODEL.
C  THIS SUBROUTINE IS CALLED FROM MAIN
C
C  REDESIGN: J. KNAPP   IK1  FZK KARLSRUHE
C-----------------------------------------------------------------------
 
      IMPLICIT NONE
*KEEP,AIR.
      COMMON /AIR/     COMPOS,PROBTA,AVERAW,AVOGAD
      DOUBLE PRECISION COMPOS(3),PROBTA(3),AVERAW,AVOGAD
*KEEP,ANNI.
      COMMON /ANNI/    CAN,CANN
      DOUBLE PRECISION CAN(50),CANN(50)
*KEEP,ATMOS.
      COMMON /ATMOS/   AATM,BATM,CATM,DATM
      DOUBLE PRECISION AATM(5),BATM(5),CATM(5),DATM(5)
*KEEP,ATMOS2.
      COMMON /ATMOS2/  HLAY,THICKL
      DOUBLE PRECISION HLAY(5),THICKL(5)
*KEEP,BUFFS.
      COMMON /BUFFS/   RUNH,RUNE,EVTH,EVTE,DATAB,LH
      INTEGER          MAXBUF,MAXLEN
      PARAMETER        (MAXBUF=39*7)
      PARAMETER        (MAXLEN=12)
      REAL             RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF),
     *                 RUNE(MAXBUF),DATAB(MAXBUF)
      INTEGER          LH
      CHARACTER*4      CRUNH,CRUNE,CEVTH,CEVTE
      EQUIVALENCE      (RUNH(1),CRUNH), (RUNE(1),CRUNE)
      EQUIVALENCE      (EVTH(1),CEVTH), (EVTE(1),CEVTE)
*KEEP,CONST.
      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
*KEEP,DPMFLG.
      COMMON /DPMFLG/  NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
      INTEGER          NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
*KEEP,EDECAY.
      COMMON /EDECAY/  CETA
      DOUBLE PRECISION CETA(5)
*KEEP,ELABCT.
      COMMON /ELABCT/  ELCUT
      DOUBLE PRECISION ELCUT(4)
*KEEP,ETHMAP.
      COMMON /ETHMAP/  ECTMAP,ELEFT
      DOUBLE PRECISION ECTMAP,ELEFT
*KEEP,KAONS.
      COMMON /KAONS/   CKA
      DOUBLE PRECISION CKA(80)
*KEEP,MAGNET.
      COMMON /MAGNET/  BX,BZ,BVAL,BNORMC,BNORM,COSB,SINB,BLIMIT
      DOUBLE PRECISION BX,BZ,BVAL,BNORMC
      REAL             BNORM,COSB,SINB,BLIMIT
*KEEP,MUMULT.
      COMMON /MUMULT/  CHC,OMC,FMOLI
      DOUBLE PRECISION CHC,OMC
      LOGICAL          FMOLI
*KEEP,MUPART.
      COMMON /MUPART/  AMUPAR,BCUT,CMUON,FMUBRM,FMUORG
      DOUBLE PRECISION AMUPAR(14),BCUT,CMUON(11)
      LOGICAL          FMUBRM,FMUORG
*KEEP,NCSNCS.
      COMMON /NCSNCS/  SIGN30,SIGN45,SIGN60,SIGO30,SIGO45,SIGO60,
     *                 SIGA30,SIGA45,SIGA60,PNOA30,PNOA45,PNOA60,
     *                 SIG30A,SIG45A,SIG60A
      DOUBLE PRECISION SIGN30(56),SIGN45(56),SIGN60(56),
     *                 SIGO30(56),SIGO45(56),SIGO60(56),
     *                 SIGA30(56),SIGA45(56),SIGA60(56),
     *                 PNOA30(1540,3),PNOA45(1540,3),PNOA60(1540,3),
     *                 SIG30A(56),SIG45A(56),SIG60A(56)
*KEEP,NKGI.
      COMMON /NKGI/    SEL,SELLG,STH,ZEL,ZELLG,ZSL,DIST,
     *                 DISX,DISY,DISXY,DISYX,DLAX,DLAY,DLAXY,DLAYX,
     *                 OBSATI,RADNKG,RMOL,TLEV,TLEVCM,IALT
      DOUBLE PRECISION SEL(10),SELLG(10),STH(10),ZEL(10),ZELLG(10),
     *                 ZSL(10),DIST(10),
     *                 DISX(-10:10),DISY(-10:10),
     *                 DISXY(-10:10,2),DISYX(-10:10,2),
     *                 DLAX (-10:10,2),DLAY (-10:10,2),
     *                 DLAXY(-10:10,2),DLAYX(-10:10,2),
     *                 OBSATI(2),RADNKG,RMOL(2),TLEV(10),TLEVCM(10)
      INTEGER          IALT(2)
*KEEP,OBSPAR.
      COMMON /OBSPAR/  OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
     *                 THETPR,PHIPR,NOBSLV
      DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
     *                 THETAP,THETPR(2),PHIP,PHIPR(2)
      INTEGER          NOBSLV
*KEEP,PAM.
      COMMON /PAM/     PAMA,SIGNUM
      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
*KEEP,PARPAR.
      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
      INTEGER          ITYPE,LEVL
*KEEP,PARPAE.
      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
     *                 (CURPAR(12),ECM )
*KEEP,PRIMSP.
      COMMON /PRIMSP/  PSLOPE,LLIMIT,ULIMIT,LL,UL,SLEX,ISPEC
      DOUBLE PRECISION PSLOPE,LLIMIT,ULIMIT,LL,UL,SLEX
      INTEGER          ISPEC
*KEEP,RANDPA.
      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
      DOUBLE PRECISION FAC,U1,U2
      REAL             RD(3000)
      INTEGER          ISEED(103,10),NSEQ
      LOGICAL          KNOR
*KEEP,RANGE.
      COMMON /RANGE/   CC
      DOUBLE PRECISION CC(20)
*KEEP,RECORD.
      COMMON /RECORD/  IRECOR
      INTEGER          IRECOR
*KEEP,RUNPAR.
      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
     *                 MONIOU,MDEBUG,NUCNUC,
     *                 CETAPE,
     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
     *                 N1STTR,MDBASE,
     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
     *                ,GHEISH,GHESIG
      COMMON /RUNPAC/  DSN,HOST,USER
      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
      REAL             STEPFC
      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
     *                 N1STTR,MDBASE
      INTEGER          CETAPE
      CHARACTER*79     DSN
      CHARACTER*20     HOST,USER
 
      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
     *                ,GHEISH,GHESIG
*KEEP,STACKF.
      COMMON /STACKF/  STACK,STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
      INTEGER          MAXSTK
      PARAMETER        (MAXSTK = 12*340*2)
      DOUBLE PRECISION STACK(MAXSTK)
      INTEGER          STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM
*KEEP,STRBAR.
      COMMON /STRBAR/  CSTRBA
      DOUBLE PRECISION CSTRBA(11)
*KEEP,VERS.
      COMMON /VERS/    VERNUM,MVDATE,VERDAT
      DOUBLE PRECISION VERNUM
      INTEGER          MVDATE
      CHARACTER*18     VERDAT
*KEEP,VENUS.
      COMMON /VENUS/   ISH0,IVERVN,MTAR99,FVENUS,FVENSG
      INTEGER          ISH0,IVERVN,MTAR99
      LOGICAL          FVENUS,FVENSG
*KEEP,CEREN3.
      COMMON /CEREN3/  CERCNT,DATAB2,LHCER
      INTEGER          MAXBF2
      PARAMETER        (MAXBF2 = 39 * 7)
      DOUBLE PRECISION CERCNT
      REAL             DATAB2(MAXBF2)
      INTEGER          LHCER
*KEND.
 
      DOUBLE PRECISION COAN,SE,TEMP1,TEMP2,TEMP3,THICK,TTIME,ZE,ZS,ZX
      INTEGER          I,IA,J,L,N
      EXTERNAL         THICK
      CHARACTER*1      MARK
C-----------------------------------------------------------------------
 
C  SAY HELLO
      WRITE(MONIOU,112)
  112 FORMAT(/' ',120('A')//
     *'   OOO      OOO     OOOO       OOOO    OO   O      O      O   '/
     *'  O   O    O   O    O    O    O    O   OO   O    O       O O  '/
     *' O        O     O   O     O   O        OO   O  O        O   O '/
     *' O        O     O   O    O     OOOO    OO   OO         O     O'/
     *' O        O     O   OOOO           O   OO   O  O       OOOOOOO'/
     *'  O   O    O   O    O   O     O    O   OO   O    O     O     O'/
     *'   OOO      OOO     O     O    OOOO    OO   O      O   O     O'//
     *' COSMIC RAY SIMULATION FOR KASCADE'///
     *' A PROGRAM TO SIMULATE EXTENSIVE AIR SHOWERS IN ATMOSPHERE'//
     *' BASED ON A PROGRAM OF P.K.F. GRIEDER, UNIVERSITY BERN,',
     *' SWITZERLAND'/
     *' HDPM MODEL ACCORDING TO J.N. CAPDEVIELLE, COLLEGE DE FRANCE,',
     *' PARIS, FRANCE'/
     *' VENUS MODEL ACCORDING TO K. WERNER, UNIVERSITY NANTES, FRANCE'/
     *' GHEISHA ROUTINES ACCORDING TO H. FESEFELDT, RWTH. AACHEN,',
     *' GERMANY'/
     *' EGS4 AND NKG FORMULAS FOR SIMULATION OF EL.MAG. PARTICLES'//)
 
      MARK = '1'
 
      WRITE(MONIOU,912) VERNUM,MARK,VERDAT
  912 FORMAT(' INSTITUT FUER KERNPHYSIK '/
     *       ' FORSCHUNGSZENTRUM UND UNIVERSITAET KARLSRUHE'/
     *       ' POSTFACH 3640'/
     *       ' D-76021 KARLSRUHE'/
     *       ' GERMANY'//
     *       ' IN CASE OF PROBLEMS CONTACT:'/
     *       '           DIETER HECK             JOHANNES KNAPP'/
     *       ' E-MAIL:   HECK@IK3.FZK.DE         KNAPP@IK1.FZK.DE'/
     *       ' FAX:      (49) 7247-82-4075       (49) 7247-82-3548'/
     *       ' TEL:      (49) 7247-82-3777       (49) 7247-82-3549'//
     *       ' NUMBER OF VERSION : ',F6.3,A1/
     *       ' DATE   OF VERSION : ',A18 /)
 
      WRITE(MONIOU,141)
  141 FORMAT(//' CERENKOV RADIATION IS GENERATED'/
     *         ' ==============================='//)
 
C  INITIALIZE FIELD WITH PARTICLE MASSES
      CALL PAMAF
 
 
C  READ RUN STEERING DATA CARDS
      CALL DATAC
 
C  CLEARS BUFFERS FOR HEADER AND FILLS IN PERMANENT INFORMATION
      DO 889  L = 1,MAXBUF
        EVTH(L)  = 0.
        EVTE(L)  = 0.
        RUNH(L)  = 0.
        RUNE(L)  = 0.
        DATAB(L) = 0.
        DATAB2(L) = 0.
  889 CONTINUE
 
 
C  PERMANENT INFORMATION
C  CHARACTER STRINGS
      CRUNH = 'RUNH'
      CRUNE = 'RUNE'
      CEVTH = 'EVTH'
      CEVTE = 'EVTE'
 
      RUNH(2)  = NRRUN
      RUNE(2)  = NRRUN
      EVTH(44) = NRRUN
 
C  DATE OF RUN
      WRITE(MONIOU,101)
 101  FORMAT(//' ',10('='),' START OF RUN ',55('='))
      CALL PRTIME(TTIME)
      RUNH(3)  = TTIME
      EVTH(45) = TTIME
 
C  VERSION OF PROGRAM
      RUNH(4)  = VERNUM
      EVTH(46) = VERNUM
 
C-----------------------------------------------------------------------
C  INITIALISATION FOR RANDOM NUMBER GENERATOR
      IF ( FEGS  .AND.  NSEQ .LT. 2 ) NSEQ = 2
C  CERENKOV SELECTION DEMANDS ALWAYS EGS CALCULATION
      FEGS = .TRUE.
C  IN CASE OF CERENKOV CALCULATIONS THE 3. RANDOM SEQUENCE IS NEEDED
      IF ( NSEQ .LT. 3 ) NSEQ = 3
      DO 281  I = 1,NSEQ
        IF ( .NOT. DEBUG   .AND.  .NOT. DEBDEL   .AND.
     *      (ISEED(2,I) .GT. 1000  .OR.  ISEED(3,I) .GT. 0) ) THEN
          WRITE(MONIOU,2811)  I
2811      FORMAT(/' #########################################'/
     *            ' ##  IMPROPER INITIALIZATION OF RANDOM  ##'/
     *            ' ##   NUMBER GENERATOR SEQUENCE ',I6,'  ##'/
     *            ' ##     IS EXTREMELY TIME CONSUMING     ##'/
     *            ' ##       PLEASE READ THE MANUALS       ##'/
     *            ' #########################################'/)
        ENDIF
        CALL RMMAQ( ISEED(1,I), I, 'S' )
  281 CONTINUE
      KNOR = .TRUE.
 
      WRITE(MONIOU,158) (L,(ISEED(J,L),J=1,3),L=1,NSEQ)
  158 FORMAT (/' RANDOM NUMBER GENERATOR AT BEGIN OF RUN :'/
     *        (' SEQUENCE = ',I2,'  SEED = ',I9,'  CALLS = ',I9,
     *         '  BILLIONS = ',I9))
 
C-----------------------------------------------------------------------
C  READ CROSS SECTIONS AND PROBABILITIES FOR NUCLEUS-NUCLEUS COLLISIONS
      OPEN(UNIT=NUCNUC,FILE='NUCNUCCS',STATUS='OLD')
      READ(NUCNUC,500) SIGN30,SIGN45,SIGN60,SIGO30,SIGO45,SIGO60,
     *                 SIGA30,SIGA45,SIGA60
      READ(NUCNUC,500) (PNOA30(I,1),I=1,1540),(PNOA45(I,1),I=1,1540),
     *                 (PNOA60(I,1),I=1,1540),(PNOA30(I,2),I=1,1540),
     *                 (PNOA45(I,2),I=1,1540),(PNOA60(I,2),I=1,1540),
     *                 (PNOA30(I,3),I=1,1540),(PNOA45(I,3),I=1,1540),
     *                 (PNOA60(I,3),I=1,1540)
 500  FORMAT( 5E16.10 )
      CLOSE(UNIT=NUCNUC)
 
C  INELASTIC CROSS SECTIONS FOR PROJECTICLE WITH MASS NUMBER IA
      DO 501  IA = 1,56
        SIG30A(IA) = COMPOS(1)*SIGN30(IA) + COMPOS(2)*SIGO30(IA)
     *                                    + COMPOS(3)*SIGA30(IA)
        SIG45A(IA) = COMPOS(1)*SIGN45(IA) + COMPOS(2)*SIGO45(IA)
     *                                    + COMPOS(3)*SIGA45(IA)
        SIG60A(IA) = COMPOS(1)*SIGN60(IA) + COMPOS(2)*SIGO60(IA)
     *                                    + COMPOS(3)*SIGA60(IA)
 
        IF (DEBUG) WRITE(MDEBUG,544) IA,SIG30A(IA),SIG45A(IA),SIG60A(IA)
 544    FORMAT(' START : CROSS SECTIONS A-AIR : A=',I2,1P,3E14.6)
 501  CONTINUE
 
      WRITE(MONIOU,503)
 503  FORMAT (//' ',10('='),' INTERACTION MODELS ',49('='))
C  HIGH ENERGY HADRONIC INTERACTION MODEL
      IF ( FVENUS ) THEN
        WRITE(MONIOU,*) 'VENUS TREATS HIGH ENERGY HADRONIC INTERACTIONS'
        CALL VENINI
        IF ( .NOT. GHEISH ) THEN
          GHEISH = .TRUE.
          WRITE(MONIOU,*)'GHEISHA OPTION NOT SELECTED, BUT SWITCHED ON'
        ENDIF
        IF     ( NFRAGM .EQ. 0 ) THEN
          WRITE(MONIOU,*)
     *    ' TOTAL FRAGMENTATION OF PRIMARY NUCLEUS IN FIRST INTERACTION'
        ELSEIF ( NFRAGM .EQ. 1 ) THEN
          WRITE(MONIOU,*)
     *      ' NO FRAGMENTATION, NO EVAPORATION OF REMAINDER'
        ELSEIF ( NFRAGM .EQ. 2 ) THEN
          WRITE(MONIOU,1504)
        ELSEIF ( NFRAGM .EQ. 3 ) THEN
          WRITE(MONIOU,1505)
        ELSE
          NFRAGM = 4
          WRITE(MONIOU,1507)
        ENDIF
        WRITE(MONIOU,*)
      ELSE
        WRITE(MONIOU,1506)
      ENDIF
1506  FORMAT(' HDPM ROUTINES TREAT HIGH ENERGY HADRONIC INTERACTIONS')
 
 
      IF ( .NOT. FVENUS ) THEN
C  INPUT FLAGS FOR HDPM OPTIONS
      WRITE(MONIOU,*)'HDPM GENERATOR SPECIFICATIONS ARE:'
      IF ( NFLAIN .EQ. 0 ) THEN
        WRITE(MONIOU,*) ' RANDOM NUMBER OF INTERACTIONS IN AIR TARGET'
        IF ( NFLDIF .EQ. 0 ) THEN
          WRITE(MONIOU,*) ' NO DIFFRACTIVE SECOND INTERACTIONS'
        ELSE
          WRITE(MONIOU,*) ' DIFFRACTIVE SECOND INTERACTIONS'
        ENDIF
      ELSE
        WRITE(MONIOU,*) ' FIXED NUMBER OF INTERACTIONS IN AIR TARGET'
      ENDIF
      IF ( NFLPI0 .EQ. 0 ) THEN
        WRITE(MONIOU,*) ' RAPIDITY OF PI0 ACCORDING TO COLLIDER DATA'
      ELSE
        WRITE(MONIOU,*) ' RAPIDITY OF PI0 SAME AS THAT OF CHARGED'
      ENDIF
      IF ( NFLPIF .EQ. 0 ) THEN
        WRITE(MONIOU,*) ' NO FLUCTUATIONS OF NUMBER OF PI0'
      ELSE
        WRITE(MONIOU,*)' FLUCTUATIONS OF NUMBER OF PI0 AS MEASURED ',
     *         'AT THE COLLIDER'
      ENDIF
      IF ( NFLCHE .EQ. 0 ) THEN
        WRITE(MONIOU,*) ' CHARGE EXCHANGE INTERACTION POSSIBLE '
      ELSE
        WRITE(MONIOU,*) ' NO CHARGE EXCHANGE INTERACTION POSSIBLE '
      ENDIF
      IF     ( NFRAGM .EQ. 0 ) THEN
        WRITE(MONIOU,*)' TOTAL FRAGMENTION OF PRIMARY NUCLEUS IN ',
     *          'FIRST INTERACTION'
      ELSEIF ( NFRAGM .EQ. 1 ) THEN
        WRITE(MONIOU,*) ' NO FRAGMENTATION, NO EVAPORATION OF REMAINDER'
      ELSEIF ( NFRAGM .EQ. 2 ) THEN
        WRITE(MONIOU,1504)
1504    FORMAT('  NO FRAGMENTATION, EVAPORATION OF REMAINDER ',
     *           ' (PT AFTER JACEE)')
      ELSEIF ( NFRAGM .EQ. 3 ) THEN
        WRITE(MONIOU,1505)
1505    FORMAT('  NO FRAGMENTATION, EVAPORATION OF REMAINDER ',
     *           ' (PT AFTER GOLDHABER)')
      ELSE
        NFRAGM = 4
        WRITE(MONIOU,1507)
1507    FORMAT('  NO FRAGMENTATION, EVAPORATION OF REMAINDER ',
     *           ' (WITH PT = 0.)')
      ENDIF
      ENDIF
      WRITE(MONIOU,*)
 
C  LOW ENERGY HADRONIC INTERACTION MODEL
      IF ( GHEISH ) THEN
        WRITE(MONIOU,*) 'GHEISHA TREATS LOW ENERGY HADRONIC ',
     *                  'INTERACTIONS'
        CALL CGHINI
      ELSE
        WRITE(MONIOU,*) 'ISOBAR ROUTINES TREAT LOW ENERGY HADRONIC ',
     *                  'INTERACTIONS'
        HILOELB = 53.D0
      ENDIF
 
C  WRITE HADRONIC STEERING FLAGS TO RUNHEADER
      RUNH(270) = NFLAIN
      RUNH(271) = NFLDIF
      RUNH(272) = NFLPI0 + 100. * NFLPIF
      RUNH(273) = NFLCHE + 100. * NFRAGM
 
      EVTH(65)  = NFLAIN
      EVTH(66)  = NFLDIF
      EVTH(67)  = NFLPI0
      EVTH(68)  = NFLPIF
      EVTH(69)  = NFLCHE
      EVTH(70)  = NFRAGM
 
      HILOECM = SQRT(2.D0*PAMA(14)*(PAMA(14) + HILOELB))
      WRITE(MONIOU,*) 'START: HIGH ENERGY INTERACTION MODEL USED ABOVE'
      WRITE(MONIOU,*)  '     ',HILOELB,' GEV LAB ENERGY   OR'
      WRITE(MONIOU,*)  '     ',HILOECM,' GEV CM ENERGY'
 
C  INPUT STEERING FLAGS FOR ELECTROMAGNETIC PART
      WRITE(MONIOU,*)
      IF ( FNKG ) THEN
        WRITE(MONIOU,*)'ELECTROMAGNETIC COMPONENT SIMULATED WITH NKG'
        IF ( ULIMIT .GT. 2.D7 ) THEN
          WRITE(MONIOU,*)'#############################################'
          WRITE(MONIOU,*)'#  W A R N I N G  NKG IS WITHOUT LPM EFFECT #'
          WRITE(MONIOU,*)'#############################################'
        ENDIF
        WRITE(MONIOU,*)
      ENDIF
      IF ( FEGS ) THEN
        WRITE(MONIOU,*)'ELECTROMAGNETIC COMPONENT SIMULATED WITH EGS4'
        WRITE(MONIOU,*)
      ENDIF
      IF ( .NOT. (FNKG .OR. FEGS) ) WRITE(MONIOU,*)
     *              'ELECTROMAGNETIC COMPONENT IS NOT SIMULATED'
      IF ( FEGS ) THEN
        IF ( STEPFC .GT. 10.  .OR.  STEPFC .LE. 0. ) THEN
          WRITE(MONIOU,*)'STEP LENGTH FACTOR FOR ELECTRON MULTIPLE ',
     *       'SCATTERING =',STEPFC,' NOT CORRECT'
          WRITE(MONIOU,*)'PLEASE READ THE MANUALS'
          STOP
        ENDIF
        IF ( STEPFC .LT. 10. ) WRITE(MONIOU,*)'STEP LENGTH ',
     *            'FACTOR FOR ELECTRON MULTIPLE SCATTERING =',STEPFC
C  INITIALIZE EGS4 PACKAGE
        CALL EGSINI
        IF ( ULIMIT .GT. 2.D7 ) THEN
          WRITE(MONIOU,*)'#############################################'
          WRITE(MONIOU,*)'#  W A R N I N G  EGS IS WITHOUT LPM EFFECT #'
          WRITE(MONIOU,*)'#############################################'
        ENDIF
      ENDIF
C  WRITE STEERING FLAGS FOR ELECTROMAGNETIC PART AS REAL TO HEADER
      IF ( FNKG ) THEN
        RUNH(20) = 1.
        EVTH(74) = 1.
      ELSE
        RUNH(20) = 0.
        EVTH(74) = 0.
      ENDIF
      IF ( FEGS ) THEN
        RUNH(19) = 1.
        EVTH(73) = 1.
      ELSE
        RUNH(19) = 0.
        EVTH(73) = 0.
      ENDIF
 
      EVTH(95) = STEPFC
 
C  PROGRAM CONFIGURATIONS FOR EVENT HEADER
      IF ( GHEISH ) THEN
        EVTH(75) = 1.
      ELSE
        EVTH(75) = 0.
      ENDIF
      IF ( FVENUS ) THEN
        EVTH(76) = 1.
      ELSE
        EVTH(76) = 0.
      ENDIF
      EVTH(139) = 0.
      EVTH(140) = 0.
      EVTH(141) = 0.
      EVTH(142) = 0.
      EVTH(143) = 0.
      EVTH(144) = 0.
      EVTH(145) = 0.
      EVTH(77) = 1.
      EVTH(78) = 0.
      EVTH(79) = 0.
      EVTH(80) = 3.
 
C-----------------------------------------------------------------------
C  BEGIN OF TAPE FOR IBM,  FOR TRANSPUTER SEE BEGIN OF EVT
 
C-----------------------------------------------------------------------
C  PHYSICAL CONSTANTS
      ENEPER  = EXP(1.D0)
      C(6)    = ( PAMA(5) / PAMA(11) )**2
      C(7)    = ( PAMA(5) / PAMA(8) )**2
      C(8)    = ( PAMA(5)**2 + PAMA(2)**2 ) * 0.5D0 / PAMA(5)
      C(20)   = 10.D0 * C(21)
      C(27)   = COS( C(26) )
      C(29)   = COS( C(28) )
      C(44)   = MAX( PAMA(8)+C(4), PAMA(14)+C(5) )
      C(45)   = PAMA(8) * PAMA(14) * 2.D0
      C(46)   = PAMA(8)**2 + PAMA(14)**2
      C(48)   = (PAMA(8)**2 + PAMA(5)**2) / (2.D0*PAMA(8)*PAMA(5))
      C(49)   = SQRT(C(48)**2 - 1.D0) / C(48)
 
      CKA(13) = 2.D0 * PAMA(11) * PAMA(14)
      CKA(14) = PAMA(11)**2 + PAMA(14)**2
      CKA(17) = SQRT( ( (PAMA(11)**2 + PAMA(5)**2)
     *          / (2.D0*PAMA(11)) )**2 - PAMA(5)**2 )
      CKA(18) = SQRT( ( (PAMA(11)**2 + PAMA(8)**2 - PAMA(7)**2)
     *          / (2.D0*PAMA(11)) )**2 - PAMA(8)**2 )
      CKA(22) = MAX( C(5)+PAMA(14), PAMA(11)+C(4) )
      CKA(28) = SQRT(1.D0 + CKA(17)**2/PAMA(5)**2)
      CKA(29) = SQRT(1.D0 - 1.D0/CKA(28)**2)
      CKA(30) = SQRT(1.D0 + CKA(18)**2/PAMA(8)**2)
      CKA(31) = SQRT(1.D0 - 1.D0/CKA(30)**2)
      CKA(41) = PAMA(16)
      CKA(42) = (PAMA(11)**2 + PAMA(7)**2 - PAMA(8)**2) /
     *          (2.D0*PAMA(11)*PAMA(7))
      CKA(43) = CKA(41) / (2.D0*PAMA(7))
      CKA(44) = SQRT(1.D0 - 1.D0/CKA(43)**2)
      CKA(45) = CKA(41) / (2.D0*PAMA(8))
      CKA(46) = SQRT(1.D0 - 1.D0/CKA(45)**2)
 
C  SET CONSTANTS FOR MUON BREMSSTRAHLUNG
      CMUON(3)  =  7.D0**OB3
      CMUON(6)  =  8.D0**OB3
      CMUON(9)  = 18.D0**OB3
      CMUON(1)  = LOG( 189.D0 * PAMA(5) / (CMUON(3)*PAMA(2)) )
      CMUON(4)  = LOG( 189.D0 * PAMA(5) / (CMUON(6)*PAMA(2)) )
      CMUON(7)  = LOG( 189.D0 * PAMA(5) / (CMUON(9)*PAMA(2)) )
     *                   + LOG( TB3/CMUON(9) )
      SE        = SQRT(EXP(1.D0))
      CMUON(2)  = 189.D0 * SE*PAMA(5)**2/(2.D0*PAMA(2)*CMUON(3))
      CMUON(5)  = 189.D0 * SE*PAMA(5)**2/(2.D0*PAMA(2)*CMUON(6))
      CMUON(8)  = 189.D0 * SE*PAMA(5)**2/(2.D0*PAMA(2)*CMUON(9))
      CMUON(10) = 0.75D0 * PAMA(5) * SE
      CMUON(3)  = CMUON(3) * CMUON(10)
      CMUON(6)  = CMUON(6) * CMUON(10)
      CMUON(9)  = CMUON(9) * CMUON(10)
      CMUON(11) = LOG( BCUT/PAMA(5) )
 
      DO  1  I = 1,50
        CANN(I) = 0.D0
    1 CONTINUE
      COAN = 0.D0
      DO 25  N = 1,12
        COAN    = COAN + CAN(N)
        CANN(N) = COAN
   25 CONTINUE
      COAN = 0.D0
      DO 26  N = 13,26
        COAN    = COAN + CAN(N)
        CANN(N) = COAN
   26 CONTINUE
 
C-----------------------------------------------------------------------
C  INITIALIZE CONSTANTS FOR MUON MULTIPLE SCATTERING (MOLIERE)
C  SEE SUBROUTINE GMOLI OF GEANT321 (CERN)
      IF (FMOLI) THEN
        TEMP1 = COMPOS(1) *  7.D0 *  8.D0 / 14.D0
        TEMP2 = COMPOS(2) *  8.D0 *  9.D0 / 16.D0
        TEMP3 = COMPOS(3) * 18.D0 * 19.D0 / 40.D0
        ZS  = TEMP1 + TEMP2 + TEMP3
        ZE  = -TB3*(TEMP1*LOG(7.D0) +TEMP2*LOG(8.D0) +TEMP3*LOG(18.D0))
        ZX  =  TEMP1*LOG(1.D0 + 3.34D0 * ( 7.D0/C(50))**2)
     *        +TEMP2*LOG(1.D0 + 3.34D0 * ( 8.D0/C(50))**2)
     *        +TEMP3*LOG(1.D0 + 3.34D0 * (18.D0/C(50))**2)
C  NOTE: CHC IS DEFINED DIFFERENT FROM GEANT WITHOUT DENSITY
        CHC = 0.39612D-3 * SQRT(ZS)
C  NOTE: OMC IS DEFINED DIFFERENT FROM GEANT WITHOUT DENSITY
        OMC = 6702.33D0 * ZS * EXP( (ZE-ZX)/ZS )
        EVTH(146) = 1.
      ELSE
        EVTH(146) = 0.
      ENDIF
 
C-----------------------------------------------------------------------
C  TEST ON INPUT VALUES
 
C  PRINT CONTROL OUTPUT
      IF ( CC(1)         .GE. CC(2)     .OR.
     *     CC(2)         .GE. CC(3)     .OR.
     *     CC(3)         .GE. CC(4)     .OR.
     *     CC(5)         .GE. CC(6)     .OR.
     *     CC(6)         .GE. CC(7)     .OR.
     *     CC(7)         .GE. CC(8)     .OR.
     *     CC(9)         .GE. CC(10)    .OR.
     *     CC(10)        .GE. CC(11)    .OR.
     *     CC(11)        .GE. CC(12)    .OR.
     *     PAMA(14)+C(3) .GT. CC(1)     .OR.
     *     PAMA(14)+C(4) .GT. CC(2)     .OR.
     *     C(4)*2.       .GT. CC(3)     .OR.
     *     C(3)+PAMA(8)  .GT. CC(5)     .OR.
     *     C(44)         .GT. CC(6)     .OR.
     *     C(4)+C(5)     .GT. CC(7)     .OR.
     *     PAMA(14)+C(4) .GE. C(4)*2.   .OR.
     *     C(44)         .GE. C(4)+C(5)        ) THEN
        WRITE(MONIOU,106)
  106   FORMAT (' ERROR OR INCOMPATIBILITY IN CONSTANTS')
C  PRINT CONTROL OUTPUT
        WRITE(MONIOU,103) (C(I),I=1,50)
  103   FORMAT (//' ',10('='),' CONSTANTS AND PARAMETERS ',43('=')
     *          //' PHYSICAL CONSTANTS (C)' // (1P,4(E15.8,1X),E15.8) )
        WRITE(MONIOU,110) (CKA(I),I=1,80)
  110   FORMAT (//' CONSTANTS FOR KAONS CKA(1) TO CKA(40)'
     *          // (1P,4(E15.8,1X),E15.8) )
        WRITE(MONIOU,114) (CETA(I),I=1,5)
  114   FORMAT (//' CONSTANTS FOR ETAS CETA(1) TO CETA(5)'
     *          // (1P,4(E15.8,1X),E15.8) )
        WRITE(MONIOU,115) (CSTRBA(I),I=1,11)
  115   FORMAT (//' CONSTANTS FOR STRANGE BARYONS CSTRBA(1) TO ',
     *            'CSTRBA(11)'// (1P,4(E15.8,1X),E15.8) )
        WRITE(MONIOU,206) (CAN(I),I=1,30)
  206   FORMAT (//' ANNIHILATION PARAMETERS, SET 1 (CAN)'
     *          // (1P,4(E15.8,1X),E15.8) )
        WRITE(MONIOU,209) (CANN(I),I=1,30)
  209   FORMAT (//' ANNIHILATION PARAMETERS, SET 2 (CANN)'
     *          // (1P,4(E15.8,1X),E15.8) )
        WRITE(MONIOU,60) (CC(I),I=1,12)
   60   FORMAT (//' THRESHOLD ENERGIES OF INTERACTION INTERVALS IN GEV',
     *          ' (CC)'// (1P,4(E15.8,1X),E15.8) )
        WRITE(MONIOU,106)
        STOP
      ENDIF
 
C  FILL CONSTANTS IN RUN HEADER
      DO 3001  L = 1,50
        RUNH(24+L)  = C(L)
        RUNH(154+L) = CAN(L)
        RUNH(204+L) = CANN(L)
 3001 CONTINUE
      DO 3002  L = 1,20
        RUNH(74+L)  = CC(L)
 3002 CONTINUE
      DO 3003  L = 1,40
        RUNH(94+L)  = CKA(L)
 3003 CONTINUE
      DO 3004  L = 1,5
        RUNH(134+L)  = CETA(L)
 3004 CONTINUE
      DO 3005  L = 1,11
        RUNH(139+L)  = CSTRBA(L)
 3005 CONTINUE
      DO 3007  L = 1,5
        RUNH(254+L) = AATM(L)
        RUNH(259+L) = BATM(L)
        RUNH(264+L) = CATM(L)
        DATM(L)     = 1.D0 / CATM(L)
 3007 CONTINUE
 
C  SET LOWER BOUNDARIES OF THE AIR LAYERS
      HLAY(1)   = 0.D0
      HLAY(2)   = 4.D5
      HLAY(3)   = 1.D6
      HLAY(4)   = 4.D6
      HLAY(5)   = 1.D7
C  CALCULATE THICKNESS AT LOWER BOUNDARIES OF AIR LAYERS
      DO 100 L= 1,5
        THICKL(L) = THICK(HLAY(L))
 100  CONTINUE
 
      CALL STAEND
 
      RETURN
      END
