]> git.uio.no Git - u/mrichter/AliRoot.git/blame - GEANT321/gcons/gprmat.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / gcons / gprmat.F
CommitLineData
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/04 13/12/94 17.08.38 by S.Giani
11*-- Author :
12 SUBROUTINE GPRMAT(IMATE,IPART,MECAN,KDIN,TKIN)
13C.
14C. ******************************************************************
15C. * *
16C. * INTERPOLATE and PRINT the DE/DX ,stopping range and *
17C. * Cross sections tabulated in JMATE banks corresponding to *
18C. * material IMATE, particle IPART, mecanism name MECAN , *
19C. * kinetic energies TKIN. *
20C. * *
21C. * The MECAnism name can be : *
22C. * 'HADF' 'INEF' 'ELAF' 'FISF' 'CAPF' *
23C. * 'HADG' 'INEG' 'ELAG' 'FISG' 'CAPG' *
24C. * 'LOSS' 'PHOT' 'ANNI' 'COMP' 'BREM' *
25C. * 'PAIR' 'DRAY' 'PFIS' 'RAYL' 'HADG' *
26C. * 'MUNU' 'RANG' 'STEP' *
27C. * *
28C. * For Hadronic particles it also computes the *
29C. * hadronic cross section from FLUKA ( '***F' ) or *
30C. * GHEISHA ( '***G' ) programs: *
31C. * HADF or HADG -- total *
32C. * INEF or INEG -- inelastic *
33C. * ELAF or ELAG -- elastic *
34C. * FISF or FISG -- fission (0.0 for FLUKA) *
35C. * CAPF or CAPG -- neutron capture (0.0 for FLUKA) *
36C. * *
37C. * Input parameters *
38C. * IMATE Geant material number *
39C. * IPART Geant particle number *
40C. * MECAN mechanism name of the bank to be fetched *
41C. * KDIM dimension of the arrays TKIN , VALUE *
42C. * TKIN array of kinetic energy of incident particle (in Gev) *
43C. * *
44C. * ==>Called by : <USER> *
45C. * Authors R.Brun, M.Maire ********* *
46C. * *
47C. ******************************************************************
48C.
49#include "geant321/gcbank.inc"
50#include "geant321/gcnum.inc"
51#include "geant321/gcunit.inc"
52 PARAMETER (MMX=100)
53 CHARACTER*(*) MECAN
54 CHARACTER*4 MECA
55 CHARACTER*4 KU1 , KU2 , KU3 , KU(5)
56 DIMENSION TKIN(KDIN),VALUE(MMX),SIGT(MMX),PCUT(5),CU(5)
57*
58#include "geant321/gcnmec.inc"
59*
60* ------------------------------------------------------------------
61*
62 KDIM = MIN(KDIN,MMX)
63 IF (KDIM.LE.0) GO TO 999
64*
65 IF (JMATE.LE.0) GO TO 999
66 IF (IMATE.LE.0) GO TO 999
67 IF (IMATE.GT.NMATE) GO TO 90
68 JMA = LQ(JMATE-IMATE)
69 IF (JMA.LE.0) GO TO 90
70*
71 IF (JPART.LE.0) GO TO 999
72 IF (IPART.LE.0) GO TO 999
73 IF (IPART.GT.NPART) GO TO 90
74 JPA = LQ(JPART-IPART)
75 IF (JPA.LE.0) GO TO 90
76*
77 DO 10 JSIG=1,MMX
78 SIGT(JSIG)=0.
79 10 CONTINUE
80 IF(MECAN.EQ.'ALL') THEN
81 N1 = 1
82 N2 = NMECA
83 ELSE
84 N1 = 0
85 DO 20 IMECA=1,NMECA
86 IF(MECAN.EQ.CHNMEC(IMECA)) THEN
87 N1 = IMECA
88 ENDIF
89 20 CONTINUE
90 IF(N1.EQ.0) THEN
91 WRITE(CHMAIL,'('' *** GPRMAT: Mechanism '',A,
92 + '' not implemented'')') MECAN
93 CALL GMAIL(0,0)
94 GOTO 999
95 ENDIF
96 N2 = N1
97 ENDIF
98 DO 60 IMEC = N1,N2
99 IF(CHNMEC(IMEC).NE.'NULL') THEN
100 MECA = CHNMEC(IMEC)
101 CALL GFTMAT(IMATE,IPART,MECA,KDIM,TKIN,VALUE,PCUT,IXST)
102 IF(IXST.EQ.0) GO TO 60
103 CHMAIL='1'
104 CALL GMAIL(0,0)
105 WRITE(CHMAIL,10100)(IQ(JMA+I),I=1,5),MECA,(IQ(JPA+J),J=1,5)
106 CALL GMAIL(0,0)
107 CHMAIL(31:)='-----------------------------------------'
108 CALL GMAIL(0,1)
109 CHMAIL=' '
110 DO 30 K=1,5
111 30 CALL GEVKEV(PCUT(K),CU(K),KU(K))
112 WRITE(CHMAIL,10200) (CU(K),KU(K),K=1,5)
113 CALL GMAIL(0,1)
114*
115 IF (MECA.EQ.'LOSS'.OR.MECA.EQ.'RANG'.OR.MECA.EQ.'STEP')
116 + THEN
117 IF (MECA.EQ.'LOSS') WRITE(CHMAIL,10300)
118 IF (MECA.EQ.'RANG') WRITE(CHMAIL,10400)
119 IF (MECA.EQ.'STEP') WRITE(CHMAIL,10500)
120 CALL GMAIL(0,1)
121 NROW = (KDIM-1)/3 + 1
122 DO 40 IKB=1,NROW
123 IK = IKB
124 DE1 = VALUE(IK)
125 CALL GEVKEV(TKIN(IK),EK1,KU1)
126*
127 IK = IKB + NROW
128 IF (IK.GT.KDIM) IK=KDIM
129 DE2 = VALUE(IK)
130 CALL GEVKEV(TKIN(IK),EK2,KU2)
131*
132 IK = IKB + 2*NROW
133 IF (IK.GT.KDIM) IK=KDIM
134 DE3 = VALUE(IK)
135 CALL GEVKEV(TKIN(IK),EK3,KU3)
136*
137 WRITE(CHMAIL,10600) EK1,KU1,DE1,EK2,KU2,DE2,EK3,KU3,
138 + DE3
139 CALL GMAIL(0,0)
140 40 CONTINUE
141 ELSE
142 WRITE(CHMAIL,10700)
143 CALL GMAIL(0,1)
144 NROW = (KDIM-1)/2 + 1
145 DO 50 IKB=1,NROW
146 IK = IKB
147 SIG1 = VALUE(IK)
148 AL1=0.
149 IF(SIG1.NE.0.)AL1 = 1./SIG1
150 SIGT(IK) = SIGT(IK) + SIG1
151 CALL GEVKEV(TKIN(IK),EK1,KU1)
152*
153 IK = IKB + NROW
154 IF (IK.GT.KDIM) IK=KDIM
155 SIG2 = VALUE(IK)
156 AL2=0.
157 IF(SIG2.NE.0.)AL2 = 1./SIG2
158 SIGT(IK) = SIGT(IK) + SIG2
159 CALL GEVKEV(TKIN(IK),EK2,KU2)
160*
161 WRITE(CHMAIL,10900) EK1,KU1,SIG1,AL1,EK2,KU2,SIG2,AL2
162 CALL GMAIL(0,0)
163 50 CONTINUE
164 ENDIF
165 ENDIF
166 60 CONTINUE
167*
168* *** print total cross section
169 IF (MECAN.EQ.'ALL') THEN
170 MECA = 'SIGT'
171 CHMAIL='1'
172 CALL GMAIL(0,0)
173 WRITE(CHMAIL,10100)(IQ(JMA+I),I=1,5),MECA,(IQ(JPA+J),J=1,5)
174 CALL GMAIL(0,0)
175 CHMAIL(31:)='-----------------------------------------'
176 CALL GMAIL(0,1)
177 CHMAIL=' '
178 DO 70 K=1,5
179 70 CALL GEVKEV(PCUT(K),CU(K),KU(K))
180 WRITE(CHMAIL,10200) (CU(K),KU(K),K=1,5)
181 CALL GMAIL(0,1)
182 WRITE(CHMAIL,10800)
183 CALL GMAIL(0,1)
184 NROW = (KDIM-1)/2 + 1
185 DO 80 IKB=1,NROW
186 IK = IKB
187 SIG1 = SIGT(IK)
188 AL1=0.
189 IF(SIG1.NE.0.)AL1 = 1./SIG1
190 CALL GEVKEV(TKIN(IK),EK1,KU1)
191*
192 IK = IKB + NROW
193 IF (IK.GT.KDIM) IK=KDIM
194 SIG2 = SIGT(IK)
195 AL2=0.
196 IF(SIG2.NE.0.)AL2 = 1./SIG2
197 CALL GEVKEV(TKIN(IK),EK2,KU2)
198*
199 WRITE(CHMAIL,10900) EK1,KU1,SIG1,AL1,EK2,KU2,SIG2,AL2
200 CALL GMAIL(0,0)
201 80 CONTINUE
202 ENDIF
203*
204 GO TO 999
205*
206 90 WRITE(CHMAIL,10000) IMATE ,IPART
207 CALL GMAIL(0,0)
208*
20910000 FORMAT(' ***** GPRMAT error : material',I4,
210 + ' or particle',I4,' not defined' )
21110100 FORMAT(30X,5A4,A4, ' for ',5A4)
21210200 FORMAT( 6X,'BCUTE =',F6.2,A4,3X,'BCUTM =',F6.2,A4,3X,
213 + 'DCUTE =',F6.2,A4,3X,'DCUTM =',F6.2,A4,3X,
214 + 'PPCUTM =',F6.2,A4 )
21510300 FORMAT( 6X,'kinetic energy DE/DX(mev/cm)',
216 + 6X,'kinetic energy DE/DX(mev/cm)',
217 + 6X,'kinetic energy DE/DX(mev/cm)')
21810400 FORMAT( 6X,'kinetic energy Stop range cm',
219 + 6X,'kinetic energy Stop ramge cm',
220 + 6X,'kinetic energy Stop range cm')
22110500 FORMAT( 6X,'kinetic energy Mulof step cm',
222 + 6X,'kinetic energy Mulof step cm',
223 + 6X,'kinetic energy Mulof step cm')
22410600 FORMAT( 3(F16.2,A4,E15.4))
22510700 FORMAT( 6X,'kinetic energy Sigma (1/cm) Lambda (cm)',
226 + 6X,'kinetic energy Sigma (1/cm) Lambda (cm)')
22710800 FORMAT( 6X,'kinetic energy Sigto (1/cm) Lambda (cm)',
228 + 6X,'kinetic energy Sigto (1/cm) Lambda (cm)')
22910900 FORMAT( 2(F16.2,A4,2(E15.4)))
230 999 END