GEANT321/gtrak/gtrack.F.ori

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