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

*
* $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
*-- 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"
      DIMENSION UBUF(1)
      CHARACTER*(*) NAMATE
      CHARACTER*20 NAME
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
      Q(JMA + 9) = RADL
      Q(JMA + 10) = ABSL
      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	*-- 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