GEANT321/erdecks/ertrgo.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/03/06 15:37:35  mclareni
   6 * Add geane321 source directories
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.49  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE ERTRGO
  13 *
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *       Perform the tracking of the track                        *
  17 C.    *       Track parameters are in VECT                             *
  18 C.    *                                                                *
  19 C.    *    ==>Called by : ERTRAK                                       *
  20 C.    *       Original routines : GTRACK + GTVOL                       *
  21 C.    *       Authors   M.Maire, E.Nagy  *********                     *
  22 C.    *                                                                *
  23 C.    ******************************************************************
  24 C.
  25 #include "geant321/gcbank.inc"
  26 #include "geant321/gcjloc.inc"
  27 #include "geant321/gccuts.inc"
  28 #include "geant321/gconst.inc"
  29 #include "geant321/gcphys.inc"
  30 #include "geant321/gckine.inc"
  31 #include "geant321/gcflag.inc"
  32 #include "geant321/gctmed.inc"
  33 #include "geant321/gcmate.inc"
  34 #include "geant321/gctrak.inc"
  35 #include "geant321/gcvolu.inc"
  36 #include "geant321/gcunit.inc"
  37 #include "geant321/gcnum.inc"
  38 #include "geant321/ertrio.inc"
  39 #include "geant321/erwork.inc"
  40       COMMON/GCCHAN/LSAMVL
  41       LOGICAL LSAMVL
  42 *
  43 *
  44       DIMENSION CUTS(10),MECA(5,12)
  45       EQUIVALENCE (CUTS(1),CUTGAM),(MECA(1,1),IPAIR)
  46       DIMENSION NAMIN(15),NUMIN(15),NAMOUT(15),NUMOUT(15)
  47 *
  48       SAVE PRECOR,NSTOUT
  49 #if (!defined(CERNLIB_SINGLE))&&(!defined(CERNLIB_IBM))
  50       PARAMETER (EPSMAC=5.E-6)
  51 #endif
  52 #if (!defined(CERNLIB_SINGLE))&&(defined(CERNLIB_IBM))
  53       PARAMETER (EPSMAC=5.E-5)
  54 #endif
  55 #if defined(CERNLIB_SINGLE)
  56       PARAMETER (EPSMAC=1.E-11)
  57 #endif
  58 C.
  59 C.    ------------------------------------------------------------------
  60 *
  61       NSTOUT = 0
  62       EPSCUR = EPSMAC
  63       LSAMVL = .FALSE.
  64       SLENG  = 0.
  65       ISTOP  = 0
  66       NUMED  = 0
  67       NUMOLD = 0
  68       IUPD   = 0
  69       NMEC   = 0
  70       INGOTO = 0
  71       INFROM = 0
  72       SAFETY = 0.
  73       MXNSTP = 1000
  74       NSTEP  = 0
  75 *
  76       CALL GMEDIA(VECT,NUMED)
  77       IF (NUMED.EQ.0) GO TO 200
  78 *
  79 * *** Come back here each time we enter into a new volume
  80 *
  81    10 CONTINUE
  82 *
  83 * *** Get tracking medium and material parameters
  84       IF (NUMED.NE.NUMOLD) THEN
  85          NUMOLD = NUMED
  86          IUPD   = 0
  87          JTM = LQ(JTMED- NUMED)
  88          DO 20 I=1,5
  89             NATMED(I)=IQ(JTM+I)
  90   20     CONTINUE
  91          NMAT   = Q(JTM + 6)
  92          ISVOL  = Q(JTM + 7)
  93          IFIELD = Q(JTM + 8)
  94          FIELDM = Q(JTM + 9)
  95          TMAXFD = Q(JTM + 10)
  96          DMAXMS = Q(JTM + 11)
  97          DEEMAX = Q(JTM + 12)
  98          EPSIL  = Q(JTM + 13)
  99          STMIN  = Q(JTM + 14)
 100          PRECOR   = MIN(0.1*EPSIL, 0.0010)
 101 *
 102          IF(LQ(JTM).EQ.0)THEN
 103             IF(ISTPAR.NE.0)THEN
 104                DO 30 I=1,10
 105                   CUTS(I)=Q(JTMED+I)
 106   30           CONTINUE
 107                DO 40 I=1,12
 108                   MECA(1,I)=Q(JTMED+10+I)
 109   40           CONTINUE
 110                ISTPAR=0
 111             ENDIF
 112          ELSE
 113             JTMN=LQ(JTM)
 114             DO 50 I=1,10
 115                CUTS(I)=Q(JTMN+I)
 116   50        CONTINUE
 117             DO 60 I=1,12
 118                MECA(1,I)=Q(JTMN+10+I)
 119   60        CONTINUE
 120             ILABS = Q(JTMN+10+21)
 121             ISYNC = Q(JTMN+10+22)
 122             ISTRA = Q(JTMN+10+23)
 123             ISTPAR=1
 124          ENDIF
 125 *
 126          JMA  = LQ(JMATE- NMAT)
 127          JPROB=LQ(JMA-4)
 128          JMIXT=LQ(JMA-5)
 129          DO 70 I=1,5
 130   70     NAMATE(I)=IQ(JMA+I)
 131          A    = Q(JMA + 6)
 132          Z    = Q(JMA + 7)
 133          DENS = Q(JMA + 8)
 134          RADL = Q(JMA + 9)
 135          ABSL = Q(JMA + 10)
 136       ENDIF
 137 *
 138       IF(LSAMVL) THEN
 139 *
 140 *       If now the particle is entering in the same volume where
 141 *       it was exiting from last step, and if it has done this for
 142 *       more than 5 times, we decrease the precision of tracking
 143          NSTOUT=NSTOUT+1
 144          IF(MOD(NSTOUT,5).EQ.0) THEN
 145             EPSCUR=NSTOUT*EPSMAC
 146             WRITE(CHMAIL,10000)ITRA,ISTAK,NTMULT,NAPART
 147 10000          FORMAT(' *** ERTRGO *** Boundary loop: track ',
 148      +         I4,' stack ',I4,' NTMULT ',I5,1X,5A4)
 149             CALL GMAIL(1,0)
 150             WRITE(CHMAIL,10100) EPSCUR
 151 10100          FORMAT('                Precision now set to ',G10.3)
 152             CALL GMAIL(0,1)
 153          ENDIF
 154       ELSE
 155          NSTOUT = 0
 156          EPSCUR = EPSMAC
 157       ENDIF
 158 *
 159 * *** Initialize magnetic field for EMC package
 160       HI(1) = 0.
 161       HI(2) = 0.
 162       HI(3) = 0.
 163       IF (IFIELD.EQ.3) THEN
 164          HI(3) = FIELDM
 165       ELSEIF (IFIELD.NE.0) THEN
 166          CALL GUFLD (VECT, HI)
 167       ENDIF
 168 *
 169 * *** Control given to user at entrance of volume (INWVOL=1)
 170       INWVOL = 1
 171       NMEC   = 1
 172       LMEC(1) = 29
 173       STEP   = 0.
 174       DESTEP = 0.
 175 *
 176       IF((LEVOLU).AND.(SLENG.GT.0.)) THEN
 177          IMEC = 0
 178          CALL EVOLIO(NVLIN,NAMIN,NUMIN,NVLOUT,NAMOUT,NUMOUT)
 179          DO 80 IPR =1,NEPRED
 180             NAMPR = NAMEER(IPR)
 181             NUMPR = NUMVER(IPR)
 182             IOVPR = IOVLER(IPR)
 183             IF (IOVPR.EQ.1) THEN
 184                IV = IUCOMP(NAMPR,NAMIN ,NVLIN )
 185                IF (IV.NE.0) THEN
 186                   IF (NUMPR.EQ.0) NUMPR = NUMIN (IV)
 187                   IF (NUMPR.EQ.NUMIN (IV)) THEN
 188                      NMEC = NMEC + 1
 189                      LMEC(NMEC) = 27
 190                      INLIST = IPR
 191                      CALL ERSTOR
 192                   ENDIF
 193                ENDIF
 194             ELSE IF (IOVPR.EQ.2) THEN
 195                IV = IUCOMP(NAMPR,NAMOUT,NVLOUT)
 196                IF (IV.NE.0) THEN
 197                   IF (NUMPR.EQ.0) NUMPR = NUMOUT(IV)
 198                   IF (NUMPR.EQ.NUMOUT(IV)) THEN
 199                      NMEC = NMEC + 1
 200                      LMEC(NMEC) = 27
 201                      INLIST = IPR
 202                      CALL ERSTOR
 203                   ENDIF
 204                ENDIF
 205             ENDIF
 206 *
 207    80    CONTINUE
 208 *
 209       ENDIF
 210 *
 211       CALL EUSTEP
 212       IF (ISTOP.NE.0) GO TO 999
 213 *
 214 * *** Particle is propagated up to the next volume boundary
 215 *
 216       INWVOL=0
 217 *
 218 * *** Come back here after each step in the same volume
 219  100  IGNEXT = 0
 220       INGOTO = 0
 221       NLEVIN = NLEVEL
 222       NMEC   = 0
 223       STEP   = 0.
 224       DESTEP = 0.
 225       DEDX2  = 0.
 226       PREC   = MAX(PRECOR,MAX(ABS(VECT(1)),ABS(VECT(2)),
 227      +                        ABS(VECT(3)),SLENG)*EPSCUR)
 228 *
 229       IF(CHARGE.NE.0.) THEN
 230          CALL ERTRCH
 231       ELSE
 232          CALL ERTRNT
 233       ENDIF
 234 *
 235       NSTEP  = NSTEP + 1
 236       IF (NSTEP.GT.MXNSTP) THEN
 237          ISTOP = 99
 238          NMEC  = NMEC + 1
 239          LMEC(NMEC) = 30
 240       ENDIF
 241 *
 242       SAFETY = SAFETY - STEP
 243       TLRAD  = TLRAD  + STEP/RADL
 244       TLGCM2 = TLGCM2 + STEP*DENS
 245 *
 246 * *** Give control to user after each tracking step
 247       CALL EUSTEP
 248 *
 249       IF(ISTOP.NE.0) GO TO 999
 250 *
 251 * *** Renormalize direction cosines
 252       CMOD = 1./SQRT(VECT(4)**2 + VECT(5)**2 + VECT(6)**2)
 253       VECT(4) = VECT(4)*CMOD
 254       VECT(5) = VECT(5)*CMOD
 255       VECT(6) = VECT(6)*CMOD
 256 *
 257       IF (INWVOL.EQ.0) GO TO 100
 258 *
 259 * *** Particle is leaving the volume (INWVOL=2) :
 260 *
 261 *     Save the current volume's tree before leaving the volume
 262       IF(LEVOLU) CALL EVOLIO(NVLIN,NAMIN,NUMIN,NVLOUT,NAMOUT,NUMOUT)
 263 *
 264 *     find the new volume
 265       IF (NLEVIN.GE.NLEVEL) THEN
 266          INFROM = 0
 267       ELSE
 268          IF (NLEVIN.EQ.0) GO TO 200
 269          INFROM = LINDEX (NLEVIN+1)
 270       ENDIF
 271       IF (NLEVIN.NE.NLEVEL) INGOTO = 0
 272       NLEVEL = NLEVIN
 273 *
 274       CALL GTMEDI (VECT,NUMED)
 275       IF (NUMED.NE.0) THEN
 276          SAFETY = 0.
 277          GO TO 10
 278       ENDIF
 279 *
 280 * *** Track outside setup, give control to user (INWVOL=3)
 281   200 INWVOL= 3
 282       ISTOP = 1
 283       NMEC  = NMEC + 1
 284       LMEC(NMEC) = 30
 285       CALL EUSTEP
 286  999  CONTINUE
 287       ILOSL = 0
 288 *
 289       END