GEANT321/gphys/gprela.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:32  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 GPRELA
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *  Initialise energy loss due to direct pair-production  and     *
  17 C.    *  nuclear interactions by muons.                                *
  18 C.    *                                                                *
  19 C     *       A, Direct pair production  <=======                      *
  20 C     *                                                                *
  21 C.    *  The DE/DX expression of MANDO and RONCHI(NUOVO CIMENTO        *
  22 C.    *  9(1952),517) is used which attempts to account for the effect *
  23 C.    *  of atomic electron screening. The screening correction is     *
  24 C.    *  applied above the energy limit defined by C. RICHARD-SERRE    *
  25 C.    *  (CERN 71-18).                                                 *
  26 C.    *                                                                *
  27 C     *       B, Nuclear interactions  <=======                        *
  28 C.    *                                                                *
  29 C.    *  the following expression derived from the Williams-Weizsacker *
  30 C.    *  relation for the virtual photon flux is used :                *
  31 C.    *                                                                *
  32 C.    *      DE/DX = FACTOR * XSEC * E                                 *
  33 C.    *                                                                *
  34 C.    *      where,                                                    *
  35 C.    *      FACTOR  =  2. * N * ALPHA / PI                            *
  36 C.    *      XSEC    =  total photo-nuclear cross-section assumed to   *
  37 C.    *                 be independent of energy. Value of 140 mubarns *
  38 C.    *                 calculated by averaging the results of Hesse   *
  39 C.    *                 et al(Phys. Rev. Lett 25(1970),613).           *
  40 C.    *                                                                *
  41 C.    *    ==>Called by : GPHYSI                                       *
  42 C.    *       Author    G.Patrick  *********                           *
  43 C.    *                                                                *
  44 C.    ******************************************************************
  45 C.
  46 #include "geant321/gcbank.inc"
  47 #include "geant321/gcjloc.inc"
  48 #include "geant321/gcmulo.inc"
  49 #include "geant321/gcmate.inc"
  50 #include "geant321/gcphys.inc"
  51 #include "geant321/gconsp.inc"
  52 #include "geant321/gccuts.inc"
  53 #include "geant321/gctrak.inc"
  54       DATA XSEC  /140.E-30/
  55       DATA FACTOR/2.7976238E+21/
  56 C.
  57 C.    ------------------------------------------------------------------
  58 C.
  59       IF(Z.LT.1.) GOTO 999
  60       ICHAN=IEKBIN
  61       T    = ELOW(ICHAN)
  62       T1   = 10.**(EKBIN(1)+(ICHAN-0.5)/GEKA)
  63       IF(T.LT.1.)GO TO 999
  64       E    = T+EMMU
  65       E1   = T1+EMMU
  66       IF(JMIXT.EQ.0)THEN
  67 C
  68 C           Element
  69 C
  70          DEDX = GPRELM(Z,T,PPCUTM)
  71          DEDX = AVO*DENS*DEDX/A
  72 *
  73 * *** auxiliary integration point for Range tables
  74          IF(ICHAN.NE.NEK1) THEN
  75             DEDX1 = GPRELM(Z,T1,PPCUTM)
  76             DEDX1 = AVO*DENS*DEDX1/A
  77          ENDIF
  78       ELSE
  79 C
  80 C          Compound/Mixture
  81 C
  82          NLMAT = Q(JMA+11)
  83          NLM   = IABS(NLMAT)
  84          DEDX  = 0.
  85          DEDX1 = 0.
  86          DO 10 L=1,NLM
  87             J    = JMIXT+NLM+L
  88             AA   = Q(J-NLM)
  89             ZZ   = Q(J)
  90             WMAT = Q(J+NLM)
  91             S    = GPRELM(ZZ,T,PPCUTM)
  92             S    = WMAT*S/AA
  93             DEDX = DEDX+AVO*DENS*S
  94 *
  95 * *** auxiliary integration point for Range tables
  96             IF(ICHAN.NE.NEK1) THEN
  97                S = GPRELM(ZZ,T1,PPCUTM)
  98                S = WMAT*S/AA
  99                DEDX1 = DEDX1+AVO*DENS*S
 100             ENDIF
 101    10    CONTINUE
 102       ENDIF
 103 C
 104 C             Nuclear interactions
 105 C
 106       IF(IMUNU.EQ.0.AND.E.GE.10.) THEN
 107          DENU=DENS*FACTOR*XSEC*E
 108 *
 109 * *** auxiliary integration point for Range tables
 110          IF(ICHAN.NE.NEK1) THEN
 111             DENU1=DENS*FACTOR*XSEC*E1
 112          ENDIF
 113       ELSE
 114          DENU=0.0
 115          DENU1=0.0
 116       ENDIF
 117       IF(DEDX.LT.0.)DEDX=0.
 118       IF(DENU.LT.0.)DENU=0.
 119       JEL2=LQ(JMA-2)
 120       Q(JEL2+ICHAN)=Q(JEL2+ICHAN)+DEDX+DENU
 121 *
 122 * *** auxiliary integration point for Range tables
 123       IF(ICHAN.NE.NEK1) THEN
 124          IF(DEDX1.LT.0.)DEDX1=0.
 125          IF(DENU1.LT.0.)DENU1=0.
 126          WS(NEKBIN*2+ICHAN)=WS(NEKBIN*2+ICHAN)+DEDX1+DENU1
 127       ENDIF
 128 C
 129   999 END