GEANT321/gxint/gxphys.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:50  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :          12/06/95  15.03.22  by  S.Ravndal
  11 *-- Author :
  12       SUBROUTINE GXPHYS
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *      Physics parameters control commands                       *
  17 C.    *                                                                *
  18 C.    *       Author:    R.Brun      **********                        *
  19 C.    *                                                                *
  20 C.    ******************************************************************
  21 C.
  22 #include "geant321/gcbank.inc"
  23 #include "geant321/gcphys.inc"
  24 #include "geant321/gccuts.inc"
  25 #include "geant321/gconsp.inc"
  26 #include "geant321/gcunit.inc"
  27 #include "geant321/gctrak.inc"
  28 #include "geant321/gcmulo.inc"
  29       DIMENSION UCUTS(10),ULCUTS(10)
  30       EQUIVALENCE(UCUTS(1),CUTGAM)
  31       DIMENSION MECA(5,13)
  32       EQUIVALENCE (MECA(1,1),IPAIR)
  33       CHARACTER*6 CUTNAM(10)
  34       CHARACTER*4 CEN(10)
  35       CHARACTER*32 CHPATL
  36       CHARACTER*(*) CHNUMB
  37       PARAMETER (CHNUMB='1234567890')
  38       DATA CUTNAM/'CUTGAM','CUTELE','CUTNEU','CUTHAD','CUTMUO',
  39      +            'BCUTE' ,'BCUTM' ,'DCUTE' ,'DCUTM' ,'PPCUTM'/
  40 C.
  41 C.    ------------------------------------------------------------------
  42 C.
  43       CALL KUPATL(CHPATL,NPAR)
  44 *
  45       IF(CHPATL.EQ.'ANNI')THEN
  46          CALL KUGETI(IANNI)
  47 *
  48       ELSEIF(CHPATL.EQ.'AUTO')THEN
  49          CALL KUGETI(IGAUTO)
  50 *
  51       ELSEIF(CHPATL.EQ.'BREM')THEN
  52          CALL KUGETI(IBREM)
  53 *
  54       ELSEIF(CHPATL.EQ.'CKOV')THEN
  55          CALL KUGETI(ICKOV)
  56 *
  57       ELSEIF(CHPATL.EQ.'COMP')THEN
  58          CALL KUGETI(ICOMP)
  59 *
  60       ELSEIF(CHPATL.EQ.'DCAY')THEN
  61          CALL KUGETI(IDCAY)
  62 *
  63       ELSEIF(CHPATL.EQ.'DRAY')THEN
  64          CALL KUGETI(IDRAY)
  65 *
  66       ELSEIF(CHPATL.EQ.'ERAN')THEN
  67          CALL KUGETR(EKMIN)
  68          CALL KUGETR(EKMAX)
  69          CALL KUGETI(NEKBIN)
  70          NEKBIN=MIN(NEKBIN,199)
  71 *
  72       ELSEIF(CHPATL.EQ.'HADR')THEN
  73          CALL KUGETI(IHADR)
  74 *
  75       ELSEIF(CHPATL.EQ.'LABS')THEN
  76          CALL KUGETI(ILABS)
  77 *
  78       ELSEIF(CHPATL.EQ.'LOSS')THEN
  79          CALL KUGETI(ILOSS)
  80          IF(ILOSS.EQ.2.OR.ILOSS.EQ.0)THEN
  81             IDRAY=0
  82          ELSE
  83             IDRAY=1
  84          ENDIF
  85 *
  86       ELSEIF(CHPATL.EQ.'MULS')THEN
  87          CALL KUGETI(IMULS)
  88 *
  89       ELSEIF(CHPATL.EQ.'MUNU')THEN
  90          CALL KUGETI(IMUNU)
  91 *
  92       ELSEIF(CHPATL.EQ.'PAIR')THEN
  93          CALL KUGETI(IPAIR)
  94 *
  95       ELSEIF(CHPATL.EQ.'PFIS')THEN
  96          CALL KUGETI(IPFIS)
  97 *
  98       ELSEIF(CHPATL.EQ.'PHOT')THEN
  99          CALL KUGETI(IPHOT)
 100 *
 101       ELSEIF(CHPATL.EQ.'RAYL')THEN
 102          CALL KUGETI(IRAYL)
 103 *
 104       ELSEIF(CHPATL.EQ.'STRA')THEN
 105          CALL KUGETI(ISTRA)
 106 *
 107       ELSEIF(CHPATL.EQ.'SYNC')THEN
 108          CALL KUGETI(ISYNC)
 109 *
 110       ELSEIF(CHPATL.EQ.'CUTS')THEN
 111          IF(NPAR.LE.0)THEN
 112             WRITE(LOUT,10000)
 113 10000       FORMAT(/,' Current PHYSICS parameters:',/)
 114             DO 10 I=1,10
 115                CALL GEVKEV(UCUTS(I),ULCUTS(I),CEN(I))
 116                WRITE(LOUT,10100)CUTNAM(I),ULCUTS(I),CEN(I)
 117 10100          FORMAT(5X,A,' = ',F7.2,1X,A)
 118    10       CONTINUE
 119             GO TO 999
 120          ENDIF
 121          CALL KUGETR(CUTGAM)
 122          CALL KUGETR(CUTELE)
 123          CALL KUGETR(CUTHAD)
 124          CALL KUGETR(CUTNEU)
 125          CALL KUGETR(CUTMUO)
 126          CALL KUGETR(BCUTE)
 127          CALL KUGETR(BCUTM)
 128          CALL KUGETR(DCUTE)
 129          CALL KUGETR(DCUTM)
 130          CALL KUGETR(PPCUTM)
 131          CALL KUGETR(TOFMAX)
 132          CALL KUGETR(GCUTS(1))
 133          IF(BCUTE.LE.0.)BCUTE=CUTGAM
 134          IF(BCUTM.LE.0.)BCUTM=CUTGAM
 135          IF(DCUTE.LE.0.)DCUTE=CUTELE
 136          IF(DCUTM.LE.0.)DCUTM=CUTELE
 137          IF(PPCUTM.LT.4.*EMASS)PPCUTM=4.*EMASS
 138 *
 139       ELSEIF(CHPATL.EQ.'DRPRT')THEN
 140          CALL KUGETI(IPART)
 141          CALL KUGETI(IMATE)
 142          CALL KUGETR(STEP)
 143          CALL KUGETI(NPOINT)
 144          CALL GDRPRT(IPART,IMATE,STEP,NPOINT)
 145 *
 146       ELSEIF(CHPATL.EQ.'PHYSI')THEN
 147          IF(JTMED.GT.0)THEN
 148             DO 30 I=1,IQ(JTMED-2)
 149                JTM=LQ(JTMED-I)
 150                IF(JTM.LE.0)GO TO 30
 151                IF(IQ(JTM-2).EQ.0)THEN
 152                   CALL MZPUSH(IXCONS,JTM,10,0,'I')
 153                   GO TO 30
 154                ENDIF
 155                DO 20 J=1,10
 156                   JTMI=LQ(JTM-J)
 157                   IF(JTMI.GT.0)THEN
 158                      CALL MZDROP(IXCONS,JTMI,' ')
 159                   ENDIF
 160    20          CONTINUE
 161    30       CONTINUE
 162             CALL UCOPY(CUTGAM,Q(JTMED+1),10)
 163             DO 40 I=1,13
 164                Q(JTMED+10+I)=MECA(1,I)
 165    40       CONTINUE
 166          ENDIF
 167          IF(JMATE.LE.0)GO TO 999
 168          DO 60 I=1,IQ(JMATE-2)
 169             JMA=LQ(JMATE-I)
 170             IF(JMA.LE.0)GO TO 60
 171             DO 50 J=1,IQ(JMA-2)
 172                IF(J.EQ.4.OR.J.EQ.5)GO TO 60
 173                JM=LQ(JMA-J)
 174                IF(JM.LE.0)GO TO 50
 175                CALL MZDROP(IXCONS,JM,'L')
 176    50       CONTINUE
 177    60    CONTINUE
 178          CALL MZGARB (IXCONS, 0)
 179          CALL GPHYSI
 180       ENDIF
 181 *
 182   999 END