GEANT321/gphys/gmulof.F

   1 #include "geant321/pilot.h"
   2 *CMZ :  3.21/02 29/03/94  15.41.22  by  S.Giani
   3 *-- Author :
   4       SUBROUTINE GMULOF
   5 C.
   6 C.    ******************************************************************
   7 C.    *                                                                *
   8 C.    *  Calculates table of steps for multiple scattering             *
   9 C.    *     energy loss and magnetic field for electrons,muons         *
  10 C.    *           (cannot be tabuled for hadrons)                      *
  11 C.    *   : smuls  = min (Tbethe , 10*radl)                            *
  12 C.    *   : sloss  = DEEMAX*GEKIN/DEDX                                 *
  13 C.    *   : sfield = CFLD*P                                            *
  14 C.    *                                                                *
  15 C.    *    ==>Called by : GPHYSI                                       *
  16 C.    *       Authors    R.Brun, Y.Dufour, M.Maire  *********          *
  17 C.    *                                                                *
  18 C.    ******************************************************************
  19 C.
  20 #include "geant321/gcbank.inc"
  21 #include "geant321/gcjloc.inc"
  22 #include "geant321/gconsp.inc"
  23 #include "geant321/gcmulo.inc"
  24 #include "geant321/gckine.inc"
  25 #include "geant321/gcmate.inc"
  26 #include "geant321/gctrak.inc"
  27 #include "geant321/gcking.inc"
  28 #include "geant321/gctmed.inc"
  29 #include "geant321/gccuts.inc"
  30 #include "geant321/gcphys.inc"
  31 *
  32       LOGICAL CERKOV
  33 *
  34 *-----------------------------------------------------------------------
  35 *
  36       SMULS  = BIG
  37       SLOSS  = BIG
  38       SFIELD = BIG
  39       STOPMX = BIG
  40       STCKOV = BIG
  41       JPROB  = LQ(JMA-4)
  42       JMIXT  = LQ(JMA-5)
  43       OMC    = Q(JPROB+21)
  44       CHC2   = Q(JPROB+25)**2
  45       NLMAT=Q(JMA+11)
  46       NLM=IABS(NLMAT)
  47       IF (FIELDM.NE.0.) CFLD = 3333.*DEGRAD*TMAXFD/ABS(FIELDM)
  48 *
  49       IF(ITCKOV.NE.0.AND.IQ(JTM-2).GE.3.AND. LQ(JTM-3)
  50      +.NE.0.AND.LQ(LQ(JTM-3)-3).NE.0) THEN
  51 *
  52 * ***  In this tracking medium Cerenkov photons are generated and
  53 * ***  tracked. Set to 1 the corresponding flag and calculate the
  54 * ***  relevant pointers.
  55 *
  56          CERKOV = .TRUE.
  57          JTCKOV = LQ(JTM-3)
  58          JABSCO = LQ(JTCKOV-1)
  59          JEFFIC = LQ(JTCKOV-2)
  60          JINDEX = LQ(JTCKOV-3)
  61          JCURIN = LQ(JTCKOV-4)
  62          NPCKOV = Q(JTCKOV+1)
  63       ELSE
  64          CERKOV = .FALSE.
  65       ENDIF
  66 *
  67 * *** Electrons
  68 *
  69       JRANG = LQ(JMA-15)
  70       IKCUT = MAX((GEKA*LOG10(CUTELE) + GEKB),1.)
  71       GKC   = (CUTELE-ELOW(IKCUT))/(ELOW(IKCUT+1)-ELOW(IKCUT))
  72       STOPC = (1.-GKC)*Q(JRANG+IKCUT) + GKC*Q(JRANG+IKCUT+1)
  73       JMULOF = LQ(JTM-1)
  74       Q(JMULOF+NEK1+1) = IKCUT
  75       Q(JMULOF+NEK1+2) = STOPC
  76 *
  77 * *** Recompute STMIN ?
  78 *     set STMIN to the range of an electron at energy=CUTELE + 200KeV
  79 *     divided by sqrt(RADL) (important for light materials)
  80 *
  81       IF(STMIN.LT.0.)THEN
  82          XES=CUTELE+2.E-4
  83          IKS = MAX((GEKA*LOG10(XES) + GEKB),1.)
  84          GKS   = (XES-ELOW(IKS))/(ELOW(IKS+1)-ELOW(IKS))
  85          STMIN = (1.-GKS)*Q(JRANG+IKS) + GKS*Q(JRANG+IKS+1) - STOPC
  86          IF(Q(JTM+7).EQ.0.)THEN
  87             STMIN = 2.*STMIN/SQRT(RADL)
  88          ELSE
  89             STMIN = 5.*STMIN/RADL
  90          ENDIF
  91       ENDIF
  92       Q(JTM+14)=STMIN
  93 *
  94       DO 10 IEKBIN=1,NEK1
  95          GEKIN = ELOW(IEKBIN)
  96          GETOT = GEKIN + EMASS
  97          PMOM2 = GEKIN*(GETOT+EMASS)
  98          PMOM  = SQRT(PMOM2)
  99          BETA2 = PMOM2/(GETOT**2)
 100 *
 101          IF (IMULS.GT.0.) THEN
 102             IF(JMIXT.LE.0)THEN
 103                CALL GMOLIO(A,Z,1.,1,DENS,BETA2,1.,OMC)
 104             ELSE
 105                CALL GMOLIO(Q(JMIXT+1),Q(JMIXT+NLM+1),Q(JMIXT+2*NLM+1),
 106      +                    NLM,DENS,BETA2,1.,OMC)
 107             ENDIF
 108             PMCH2  = PMOM2/CHC2
 109             TBETHE = (PMCH2*BETA2)/LOG(OMC*PMCH2)
 110             TMXCOR = 2232.*RADL*PMOM2*BETA2
 111             SMULS  = MIN(TBETHE,TMXCOR,10.*RADL)
 112          ENDIF
 113 *
 114          IF (IFIELD*FIELDM.NE.0.) THEN
 115             SFIELD = CFLD*PMOM
 116          ENDIF
 117 *
 118          IF (ILOSS*DEEMAX.GT.0.) THEN
 119             IF (IEKBIN.LE.IKCUT) THEN
 120                STOPMX = 0.
 121                SLOSS  = 0.
 122             ELSE
 123                STOPMX = Q(JRANG+IEKBIN)
 124                EKF = (1.-DEEMAX)*GEKIN
 125                IF (EKF.LE.ELOW(1)) EKF = ELOW(1)
 126                IKF = MAX((GEKA*LOG10(EKF) + GEKB),1.)
 127                GKR = (EKF-ELOW(IKF))/(ELOW(IKF+1)-ELOW(IKF))
 128                SLOSS = STOPMX-(1.-GKR)*Q(JRANG+IKF)-GKR*Q(JRANG+IKF+1)
 129                IF (SLOSS.LE.0.) SLOSS = 0.
 130                STOPMX = STOPMX-STOPC
 131                IF (STOPMX.LE.0.) STOPMX = 0.
 132             ENDIF
 133          ENDIF
 134          IF(CERKOV) THEN
 135             CHARGE = 1.
 136             VECT(7) = PMOM
 137             CALL GNCKOV
 138             STCKOV = MXPHOT/MAX(3.*DNDL,1E-10)
 139          ENDIF
 140 *
 141          STEP = MIN(SMULS,SLOSS,SFIELD,STCKOV)
 142          IF (STEP.LT.STMIN) THEN
 143             STEP = MIN(STMIN,STOPMX)
 144          ENDIF
 145          Q(JMULOF+IEKBIN) = STEP
 146    10 CONTINUE
 147       DO 20 I=1,IKCUT
 148          Q(JMULOF+I)=0.5*Q(JMULOF+IKCUT+1)
 149    20 CONTINUE
 150 *
 151 * *** Muons
 152 *
 153       JRANG = LQ(JMA-16)
 154       IKCUT = GEKA*LOG10(CUTMUO) + GEKB
 155       GKC   = (CUTMUO-ELOW(IKCUT))/(ELOW(IKCUT+1)-ELOW(IKCUT))
 156       STOPC = (1.-GKC)*Q(JRANG+IKCUT) + GKC*Q(JRANG+IKCUT+1)
 157       JMULOF = LQ(JTM-2)
 158       Q(JMULOF+NEK1+1)=IKCUT
 159       Q(JMULOF+NEK1+2)=STOPC
 160 *
 161       DO 30 IEKBIN=1,NEK1
 162          GEKIN = ELOW(IEKBIN)
 163          GETOT = GEKIN + EMMU
 164          PMOM2 = GEKIN*(GETOT+EMMU)
 165          PMOM  = SQRT(PMOM2)
 166          BETA2 = PMOM2/(GETOT**2)
 167 *
 168          IF (IMULS.GT.0.) THEN
 169             IF(JMIXT.LE.0)THEN
 170                CALL GMOLIO(A,Z,1.,1,DENS,BETA2,1.,OMC)
 171             ELSE
 172                CALL GMOLIO(Q(JMIXT+1),Q(JMIXT+NLM+1),Q(JMIXT+2*NLM+1),
 173      +                    NLM,DENS,BETA2,1.,OMC)
 174             ENDIF
 175             PMCH2  = PMOM2/CHC2
 176             TBETHE = (PMCH2*BETA2)/LOG(OMC*PMCH2)
 177             TMXCOR = 2232.*RADL*PMOM2*BETA2
 178             SMULS  = MIN(TBETHE,TMXCOR,10.*RADL)
 179          ENDIF
 180 *
 181          IF (IFIELD*FIELDM.NE.0.) THEN
 182             SFIELD = CFLD*PMOM
 183          ENDIF
 184 *
 185          IF (ILOSS*DEEMAX.GT.0.) THEN
 186             IF (IEKBIN.LE.IKCUT) THEN
 187                STOPMX = 0.
 188                SLOSS  = 0.
 189             ELSE
 190                STOPMX = Q(JRANG+IEKBIN)
 191                EKF = (1.-DEEMAX)*GEKIN
 192                IF (EKF.LE.ELOW(1)) EKF = ELOW(1)
 193                IKF = GEKA*LOG10(EKF) + GEKB
 194                GKR = (EKF-ELOW(IKF))/(ELOW(IKF+1)-ELOW(IKF))
 195                SLOSS = STOPMX-(1.-GKR)*Q(JRANG+IKF)-GKR*Q(JRANG+IKF+1)
 196                IF (SLOSS.LE.0.) SLOSS = 0.
 197                STOPMX = STOPMX-STOPC
 198                IF (STOPMX.LE.0.) STOPMX = 0.
 199             ENDIF
 200          ENDIF
 201          IF(CERKOV) THEN
 202             CHARGE = 1.
 203             VECT(7) = PMOM
 204             CALL GNCKOV
 205             STCKOV = MXPHOT/MAX(3.*DNDL,1E-10)
 206          ENDIF
 207 *
 208          STEP = MIN(SMULS,SLOSS,SFIELD,STCKOV)
 209          IF (STEP.LT.STMIN) THEN
 210             STEP = MIN(STMIN,STOPMX)
 211          ENDIF
 212          Q(JMULOF+IEKBIN) = STEP
 213    30 CONTINUE
 214       DO 40 I=1,IKCUT
 215          Q(JMULOF+I)=0.5*Q(JMULOF+IKCUT+1)
 216    40 CONTINUE
 217 *
 218       END