[u/mrichter/AliRoot.git] / GEANT321 / gcons / gsmate.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:20:16  cernlib
* Geant
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.19  by  S.Giani
*FCA :          17/02/99  12:00:00  by  Federico Carminati
*               Calculation of radiation length and interaction length
*               ignoring user input parameters
*-- Author :
      SUBROUTINE GSMATE(IMAT,NAMATE,A,Z,DENS,RADL,ABSL,UBUF,NWBUF)
C.
C.    ******************************************************************
C.    *                                                                *
C.    *                                                                *
C.    *       Store material parameters                                *
C.    *                                                                *
C.    *                                                                *
C.    *             The Material data structure JMATE                  *
C.    *             ---------------------------------                  *
C.    *                                                                *
C.    *                                         | JMATE                *
C.    *    NMATE           IMATE                v                      *
C.    *     ......................................                     *
C.    *     |              | |                 | |                     *
C.    *     ......................................                     *
C.    *                     |                                          *
C.    *                     | JMA                                      *
C.    *                     v                                          *
C.    *                    .....................                       *
C.    *                    | 1 |               |                       *
C.    *                    .....               |                       *
C.    *                    | 2 |  Material     |                       *
C.    *                    |...|               |                       *
C.    *                    | 3 |   Name        |                       *
C.    *                    |...|               |                       *
C.    *                    | 4 |               |                       *
C.    *                    |...|               |                       *
C.    *                    | 5 |               |                       *
C.    *                    .....................                       *
C.    *                    | 6 |   A           |                       *
C.    *                    |...|...............|                       *
C.    *                    | 7 |   Z           |                       *
C.    *                    |...|...............|                       *
C.    *                    | 8 |   Density     |                       *
C.    *                    |...|...............|                       *
C.    *                    | 9 |   RADL        |                       *
C.    *                    |...|...............|                       *
C.    *                    | 10|   ABSL        |                       *
C.    *                    |...|...............|                       *
C.    *                    | 11|   NMIXT       |                       *
C.    *                    |...|...............|                       *
C.    *                    |   |               |                       *
C.    *                    .....................                       *
C.    *                                                                *
C.    * JMA = LQ(JMATE-IMATE) pointer to material IMATE                *
C.    *                                                                *
C.    *   When  the subroutine  GPHYSI is  called at  initialisation   *
C.    * time  the following  banks  are  created for  each  material   *
C.    * (tabulation of energy loss and cross-section).                 *
C.    *                                               | JMATE          *
C.    * NMATE                     IMATE               v                *
C.    * ................................................               *
C.    * |                        | |                 | |               *
C.    * ................................................               *
C.    *                           | JMA = LQ(JMATE-IMATE)              *
C.    *                           v                              11    *
C.    * ............................................................   *
C.    * |  13 12 11 10 9 8 7 6 5 4 3 2 1 | |  Material parameters  |   *
C.    * ............................................................   *
C.    *    |  |  |  |  | | | | | | | | |                               *
C.    *    |  |  |  |  | | | | | | | | v  JMAEL = LQ(JMA-1)            *
C.    *    |  |  |  |  | | | | | | | |                         270     *
C.    *    |  |  |  |  | | | | | | | |................................ *
C.    *    |  |  |  |  | | | | | | | ||Energy loss for electron/positro*
C.    *    |  |  |  |  | | | | | | | |............................     *
C.    *    |  |  |  |  | | | | | | | v  JMAMU = LQ(JMA-2)       90     *
C.    *    |  |  |  |  | | | | | | |..............................     *
C.    *    |  |  |  |  | | | | | | ||Energy loss for muons       |     *
C.    *    |  |  |  |  | | | | | | |..............................     *
C.    *    |  |  |  |  | | | | | | v  JMAAL = LQ(JMA-3)         90     *
C.    *    |  |  |  |  | | | | | |................................     *
C.    *    |  |  |  |  | | | | | ||Energy loss for other particles|    *
C.    *    |  |  |  |  | | | | | |................................     *
C.    *    |  |  |  |  | | | | | v  JPROB = LQ(JMA-4)           30     *
C.    *    |  |  |  |  | | | | |..................................     *
C.    *    |  |  |  |  | | | | ||Some material constants         |     *
C.    *    |  |  |  |  | | | | |..................................     *
C.    *    |  |  |  |  | | | | v  JMIXT = LQ(JMA-5)             11     *
C.    *    |  |  |  |  | | | |....................................     *
C.    *    |  |  |  |  | | | ||Mixture or compound parameters    |     *
C.    *    |  |  |  |  | | | |....................................     *
C.    *    |  |  |  |  | | | v  JPHOT = LQ(JMA-6) and JMUNU     90     *
C.    *    |  |  |  |  | | |......................................     *
C.    *    |  |  |  |  | | ||Photo-effect cross-section          |     *
C.    *    |  |  |  |  | | |......................................     *
C.    *    |  |  |  |  | | v  JANNI = LQ(JMA-7)                 90     *
C.    *    |  |  |  |  | |........................................     *
C.    *    |  |  |  |  | ||Positron annihilation cross-section   |     *
C.    *    |  |  |  |  | |........................................     *
C.    *    |  |  |  |  | V  JCOMP = LQ(JMA-8)                   90     *
C.    *    |  |  |  |  |..........................................     *
C.    *    |  |  |  |  ||Compton scattering cross-section        |     *
C.    *    |  |  |  |  |..........................................     *
C.    *    |  |  |  |  V  JBREM = LQ(JMA-9)                     90     *
C.    *    |  |  |  | ............................................     *
C.    *    |  |  |  | |Bremsstrahlung cross-section              |     *
C.    *    |  |  |  | ............................................     *
C.    *    |  |  |  V  JPAIR = LQ(JMA-10)                       90     *
C.    *    |  |  | ...............................................     *
C.    *    |  |  | |Pair production cross-section                |     *
C.    *    |  |  | ...............................................     *
C.    *    |  |  V  JDRAY = LQ(JMA-11)                         210     *
C.    *    |  | ..................................................     *
C.    *    |  | |Moller and Bhabha cross-sections                |     *
C.    *    |  | ..................................................     *
C.    *    |  V  JPFIS = LQ(JMA-12)                             90     *
C.    *    | .....................................................     *
C.    *    | |Photo fission cross section                        |     *
C.    *    | .....................................................     *
C.    *    V  JRAYL = LQ(JMA-13)                                62     *
C.    *   ........................................................     *
C.    *   |Rayleigh scattering cross section and atomic form fact|     *
C.    *   ........................................................     *
C.    * V  JMUNU = LQ(JMA-14)                                  90      *
C.    *   ........................................................     *
C.    * V  JRANG = LQ(JMA-15)                                 180      *
C.    * V........................................................      *
C.    *  |Stopping range for electrons/positrons                |      *
C.    *  ........................................................      *
C.    * V  JRANG = LQ(JMA-16)                                 180      *
C.    * V........................................................      *
C.    *  |Stopping range for muons / other particles            |      *
C.    *  ........................................................      *
C.    *                                                                *
C.    *    ==>Called by : <USER>, UGEOM    ,<GXINT> GINC3              *
C.    *       Author    R.Brun  *********                              *
C.    *                                                                *
C.    ******************************************************************
C.
#include "geant321/gcbank.inc"
#include "geant321/gcnum.inc"
#include "geant321/gcmzfo.inc"
#include "geant321/gcunit.inc"
#include "geant321/gconsp.inc"
      DIMENSION UBUF(1)
      CHARACTER*(*) NAMATE
      CHARACTER*20 NAME
      PARAMETER(ALR2AV=1.39621E-03, AL183=5.20948)
C.
C.    ------------------------------------------------------------------
C.
      IF(IMAT.LE.0)GO TO 99
      IF(JMATE.LE.0)THEN
         CALL MZBOOK(IXCONS,JMATE,JMATE,1,'MATE',NMATE,NMATE,0,3,0)
         IQ(JMATE-5)=0
      ENDIF
      IF(IMAT.GT.NMATE)THEN
         CALL MZPUSH(IXCONS,JMATE,IMAT-NMATE,0,'I')
         NMATE=IMAT
         JMA1=0
      ELSE
         JMA1=LQ(JMATE-IMAT)
         IF(JMA1.GT.0) THEN
            WRITE(CHMAIL,10000)
            CALL GMAIL(1,0)
            CALL GPMATE(IMAT)
            CALL MZDROP(IXCONS,LQ(JMATE-IMAT),' ')
         ENDIF
      ENDIF
      CALL MZBOOK(IXCONS,JMA,JMATE,-IMAT,'MATE',20,20,NWBUF+11,IOMATE,0)
C
      NAME=NAMATE
      NCH=LNBLNK(NAME)
      IF(NCH.GT.0)THEN
         IF(NAME(NCH:NCH).EQ.'$')NAME(NCH:NCH)=' '
      ENDIF
      CALL UCTOH(NAME,IQ(JMA+1),4,20)
C
      Q(JMA + 6) = A
      Q(JMA + 7) = Z
      Q(JMA + 8) = DENS
* Calculation with standard formulas
*     Q(JMA + 9) = RADL
*     Q(JMA + 10) = ABSL
      IF(A.GT.0.AND.Z.GT.0) THEN
         IF(RADL.LT.0) THEN
            Q(JMA+9)=-RADL
         ELSE
            ALZ=LOG(Z)/3
            Q(JMA + 9) = A/(ALR2AV*DENS*Z*(Z+GXSI(Z))*
     +        (AL183-LOG(Z)/3-GFCOUL(Z)))
         ENDIF
         IF(ABSL.LT.0) THEN
            Q(JMA+10)=-ABSL
         ELSE
            Q(JMA + 10) = A/(AVO*DENS*1E-3*GHSIGM(5.,8,A))
         ENDIF
      ELSE
         Q(JMA + 9) = BIG
         Q(JMA + 10) = BIG
      ENDIF
      Q(JMA + 11) = 1.
      IF(NWBUF.GT.0)CALL UCOPY(UBUF,Q(JMA+12),NWBUF)
C
      IF(JMA1.GT.0) THEN
         CALL GPMATE(-IMAT)
      ENDIF
C
10000 FORMAT(' *** GSMATE ***: Warning, material redefinition:')
  99  END
Commit	Line	Data
fe4da5cc	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/(ALR2AVDENSZ(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/(AVODENS1E-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