GEANT321/gcons/gsmate.F.ori

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