GEANT321/gphys/gbrela.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:22  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.21  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GBRELA
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *  Initialize the bremsstrahlung energy loss tables              *
  17 C.    *            ( See L.Urban report)                               *
  18 C.    *                                                                *
  19 C.    *    ==>Called by : GPHYSI                                       *
  20 C.    *       Author    G.Patrick, L.Urban  *********                  *
  21 C.    *                                                                *
  22 C.    ******************************************************************
  23 C.
  24 #include "geant321/gcbank.inc"
  25 #include "geant321/gcmulo.inc"
  26 #include "geant321/gcjloc.inc"
  27 #include "geant321/gctrak.inc"
  28 #include "geant321/gccuts.inc"
  29 #include "geant321/gcmate.inc"
  30 #include "geant321/gconsp.inc"
  31 #include "geant321/gcphys.inc"
  32       DIMENSION DEM(8)
  33       DATA DEM/-6.76228E-1,4.35611E-1,-4.69224E-1,-7.05133E-3,
  34      +        1.31200,-8.07563E-1,-6.96166E-1,3.62549E-1/
  35 C.
  36 C.    ------------------------------------------------------------------
  37 C.
  38 C            Number of constituents(ie. element,mixture or compound).
  39 C
  40       NLMAT = Q(JMA+11)
  41       NLM    = IABS(NLMAT)
  42       IF (NLMAT.EQ.0)                             GO TO 999
  43       IF(Z.LT.1.)                                 GO TO 999
  44 C
  45       JEL1=LQ(JMA-1)
  46       JEL2=LQ(JMA-2)
  47       ICHAN=IEKBIN
  48       XE     = ELOW(ICHAN)
  49       XE1    = 10.**(EKBIN(1)+(ICHAN-0.5)/GEKA)
  50 C
  51 C==========>  A,Bremsstrahlung losses for electrons
  52 C             special treatment for compounds/mixtures
  53 C
  54       IF(JMIXT.EQ.0)THEN
  55 C
  56 C             simple material (element)
  57 C
  58          DEDX=GBRELE(Z,XE,BCUTE)
  59          DEDX=AVO*DENS*DEDX/A
  60 *
  61 * *** auxiliary integration point for Range tables
  62          IF(ICHAN.NE.NEK1) THEN
  63             DEDX1=GBRELE(Z,XE1,BCUTE)
  64             DEDX1=AVO*DENS*DEDX1/A
  65          ENDIF
  66       ELSE
  67 C
  68 C             compound/mixture
  69 C
  70          DEDX=0.
  71          DEDX1=0.
  72          DO 10 L=1,NLM
  73             J = JMIXT+NLM+L
  74             AA = Q(J-NLM)
  75             ZZ = Q(J)
  76             WMAT= Q(J+NLM)
  77             S = GBRELE(ZZ,XE,BCUTE)
  78             S = WMAT*S/AA
  79             DEDX= DEDX+AVO*DENS*S
  80 *
  81 * *** auxiliary integration point for Range tables
  82             IF(ICHAN.NE.NEK1) THEN
  83                S = GBRELE(ZZ,XE1,BCUTE)
  84                S = WMAT*S/AA
  85                DEDX1= DEDX1+AVO*DENS*S
  86             ENDIF
  87    10    CONTINUE
  88       ENDIF
  89 C
  90       IF(DEDX.LT.0.)DEDX=0.
  91       Q(JEL1+ICHAN)=Q(JEL1+ICHAN)+DEDX
  92       FACT = GBFLOS(XE,BCUTE)
  93       Q(JEL1+ICHAN+NEK1)=Q(JEL1+ICHAN+NEK1)+FACT*DEDX
  94 *
  95       IF(ISTRA.NE.0) Q(JEL1+ICHAN+2*NEK1) = DEDX
  96 *
  97 * *** auxiliary integration point for Range tables
  98       IF(ICHAN.NE.NEK1) THEN
  99          IF(DEDX1.LT.0.)DEDX1=0.
 100          WS(ICHAN)=WS(ICHAN)+DEDX1
 101          FACT = GBFLOS(XE1,BCUTE)
 102          WS(NEKBIN+ICHAN)=WS(NEKBIN+ICHAN)+FACT*DEDX1
 103       ENDIF
 104 C
 105 C===========>  B, Bremsstrahlung losses for muons
 106 C
 107       IF(XE.GE.1.)GO TO 20
 108       CONS1=3.26485E-8*Z*Z*DENS/A
 109       CONS2=LOG(2.70511)-LOG(A)/3.
 110       R=EMMU/(XE+EMMU)
 111       RL=LOG(R)
 112       DEDX=DEM(1)+RL*DEM(3)+R*(DEM(5)+R*DEM(7))
 113       DEDX=DEDX+CONS2*(DEM(2)+RL*DEM(4)+R*(DEM(6)+R*DEM(8)))
 114       DEDX=CONS1*XE*DEDX
 115       IF(DEDX.LT.0.)DEDX=0.
 116       Q(JEL2+ICHAN)=Q(JEL2+ICHAN)+DEDX
 117 *
 118       IF(ISTRA.NE.0) Q(JEL2+ICHAN+NEK1) = DEDX
 119 *
 120 * *** auxiliary integration point for Range tables
 121       IF(ICHAN.NE.NEK1) THEN
 122          R=EMMU/(XE1+EMMU)
 123          RL=LOG(R)
 124          DEDX1=DEM(1)+RL*DEM(3)+R*(DEM(5)+R*DEM(7))
 125          DEDX1=DEDX1+CONS2*(DEM(2)+RL*DEM(4)+R*(DEM(6)+R*DEM(8)))
 126          DEDX1=CONS1*XE1*DEDX1
 127          IF(DEDX1.LT.0.)DEDX1=0.
 128          WS(NEKBIN*2+ICHAN) = WS(NEKBIN*2+ICHAN)+DEDX1
 129       ENDIF
 130       GO TO 999
 131 C
 132    20 IF(JMIXT.EQ.0)THEN
 133 C
 134 C             simple material (element)
 135 C
 136          DEDX=GBRELM(Z,XE,BCUTM)
 137          DEDX=AVO*DENS*DEDX/A
 138 *
 139 * *** auxiliary integration point for Range tables
 140          IF(ICHAN.NE.NEK1) THEN
 141             DEDX1=GBRELM(Z,XE1,BCUTM)
 142             DEDX1=AVO*DENS*DEDX1/A
 143          ENDIF
 144       ELSE
 145 C
 146 C             compound/mixture
 147 C
 148          DEDX=0.
 149          DEDX1=0.
 150          DO 30 L=1,NLM
 151             J = JMIXT+NLM+L
 152             AA = Q(J-NLM)
 153             ZZ = Q(J)
 154             WMAT= Q(J+NLM)
 155             S = GBRELM(ZZ,XE,BCUTM)
 156             S = WMAT*S/AA
 157             DEDX= DEDX+AVO*DENS*S
 158 *
 159 * *** auxiliary integration point for Range tables
 160             IF(ICHAN.NE.NEK1) THEN
 161                S = GBRELM(ZZ,XE1,BCUTM)
 162                S = WMAT*S/AA
 163                DEDX1= DEDX1+AVO*DENS*S
 164             ENDIF
 165    30    CONTINUE
 166       ENDIF
 167 C
 168       IF(DEDX.LT.0.)DEDX=0.
 169       Q(JEL2+ICHAN)=Q(JEL2+ICHAN)+DEDX
 170 *
 171       IF(ISTRA.NE.0) Q(JEL2+ICHAN+NEK1) = DEDX
 172 *
 173 * *** auxiliary integration point for Range tables
 174       IF(ICHAN.NE.NEK1) THEN
 175          IF(DEDX1.LT.0.)DEDX1=0.
 176          WS(NEKBIN*2+ICHAN)=WS(NEKBIN*2+ICHAN)+DEDX1
 177       ENDIF
 178 C
 179   999 END