GEANT321/gphys/grangi.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:33  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.23  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GRANGI
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *  Calculates the stopping range , in cm.                        *
  17 C.    *     (i.e. the maximum step due to the continuous energy loss)  *
  18 C.    *      The stopping range is the integral of the inverse of the  *
  19 C.    *      DE/DX table.                                              *
  20 C.    *     There are 4 tables : electron,positron,muon,proton         *
  21 C.    *                                                                *
  22 C.    *    ==>Called by : GPHYSI                                       *
  23 C.    *       Author      M.Maire   *********                          *
  24 C.    *                                                                *
  25 C.    ******************************************************************
  26 C.
  27 #include "geant321/gcbank.inc"
  28 #include "geant321/gctrak.inc"
  29 #include "geant321/gcjloc.inc"
  30 #include "geant321/gcmulo.inc"
  31 #include "geant321/gconsp.inc"
  32 #include "geant321/gcmate.inc"
  33 #if !defined(CERNLIB_SINGLE)
  34       DOUBLE PRECISION RANGMU, RANGEL, RANGPO, RANGPR
  35       DOUBLE PRECISION DDXEL1, DDXMU1, DDXPR1, DDXPO1
  36       DOUBLE PRECISION DDXEL2, DDXMU2, DDXPR2, DDXPO2
  37       DOUBLE PRECISION DDXEL3, DDXMU3, DDXPR3, DDXPO3
  38       DOUBLE PRECISION HFACT, ONE, TEN, HLOG10, HFACT2, HFACT3
  39 #endif
  40       PARAMETER (ONE=1,TEN=10)
  41 *
  42       HLOG10 = LOG(TEN)
  43 *
  44       JRANEL = LQ(JMA-15)
  45       JRANPO = LQ(JMA-15)+NEK1
  46       JRANMU = LQ(JMA-16)
  47       JRANPR = LQ(JMA-16)+NEK1
  48 *
  49       IF(Z.LT.1) THEN
  50          DO 10  IEKBIN=1,NEK1
  51             Q(JRANEL+IEKBIN)=BIG
  52             Q(JRANPO+IEKBIN)=BIG
  53             Q(JRANMU+IEKBIN)=BIG
  54             Q(JRANPR+IEKBIN)=BIG
  55    10    CONTINUE
  56 *
  57       ELSE
  58          SMALL = 1./BIG
  59          JLOSEL = LQ(JMA-1)
  60          JLOSPO = LQ(JMA-1)+NEK1
  61          JLOSMU = LQ(JMA-2)
  62          JLOSPR = LQ(JMA-3)
  63 *
  64          JWSPEL =         -1
  65          JWSPPO = NEKBIN  -1
  66          JWSPMU = NEKBIN*2-1
  67          JWSPPR = NEKBIN*3-1
  68 *
  69          RANGPO = 0.
  70          RANGMU = 0.
  71          RANGEL = 0.
  72          RANGPR = 0.
  73 *
  74          Q(JRANEL+1)=0.
  75          Q(JRANPO+1)=0.
  76          Q(JRANMU+1)=0.
  77          Q(JRANPR+1)=0.
  78 *
  79          HFACT = ONE/(6.*GEKA)
  80 *
  81          DDXEL3 = ELOW(1)*HLOG10/MAX(Q(JLOSEL+1),SMALL)
  82          DDXMU3 = ELOW(1)*HLOG10/MAX(Q(JLOSMU+1),SMALL)
  83          DDXPR3 = ELOW(1)*HLOG10/MAX(Q(JLOSPR+1),SMALL)
  84          DDXPO3 = ELOW(1)*HLOG10/MAX(Q(JLOSPO+1),SMALL)
  85 *
  86          HFACT2 = HLOG10*TEN**(EKBIN(1)+0.5/GEKA)
  87 *
  88          DO 20 IEKBIN=2,NEK1
  89 *
  90             HFACT3 = ELOW(IEKBIN)*HLOG10
  91 *
  92 * *** Electrons
  93 *
  94             DDXEL1 = DDXEL3
  95             DDXEL3 = HFACT3/MAX(Q(JLOSEL+IEKBIN),SMALL)
  96             DDXEL2 = HFACT2/MAX(WS(JWSPEL+IEKBIN),SMALL)
  97             RANGEL = RANGEL+DDXEL1+4.*DDXEL2+DDXEL3
  98             Q(JRANEL+IEKBIN)=RANGEL*HFACT
  99 *
 100 * *** Positons
 101 *
 102             DDXPO1 = DDXPO3
 103             DDXPO3 = HFACT3/MAX(Q(JLOSPO+IEKBIN),SMALL)
 104             DDXPO2 = HFACT2/MAX(WS(JWSPPO+IEKBIN),SMALL)
 105             RANGPO = RANGPO+DDXPO1+4.*DDXPO2+DDXPO3
 106             Q(JRANPO+IEKBIN)=RANGPO*HFACT
 107 *
 108 * *** Muons
 109 *
 110             DDXMU1 = DDXMU3
 111             DDXMU3 = HFACT3/MAX(Q(JLOSMU+IEKBIN),SMALL)
 112             DDXMU2 = HFACT2/MAX(WS(JWSPMU+IEKBIN),SMALL)
 113             RANGMU = RANGMU+DDXMU1+4.*DDXMU2+DDXMU3
 114             Q(JRANMU+IEKBIN)=RANGMU*HFACT
 115 *
 116 * *** Protons
 117 *
 118             DDXPR1 = DDXPR3
 119             DDXPR3 = HFACT3/MAX(Q(JLOSPR+IEKBIN),SMALL)
 120             DDXPR2 = HFACT2/MAX(WS(JWSPPR+IEKBIN),SMALL)
 121             RANGPR = RANGPR+DDXPR1+4.*DDXPR2+DDXPR3
 122             Q(JRANPR+IEKBIN)=RANGPR*HFACT
 123 *
 124             HFACT2 = HLOG10*TEN**(EKBIN(1)+(IEKBIN-0.5)/GEKA)
 125 *
 126    20    CONTINUE
 127       ENDIF
 128 *
 129       END