GEANT321/gtrak/gtrack.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1999/05/18 15:55:21  fca
   6 * AliRoot sources
   7 *
   8 * Revision 1.1.1.1  1995/10/24 10:21:44  cernlib
   9 * Geant
  10 *
  11 *
  12 #include "geant321/pilot.h"
  13 *CMZ :  3.21/02 29/03/94  15.41.24  by  S.Giani
  14 *FCA :          17/05/99  16:21:12  by  Federico Carminati
  15 *               Added the modifications of P.Nevski in MANY volumes
  16 *               force update of alternative list of many candidates
  17 *-- Author :
  18       SUBROUTINE GTRACK
  19 C.
  20 C.    ******************************************************************
  21 C.    *                                                                *
  22 C.    *       Controls tracking of current particle,                   *
  23 C.    *        up to end of track for sequential tracking mode, or     *
  24 C.    *        through current volume for parallel tracking mode.      *
  25 C.    *                                                                *
  26 C.    *    ==>Called by : GUTRAK                                       *
  27 C.    *       Authors   : R.Brun, F.Bruyant                            *
  28 C.    *                                                                *
  29 C.    ******************************************************************
  30 C.
  31 #include "geant321/gcbank.inc"
  32 #include "geant321/gccuts.inc"
  33 #include "geant321/gcjloc.inc"
  34 #include "geant321/gckine.inc"
  35 #include "geant321/gcking.inc"
  36 #include "geant321/gcmate.inc"
  37 #include "geant321/gcphys.inc"
  38 #include "geant321/gcparm.inc"
  39 #include "geant321/gcsets.inc"
  40 #include "geant321/gcstak.inc"
  41 #include "geant321/gctmed.inc"
  42 #include "geant321/gctrak.inc"
  43 #include "geant321/gcvolu.inc"
  44 #include "geant321/gcunit.inc"
  45 #include "geant321/gcflag.inc"
  46 #include "geant321/gcnum.inc"
  47 #if defined(CERNLIB_USRJMP)
  48 #include "geant321/gcjump.inc"
  49 #endif
  50       COMMON/GCCHAN/LSAMVL
  51       LOGICAL LSAMVL
  52 *
  53       DIMENSION CUTS(10),MECA(5,13)
  54       EQUIVALENCE (CUTS(1),CUTGAM),(MECA(1,1),IPAIR)
  55       SAVE PRECOR
  56 #if !defined(CERNLIB_SINGLE)
  57       PARAMETER (EPSMAC=1.E-6)
  58 #endif
  59 #if defined(CERNLIB_SINGLE)
  60       PARAMETER (EPSMAC=1.E-11)
  61 #endif
  62 C.
  63 C.    ------------------------------------------------------------------
  64       ISTOP = 0
  65       EPSCUR = EPSMAC
  66       NSTOUT = 0
  67       INWOLD = 0
  68       LSAMVL = .FALSE.
  69 *
  70 * *** Check validity of tracking medium and material parameters
  71 *
  72    10 IF (NUMED.NE.NUMOLD) THEN
  73          NUMOLD = NUMED
  74          IUPD   = 0
  75          JTM    = LQ(JTMED- NUMED)
  76          DO 20 I = 1,5
  77             NATMED(I) = IQ(JTM+I)
  78    20    CONTINUE
  79          NMAT     = Q(JTM + 6)
  80          ISVOL    = Q(JTM + 7)
  81          IFIELD   = Q(JTM + 8)
  82          FIELDM   = Q(JTM + 9)
  83          TMAXFD   = Q(JTM + 10)
  84          STEMAX   = Q(JTM + 11)
  85          DEEMAX   = Q(JTM + 12)
  86          EPSIL    = Q(JTM + 13)
  87          STMIN    = Q(JTM + 14)
  88          PRECOR   = MIN(0.1*EPSIL, 0.0010)
  89          IF (LQ(JTM).EQ.0) THEN
  90             IF (ISTPAR.NE.0) THEN
  91                DO 30 I = 1,10
  92                   CUTS(I) = Q(JTMED+I)
  93    30          CONTINUE
  94                DO 40 I = 1,13
  95                   MECA(1,I) = Q(JTMED+10+I)
  96    40          CONTINUE
  97                ILABS = Q(JTMED+10+21)
  98                ISYNC = Q(JTMED+10+22)
  99                ISTRA = Q(JTMED+10+23)
 100                ISTPAR = 0
 101             ENDIF
 102          ELSE
 103             JTMN = LQ(JTM)
 104             DO 50 I = 1,10
 105                CUTS(I) = Q(JTMN+I)
 106    50       CONTINUE
 107             DO 60 I = 1,13
 108                MECA(1,I) = Q(JTMN+10+I)
 109    60       CONTINUE
 110             ILABS = Q(JTMN+10+21)
 111             ISYNC = Q(JTMN+10+22)
 112             ISTRA = Q(JTMN+10+23)
 113             ISTPAR = 1
 114          ENDIF
 115 *
 116          JMA   = LQ(JMATE-NMAT)
 117          JPROB = LQ(JMA-4)
 118          JMIXT = LQ(JMA-5)
 119          DO 70 I = 1,5
 120             NAMATE(I) = IQ(JMA+I)
 121    70    CONTINUE
 122          A    = Q(JMA +6)
 123          Z    = Q(JMA +7)
 124          DENS = Q(JMA +8)
 125          RADL = Q(JMA +9)
 126          ABSL = Q(JMA +10)
 127          IF(IQ(JTM-2).GE.3.AND.LQ(JTM-3).NE.0.AND.ITCKOV.NE.0.AND.
 128      +      LQ(LQ(JTM-3)-3).NE.0.AND.Z.GE.1.) THEN
 129 *
 130 * ***  In this tracking medium Cerenkov photons are generated and
 131 * ***  tracked. Set to 1 the corresponding flag.
 132 *
 133             IMCKOV = 1
 134          ELSE
 135             IMCKOV = 0
 136          ENDIF
 137 *
 138 *
 139 *  **   Update precomputed quantities
 140 *
 141          IMULL = IMULS
 142          IF (ILOSS.LE.0) THEN
 143             DEEMAX = 0.
 144             ILOSL = 0
 145          ELSEIF (DEEMAX.GT.0.) THEN
 146             ILOSL = ILOSS
 147          ELSE
 148             ILOSL = 0
 149          ENDIF
 150       ENDIF
 151 *
 152       IF(LSAMVL) THEN
 153 *
 154 *       If now the particle is entering in the same volume where
 155 *       it was exiting from last step, and if it has done this for
 156 *       more than 5 times, we decrease the precision of tracking
 157          NSTOUT=NSTOUT+1
 158          IF(MOD(NSTOUT,5).EQ.0) THEN
 159             EPSCUR=NSTOUT*EPSMAC
 160 *            WRITE(CHMAIL,10000)ITRA,ISTAK,NTMULT,NAPART
 161 *10000          FORMAT(' *** GTRACK *** Boundary loop: track ',
 162 *     +         I4,' stack ',I4,' NTMULT ',I5,1X,5A4)
 163 *            CALL GMAIL(1,0)
 164 *            WRITE (CHMAIL,10250) IEVENT,IDEVT,(NRNDM(I),I = 1,2)
 165 *            CALL GMAIL(0,0)
 166 *            WRITE(CHMAIL,10100) EPSCUR
 167 *10100          FORMAT('                Precision now set to ',G10.3)
 168 *            CALL GMAIL(0,1)
 169          ENDIF
 170       ELSE
 171          NSTOUT = 0
 172          EPSCUR = EPSMAC
 173       ENDIF
 174 *
 175       INWVOL = 1
 176 *
 177 * *** Compute SET and DET number if volume is sensitive
 178 *
 179       IF (JSET.GT.0) THEN
 180          IF(ISVOL.GT.0) THEN
 181             CALL GFINDS
 182          ELSE
 183             IHSET = 0
 184             IHDET = 0
 185             ISET = 0
 186             IDET = 0
 187             IDTYPE = 0
 188             NVNAME = 0
 189          ENDIF
 190       ENDIF
 191 *
 192 *    Clear step dependent variables
 193 *
 194    80 NMEC   = 0
 195       STEP   = 0.
 196       DESTEL = 0.
 197       DESTEP = 0.
 198       NGKINE = 0
 199       NGPHOT = 0.
 200       IGNEXT = 0
 201       INWOLD = INWVOL
 202       PREC   = MAX(PRECOR,MAX(ABS(VECT(1)),ABS(VECT(2)),
 203      +                        ABS(VECT(3)),SLENG)*EPSCUR)
 204 *
 205 *     Give control to user at entrance of volume (INWVOL=1)
 206 *
 207       IF (INWVOL.EQ.1) THEN
 208 #if !defined(CERNLIB_USRJMP)
 209          CALL GUSTEP
 210 #endif
 211 #if defined(CERNLIB_USRJMP)
 212          CALL JUMPT0(JUSTEP)
 213 #endif
 214          IF (ISTOP.NE.0) GO TO 999
 215          INWVOL = 0
 216       ENDIF
 217 *
 218 * *** Propagate particle up to next volume boundary or end of track
 219 *
 220       INGOTO = 0
 221       NLEVIN = NLEVEL
 222       IF (IPARAM.NE.0) THEN
 223          IF (GEKIN.LE.PACUTS(ITRTYP)) THEN
 224             NMEC = NMEC+1
 225             LMEC(NMEC) = 26
 226             ISTOP = 2
 227 #if !defined(CERNLIB_USRJMP)
 228             CALL GUPARA
 229 #endif
 230 #if defined(CERNLIB_USRJMP)
 231             CALL JUMPT0(JUPARA)
 232 #endif
 233             GO TO 90
 234          ENDIF
 235       ENDIF
 236       IF      (ITRTYP.EQ.1) THEN
 237          CALL GTGAMA
 238       ELSE IF (ITRTYP.EQ.2) THEN
 239          CALL GTELEC
 240       ELSE IF (ITRTYP.EQ.3) THEN
 241          CALL GTNEUT
 242       ELSE IF (ITRTYP.EQ.4) THEN
 243          CALL GTHADR
 244       ELSE IF (ITRTYP.EQ.5) THEN
 245          CALL GTMUON
 246       ELSE IF (ITRTYP.EQ.6) THEN
 247          CALL GTNINO
 248       ELSE IF (ITRTYP.EQ.7) THEN
 249          CALL GTCKOV
 250       ELSE IF (ITRTYP.EQ.8) THEN
 251          CALL GTHION
 252       ENDIF
 253       IF(JGSTAT.NE.0) CALL GFSTAT(10+ITRTYP)
 254       STLOSS=STEP
 255 *
 256 *     Check for possible endless loop
 257 *
 258    90 NSTEP = NSTEP +1
 259       IF (NSTEP.GT.MAXNST) THEN
 260          IF (ISTOP.EQ.0) THEN
 261             ISTOP = 99
 262             NMEC  = NMEC +1
 263             LMEC(NMEC) = 30
 264             WRITE(CHMAIL,10200) MAXNST
 265             CALL GMAIL(1,0)
 266             CALL GPCXYZ
 267             WRITE(CHMAIL,10250) IEVENT,IDEVT,(NRNDM(I),I=1,2),TOFG*1.E9
 268             CALL GMAIL(0,1)
 269 10200       FORMAT(' *** GTRACK *** More than ',I6,
 270      +             ' steps, tracking abandoned!')
 271 10250       FORMAT(' IEVENT ',I7,' IDEVT ',I7,' Random Seeds ',I10,2X
 272      $           ,I10,' Time of flight ',F10.3,' ns')
 273          ENDIF
 274       ENDIF
 275 *
 276 * *** Give control to user at end of each tracking step
 277 *
 278       SAFETY = SAFETY -STEP
 279 #if !defined(CERNLIB_USRJMP)
 280       CALL GUSTEP
 281 #endif
 282 #if defined(CERNLIB_USRJMP)
 283       CALL JUMPT0(JUSTEP)
 284 #endif
 285 *
 286       IF (ISTOP.NE.0) GO TO 999
 287 *
 288 *      Renormalize direction cosines
 289 *
 290       PMOM = SQRT(VECT(4)**2+VECT(5)**2+VECT(6)**2)
 291       IF(PMOM.GT.0.) THEN
 292          CMOD = 1./PMOM
 293          VECT(4) = VECT(4)*CMOD
 294          VECT(5) = VECT(5)*CMOD
 295          VECT(6) = VECT(6)*CMOD
 296       ENDIF
 297 *                                        force update of alternatives:
 298       IF (INWVOL.EQ.0) then
 299          if (GONLY(NLEVEL).eq.0.and.Safety.le.0.and.Iswit(10).ge.0)
 300      +        CALL GTMEDI(VECT,NMED)
 301          GO TO 80
 302       endif
 303 *
 304       IF (NJTMAX.GT.0) THEN
 305          CALL GSTRAC
 306          IF (NLEVIN.EQ.0) GO TO 100
 307          GO TO 999
 308       ELSE
 309          IF (NLEVIN.GE.NLEVEL) THEN
 310             INFROM = 0
 311          ELSE
 312             IF (NLEVIN.EQ.0) GO TO 100
 313             INFROM = LINDEX(NLEVIN+1)
 314          ENDIF
 315          IF (NLEVIN.NE.NLEVEL) INGOTO = 0
 316          NLEVEL = NLEVIN
 317 *
 318          CALL GTMEDI (VECT, NUMED)
 319          IF (NUMED.NE.0) THEN
 320             SAFETY = 0.
 321             GO TO 10
 322          ENDIF
 323       ENDIF
 324 *
 325 *     Track outside setup, give control to user (INWVOL=3)
 326 *
 327   100 INWVOL = 3
 328       ISTOP  = 1
 329       ISET   = 0
 330       IDET   = 0
 331       NMEC   = 0
 332       STEP   = 0.
 333       DESTEL = 0.
 334       DESTEP = 0.
 335       NGKINE = 0
 336       NLCUR  = NLEVEL
 337       NLEVEL = 1
 338 #if !defined(CERNLIB_USRJMP)
 339       CALL GUSTEP
 340 #endif
 341 #if defined(CERNLIB_USRJMP)
 342       CALL JUMPT0(JUSTEP)
 343 #endif
 344       NLEVEL = NLCUR
 345 *                                                             END GTRACK
 346   999 END