TGeant3/galicef.F

   1 *CMZ :  2.03/01 20/08/98  17.46.44  by  Federico Carminati
   2 *CMZ :  2.00/01 20/04/98  10.51.01  by  Unknown
   3 *CMZ :  2.00/00 16/04/98  12.54.34  by  Unknown
   4 *CMZ :  1.05/00 08/06/94  09.19.45  by  Nick van Eijndhoven (RUU/CERN)
   5 *-- Author :    Nick van Eijndhoven (RUU/CERN)   08/06/94
   6       SUBROUTINE SXPART
   7 C
   8 C *** DEFINITION OF ADDITIONAL PARTICLES AND DECAY MODES ***
   9 C *** NVE 08-JUL-1994 SAP UTRECHT ***
  10 C
  11 C CALLED BY : UGINIT
  12 C ORIGIN    : NICK VAN EIJNDHOVEN
  13 C
  14       DIMENSION BRATIO(6),MODE(6)
  15 C
  16 C --- Define additional particles
  17       CALL GSPART(33,'OMEGA(783)',3,0.782, 0.,7.836E-23,0.,0)
  18       CALL GSPART(34,'PHI(1020)' ,3,1.019, 0.,1.486E-22,0.,0)
  19       CALL GSPART(35,'D +'       ,4,1.870, 1.,1.066E-12,0.,0)
  20       CALL GSPART(36,'D -'       ,4,1.870,-1.,1.066E-12,0.,0)
  21       CALL GSPART(37,'D 0'       ,3,1.865, 0.,4.2E-13  ,0.,0)
  22       CALL GSPART(38,'ANTI D 0'  ,3,1.865, 0.,4.2E-13  ,0.,0)
  23       CALL GSPART(42,'RHO +'     ,4,0.768, 1.,4.353E-24,0.,0)
  24       CALL GSPART(43,'RHO -'     ,4,0.768,-1.,4.353E-24,0.,0)
  25       CALL GSPART(44,'RHO 0'     ,3,0.768, 0.,4.353E-24,0.,0)
  26 C
  27 C --- Define additional decay modes ---
  28 C --- omega(783) ---
  29       DO KZ=1,6
  30          BRATIO(KZ)=0
  31          MODE(KZ)=0
  32       ENDDO
  33       IPA=33
  34       BRATIO(1)=89.
  35       BRATIO(2)=8.5
  36       BRATIO(3)=2.5
  37       MODE(1)=70809
  38       MODE(2)=107
  39       MODE(3)=908
  40       CALL GSDK(IPA,BRATIO,MODE)
  41 C --- phi(1020) ---
  42       DO KZ=1,6
  43          BRATIO(KZ)=0
  44          MODE(KZ)=0
  45       ENDDO
  46       IPA=34
  47       BRATIO(1)=49.
  48       BRATIO(2)=34.4
  49       BRATIO(3)=12.9
  50       BRATIO(4)=2.4
  51       BRATIO(5)=1.3
  52       MODE(1)=1112
  53       MODE(2)=1610
  54       MODE(3)=4407
  55       MODE(4)=90807
  56       MODE(5)=1701
  57       CALL GSDK(IPA,BRATIO,MODE)
  58 C --- D+ ---
  59       DO KZ=1,6
  60          BRATIO(KZ)=0
  61          MODE(KZ)=0
  62       ENDDO
  63       IPA=35
  64       BRATIO(1)=25.
  65       BRATIO(2)=25.
  66       BRATIO(3)=25.
  67       BRATIO(4)=25.
  68       MODE(1)=80809
  69       MODE(2)=120808
  70       MODE(3)=111208
  71       MODE(4)=110809
  72       CALL GSDK(IPA,BRATIO,MODE)
  73 C --- D- ---
  74       DO KZ=1,6
  75          BRATIO(KZ)=0
  76          MODE(KZ)=0
  77       ENDDO
  78       IPA=36
  79       BRATIO(1)=25.
  80       BRATIO(2)=25.
  81       BRATIO(3)=25.
  82       BRATIO(4)=25.
  83       MODE(1)=90908
  84       MODE(2)=110909
  85       MODE(3)=121109
  86       MODE(4)=120908
  87       CALL GSDK(IPA,BRATIO,MODE)
  88 C --- D0 ---
  89       DO KZ=1,6
  90          BRATIO(KZ)=0
  91          MODE(KZ)=0
  92       ENDDO
  93       IPA=37
  94       BRATIO(1)=33.
  95       BRATIO(2)=33.
  96       BRATIO(3)=33.
  97       MODE(1)=809
  98       MODE(2)=1208
  99       MODE(3)=1112
 100       CALL GSDK(IPA,BRATIO,MODE)
 101 C --- Anti D0 ---
 102       DO KZ=1,6
 103          BRATIO(KZ)=0
 104          MODE(KZ)=0
 105       ENDDO
 106       IPA=38
 107       BRATIO(1)=33.
 108       BRATIO(2)=33.
 109       BRATIO(3)=33.
 110       MODE(1)=809
 111       MODE(2)=1109
 112       MODE(3)=1112
 113       CALL GSDK(IPA,BRATIO,MODE)
 114 C --- rho+ ---
 115       DO KZ=1,6
 116          BRATIO(KZ)=0
 117          MODE(KZ)=0
 118       ENDDO
 119       IPA=42
 120       BRATIO(1)=100.
 121       MODE(1)=807
 122       CALL GSDK(IPA,BRATIO,MODE)
 123 C --- rho- ---
 124       DO KZ=1,6
 125          BRATIO(KZ)=0
 126          MODE(KZ)=0
 127       ENDDO
 128       IPA=43
 129       BRATIO(1)=100.
 130       MODE(1)=907
 131       CALL GSDK(IPA,BRATIO,MODE)
 132 C --- rho0 ---
 133       DO KZ=1,6
 134          BRATIO(KZ)=0
 135          MODE(KZ)=0
 136       ENDDO
 137       IPA=44
 138       BRATIO(1)=100.
 139       MODE(1)=707
 140       CALL GSDK(IPA,BRATIO,MODE)
 141 C --- jpsi ---
 142       DO KZ=1,6
 143          BRATIO(KZ)=0
 144          MODE(KZ)=0
 145       ENDDO
 146       IPA=113
 147       BRATIO(1)=50.
 148       BRATIO(2)=50.
 149       MODE(1)=506
 150       MODE(2)=605
 151       CALL GSDK(IPA,BRATIO,MODE)
 152 C --- upsilon ---
 153       IPA=114
 154       CALL GSDK(IPA,BRATIO,MODE)
 155 C --- phi ---
 156       IPA=115
 157       CALL GSDK(IPA,BRATIO,MODE)
 158 C
 159       RETURN
 160       END
 161 *CMZ :  2.00/01 23/04/98  08.37.08  by  Federico Carminati
 162 *CMZ :  2.00/00 16/04/98  12.54.34  by  Unknown
 163 *CMZ :  1.05/00 08/06/94  09.19.45  by  Nick van Eijndhoven (RUU/CERN)
 164 *-- Author :    Nick van Eijndhoven (RUU/CERN)   08/06/94
 165       SUBROUTINE SXSROT(NMAT,THETA1,PHI1,THETA2,PHI2,THETA3,PHI3)
 166 C
 167 C *** INITIALISATION OF THE ALICE ZEBRA STRUCTURE ***
 168 C *** FCA 22-APR-1998 CERN EP ***
 169 C
 170 C CALLED BY : *_GEOM, *_ROTM, *_TMED
 171 C ORIGIN    : FEDERICO CARMINATI
 172 C
 173 #undef CERNLIB_GEANT321_GCBANK_INC
 174 #undef CERNLIB_GEANT321_GCLINK_INC
 175 #include "geant321/gcbank.inc"
 176 *KEND.
 177 *
 178       NMAT=1
 179       IF(JROTM.GT.0) THEN
 180          NS=IQ(JROTM-2)
 181          DO KZ=1,NS
 182             IF(LQ(JROTM-KZ).EQ.0) THEN
 183                NMAT=KZ
 184                GOTO 10
 185             ENDIF
 186          ENDDO
 187          NMAT=NS+1
 188       ENDIF
 189  10   CALL GSROTM(NMAT,THETA1,PHI1,THETA2,PHI2,THETA3,PHI3)
 190 *
 191  999  END
 192 *CMZ :          30/12/98  16.23.44  by  Rene Brun
 193 *-- Author :    Rene Brun   30/12/98
 194       subroutine setclip(name,xmin,xmax,ymin,ymax,zmin,zmax)
 195 *
 196 *       define the clip box parameters for volume name
 197 *
 198 #undef CERNLIB_GEANT321_GCUNIT_INC
 199 #include "geant321/gcunit.inc"
 200 #undef CERNLIB_GEANT321_GCMUTR_INC
 201 #include "geant321/gcmutr.inc"
 202 #undef CERNLIB_GEANT321_GCGOBJ_INC
 203 #include "geant321/gcgobj.inc"
 204 *KEND.
 205       character *(*) name
 206       real xmin,xmax,ymin,ymax,zmin,zmax
 207 *
 208          IHOLE=0
 209          NCVOLS=NCVOLS+1
 210          IF(NCVOLS.EQ.MULTRA)THEN
 211             WRITE(CHMAIL, 10000)
 212 10000      FORMAT(' *** GXDRAW ***:',
 213      +            ' No more space to store MCVOL information.')
 214             CALL GMAIL(0,0)
 215             WRITE(CHMAIL, 10100)
 216 10100      FORMAT(' *** GXDRAW ***: Please reset MCVOL')
 217             CALL GMAIL(0,0)
 218             return
 219          ENDIF
 220          IF(XMIN.GE.XMAX.OR.YMIN.GE.YMAX.OR.ZMIN.GE.ZMAX)THEN
 221             WRITE(CHMAIL,10200)
 222 10200       FORMAT(' Wrong Box limits. Check values ')
 223             CALL GMAIL(0,0)
 224             return
 225          ENDIF
 226 ****SG
 227          GNNVV(NCVOLS)=NAME
 228          GNASH(NCVOLS)='BOX'
 229          GXMIN(NCVOLS)=XMIN
 230          GXMAX(NCVOLS)=XMAX
 231          GYMIN(NCVOLS)=YMIN
 232          GYMAX(NCVOLS)=YMAX
 233          GZMIN(NCVOLS)=ZMIN
 234          GZMAX(NCVOLS)=ZMAX
 235          IF(GXMIN(NCVOLS).GT.-99999.)IHOLE=1
 236 * Resetting Mcvol mode
 237          IF(GNNVV(NCVOLS).EQ.'.')THEN
 238             IHOLE=0
 239             DO 10 JJ=1,NCVOLS
 240                GNNVV(JJ)=' '
 241                GXMIN(JJ)=-100000
 242                GXMAX(JJ)=-99999
 243                GYMIN(JJ)=-100000
 244                GYMAX(JJ)=-99999
 245                GZMIN(JJ)=-100000
 246                GZMAX(JJ)=-99999
 247    10       CONTINUE
 248             NCVOLS=0
 249          ENDIF
 250       end
 251
 252       subroutine setbomb(boom)
 253 *
 254 *      set the bomb factor
 255 *
 256 #undef CERNLIB_GEANT321_GCMUTR_INC
 257 #include "geant321/gcmutr.inc"
 258 *KEND.
 259 *
 260       real boom
 261 *
 262       gboom = boom
 263       end