GEANT321/gcons/gsmate.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:16  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.19  by  S.Giani
  11 *FCA :          17/02/99  12:00:00  by  Federico Carminati
  12 *               Calculation of radiation length and interaction length
  13 *               ignoring user input parameters
  14 *-- Author :
  15       SUBROUTINE GSMATE(IMAT,NAMATE,A,Z,DENS,RADL,ABSL,UBUF,NWBUF)
  16 C.
  17 C.    ******************************************************************
  18 C.    *                                                                *
  19 C.    *                                                                *
  20 C.    *       Store material parameters                                *
  21 C.    *                                                                *
  22 C.    *                                                                *
  23 C.    *             The Material data structure JMATE                  *
  24 C.    *             ---------------------------------                  *
  25 C.    *                                                                *
  26 C.    *                                         | JMATE                *
  27 C.    *    NMATE           IMATE                v                      *
  28 C.    *     ......................................                     *
  29 C.    *     |              | |                 | |                     *
  30 C.    *     ......................................                     *
  31 C.    *                     |                                          *
  32 C.    *                     | JMA                                      *
  33 C.    *                     v                                          *
  34 C.    *                    .....................                       *
  35 C.    *                    | 1 |               |                       *
  36 C.    *                    .....               |                       *
  37 C.    *                    | 2 |  Material     |                       *
  38 C.    *                    |...|               |                       *
  39 C.    *                    | 3 |   Name        |                       *
  40 C.    *                    |...|               |                       *
  41 C.    *                    | 4 |               |                       *
  42 C.    *                    |...|               |                       *
  43 C.    *                    | 5 |               |                       *
  44 C.    *                    .....................                       *
  45 C.    *                    | 6 |   A           |                       *
  46 C.    *                    |...|...............|                       *
  47 C.    *                    | 7 |   Z           |                       *
  48 C.    *                    |...|...............|                       *
  49 C.    *                    | 8 |   Density     |                       *
  50 C.    *                    |...|...............|                       *
  51 C.    *                    | 9 |   RADL        |                       *
  52 C.    *                    |...|...............|                       *
  53 C.    *                    | 10|   ABSL        |                       *
  54 C.    *                    |...|...............|                       *
  55 C.    *                    | 11|   NMIXT       |                       *
  56 C.    *                    |...|...............|                       *
  57 C.    *                    |   |               |                       *
  58 C.    *                    .....................                       *
  59 C.    *                                                                *
  60 C.    * JMA = LQ(JMATE-IMATE) pointer to material IMATE                *
  61 C.    *                                                                *
  62 C.    *   When  the subroutine  GPHYSI is  called at  initialisation   *
  63 C.    * time  the following  banks  are  created for  each  material   *
  64 C.    * (tabulation of energy loss and cross-section).                 *
  65 C.    *                                               | JMATE          *
  66 C.    * NMATE                     IMATE               v                *
  67 C.    * ................................................               *
  68 C.    * |                        | |                 | |               *
  69 C.    * ................................................               *
  70 C.    *                           | JMA = LQ(JMATE-IMATE)              *
  71 C.    *                           v                              11    *
  72 C.    * ............................................................   *
  73 C.    * |  13 12 11 10 9 8 7 6 5 4 3 2 1 | |  Material parameters  |   *
  74 C.    * ............................................................   *
  75 C.    *    |  |  |  |  | | | | | | | | |                               *
  76 C.    *    |  |  |  |  | | | | | | | | v  JMAEL = LQ(JMA-1)            *
  77 C.    *    |  |  |  |  | | | | | | | |                         270     *
  78 C.    *    |  |  |  |  | | | | | | | |................................ *
  79 C.    *    |  |  |  |  | | | | | | | ||Energy loss for electron/positro*
  80 C.    *    |  |  |  |  | | | | | | | |............................     *
  81 C.    *    |  |  |  |  | | | | | | | v  JMAMU = LQ(JMA-2)       90     *
  82 C.    *    |  |  |  |  | | | | | | |..............................     *
  83 C.    *    |  |  |  |  | | | | | | ||Energy loss for muons       |     *
  84 C.    *    |  |  |  |  | | | | | | |..............................     *
  85 C.    *    |  |  |  |  | | | | | | v  JMAAL = LQ(JMA-3)         90     *
  86 C.    *    |  |  |  |  | | | | | |................................     *
  87 C.    *    |  |  |  |  | | | | | ||Energy loss for other particles|    *
  88 C.    *    |  |  |  |  | | | | | |................................     *
  89 C.    *    |  |  |  |  | | | | | v  JPROB = LQ(JMA-4)           30     *
  90 C.    *    |  |  |  |  | | | | |..................................     *
  91 C.    *    |  |  |  |  | | | | ||Some material constants         |     *
  92 C.    *    |  |  |  |  | | | | |..................................     *
  93 C.    *    |  |  |  |  | | | | v  JMIXT = LQ(JMA-5)             11     *
  94 C.    *    |  |  |  |  | | | |....................................     *
  95 C.    *    |  |  |  |  | | | ||Mixture or compound parameters    |     *
  96 C.    *    |  |  |  |  | | | |....................................     *
  97 C.    *    |  |  |  |  | | | v  JPHOT = LQ(JMA-6) and JMUNU     90     *
  98 C.    *    |  |  |  |  | | |......................................     *
  99 C.    *    |  |  |  |  | | ||Photo-effect cross-section          |     *
 100 C.    *    |  |  |  |  | | |......................................     *
 101 C.    *    |  |  |  |  | | v  JANNI = LQ(JMA-7)                 90     *
 102 C.    *    |  |  |  |  | |........................................     *
 103 C.    *    |  |  |  |  | ||Positron annihilation cross-section   |     *
 104 C.    *    |  |  |  |  | |........................................     *
 105 C.    *    |  |  |  |  | V  JCOMP = LQ(JMA-8)                   90     *
 106 C.    *    |  |  |  |  |..........................................     *
 107 C.    *    |  |  |  |  ||Compton scattering cross-section        |     *
 108 C.    *    |  |  |  |  |..........................................     *
 109 C.    *    |  |  |  |  V  JBREM = LQ(JMA-9)                     90     *
 110 C.    *    |  |  |  | ............................................     *
 111 C.    *    |  |  |  | |Bremsstrahlung cross-section              |     *
 112 C.    *    |  |  |  | ............................................     *
 113 C.    *    |  |  |  V  JPAIR = LQ(JMA-10)                       90     *
 114 C.    *    |  |  | ...............................................     *
 115 C.    *    |  |  | |Pair production cross-section                |     *
 116 C.    *    |  |  | ...............................................     *
 117 C.    *    |  |  V  JDRAY = LQ(JMA-11)                         210     *
 118 C.    *    |  | ..................................................     *
 119 C.    *    |  | |Moller and Bhabha cross-sections                |     *
 120 C.    *    |  | ..................................................     *
 121 C.    *    |  V  JPFIS = LQ(JMA-12)                             90     *
 122 C.    *    | .....................................................     *
 123 C.    *    | |Photo fission cross section                        |     *
 124 C.    *    | .....................................................     *
 125 C.    *    V  JRAYL = LQ(JMA-13)                                62     *
 126 C.    *   ........................................................     *
 127 C.    *   |Rayleigh scattering cross section and atomic form fact|     *
 128 C.    *   ........................................................     *
 129 C.    * V  JMUNU = LQ(JMA-14)                                  90      *
 130 C.    *   ........................................................     *
 131 C.    * V  JRANG = LQ(JMA-15)                                 180      *
 132 C.    * V........................................................      *
 133 C.    *  |Stopping range for electrons/positrons                |      *
 134 C.    *  ........................................................      *
 135 C.    * V  JRANG = LQ(JMA-16)                                 180      *
 136 C.    * V........................................................      *
 137 C.    *  |Stopping range for muons / other particles            |      *
 138 C.    *  ........................................................      *
 139 C.    *                                                                *
 140 C.    *    ==>Called by : <USER>, UGEOM    ,<GXINT> GINC3              *
 141 C.    *       Author    R.Brun  *********                              *
 142 C.    *                                                                *
 143 C.    ******************************************************************
 144 C.
 145 #include "geant321/gcbank.inc"
 146 #include "geant321/gcnum.inc"
 147 #include "geant321/gcmzfo.inc"
 148 #include "geant321/gcunit.inc"
 149 #include "geant321/gconsp.inc"
 150       DIMENSION UBUF(1)
 151       CHARACTER*(*) NAMATE
 152       CHARACTER*20 NAME
 153       PARAMETER(ALR2AV=1.39621E-03, AL183=5.20948)
 154 C.
 155 C.    ------------------------------------------------------------------
 156 C.
 157       IF(IMAT.LE.0)GO TO 99
 158       IF(JMATE.LE.0)THEN
 159          CALL MZBOOK(IXCONS,JMATE,JMATE,1,'MATE',NMATE,NMATE,0,3,0)
 160          IQ(JMATE-5)=0
 161       ENDIF
 162       IF(IMAT.GT.NMATE)THEN
 163          CALL MZPUSH(IXCONS,JMATE,IMAT-NMATE,0,'I')
 164          NMATE=IMAT
 165          JMA1=0
 166       ELSE
 167          JMA1=LQ(JMATE-IMAT)
 168          IF(JMA1.GT.0) THEN
 169             WRITE(CHMAIL,10000)
 170             CALL GMAIL(1,0)
 171             CALL GPMATE(IMAT)
 172             CALL MZDROP(IXCONS,LQ(JMATE-IMAT),' ')
 173          ENDIF
 174       ENDIF
 175       CALL MZBOOK(IXCONS,JMA,JMATE,-IMAT,'MATE',20,20,NWBUF+11,IOMATE,0)
 176 C
 177       NAME=NAMATE
 178       NCH=LNBLNK(NAME)
 179       IF(NCH.GT.0)THEN
 180          IF(NAME(NCH:NCH).EQ.'$')NAME(NCH:NCH)=' '
 181       ENDIF
 182       CALL UCTOH(NAME,IQ(JMA+1),4,20)
 183 C
 184       Q(JMA + 6) = A
 185       Q(JMA + 7) = Z
 186       Q(JMA + 8) = DENS
 187 * Calculation with standard formulas
 188 *     Q(JMA + 9) = RADL
 189 *     Q(JMA + 10) = ABSL
 190       IF(A.GT.0.AND.Z.GT.0) THEN
 191          IF(RADL.LT.0) THEN
 192             Q(JMA+9)=-RADL
 193          ELSE
 194             ALZ=LOG(Z)/3
 195             Q(JMA + 9) = A/(ALR2AV*DENS*Z*(Z+GXSI(Z))*
 196      +        (AL183-LOG(Z)/3-GFCOUL(Z)))
 197          ENDIF
 198          IF(ABSL.LT.0) THEN
 199             Q(JMA+10)=-ABSL
 200          ELSE
 201             Q(JMA + 10) = A/(AVO*DENS*1E-3*GHSIGM(5.,8,A))
 202          ENDIF
 203       ELSE
 204          Q(JMA + 9) = BIG
 205          Q(JMA + 10) = BIG
 206       ENDIF
 207       Q(JMA + 11) = 1.
 208       IF(NWBUF.GT.0)CALL UCOPY(UBUF,Q(JMA+12),NWBUF)
 209 C
 210       IF(JMA1.GT.0) THEN
 211          CALL GPMATE(-IMAT)
 212       ENDIF
 213 C
 214 10000 FORMAT(' *** GSMATE ***: Warning, material redefinition:')
 215   99  END
 216