This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / neutron / moxsec.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1995/10/24 10:21:57  cernlib
6 * Geant
7 *
8 *
9 #include "geant321/pilot.h"
10 *CMZ :  3.21/04 23/02/95  14.46.01  by  S.Giani
11 *-- Author :
12       SUBROUTINE MOXSEC
13 C************************************************************
14 C
15 C  setup cross-section tables for MICAP
16 C
17 C  Called by: MORINI
18 C
19 C  INPUT: MICAP element IDs in KE  = LD(LFP11)
20 C         element densities in RHO = D (LFP12)
21 C
22 C  Author : C.Zeitnitz
23 C
24 C  See USER's GUIDE TO MICAP ORNL/TM-10340
25 C  for details and pointer description (MPOINT)
26 C
27 C************************************************************
28 #include "geant321/mmicap.inc"
29 #include "geant321/minput.inc"
30 #include "geant321/mpoint.inc"
31 #include "geant321/mconst.inc"
32 #include "geant321/cmagic.inc"
33 C
34       CHARACTER*80 XSFILE
35       CHARACTER*70 CCOMM
36       CHARACTER*11 CGEANT
37       CHARACTER*4  MARK
38       CHARACTER*20 MATNAM
39       INTEGER INEL(134)
40       LOGICAL NOHED,XSTOP
41 C
42 C       CALCULATE THE NUMBER OF ELEMENTS (NNUC)
43 C       AND GENERATE THE ISOTOPE NUMBER ARRAY (IN(NMIX))
44       NWTOT = 0
45       DO 10 I=1,NMIX
46          LD(LFP17+I-1)=0
47          LD(LFP16+I-1)=0
48    10 CONTINUE
49 C       INITIALIZE THE NUMBER OF ELEMENTS (NNUC)
50       NNUC=0
51       DO 30 I=1,NMIX
52          IF(LD(LFP16+I-1).GT.0)GO TO 30
53          NNUC=NNUC+1
54          LD(LFP16+I-1)=NNUC
55          DO 20 J=I+1,NMIX
56             IF(LD(LFP11+I-1).NE.LD(LFP11+J-1))GO TO 20
57             LD(LFP16+J-1)=NNUC
58    20    CONTINUE
59    30 CONTINUE
60 C get number of isoptopes from xsection file(s)
61       LT = LTEMP
62       NII = 0
63    40 CONTINUE
64         NUNIT = IQ(LT+NTUNIT)
65         READ(NUNIT,'(I10)') NIS
66         NII = NII + NIS
67         IQ(LT+NTMPNI) = NIS
68         LT = LQ(LT)
69       IF(LT.GT.0) GOTO 40
70 C allocate needed memory for x-section
71       NW = 2*NII+13*NNUC+2*NNR*NNUC+4*NGR*NNUC+3*NQ*NNUC+26*MEDIA + 2
72       NI = NII
73       NWTOT = NWTOT + NW
74       CALL CHKZEB(NW,IXCONS)
75       CALL MZBOOK(IXCONS,LMOX1,0,2,'MOX1',0,0,NW,0,-1)
76 C       SET UP THE B CONTROL BLOCK LOCATION NUMBER ARRAY ICOM(NNUC)
77 C LFP170 points to length of x-section data
78       LFP170 = LMOX1 + 2
79       LFP18=LFP170+NNUC
80       LFP18A=LFP18+NII
81       LFP19=LFP18A+NII
82       LFP20=LFP19+NMIX
83 C       SET UP THE ARRAY (IREC(NII))
84       CALL XSECN1(NII,D(LFP11),D(LFP16),D(LFP17),
85      +                D(LFP18),D(LFP18A),D(LFP170),D(LFP19),
86      +                D(LFP20),D(LFP20),INEL)
87 C check if all isotopes have been found in the x-section file(s)
88       XSTOP = .FALSE.
89       DO 50  I=1,NMIX
90         IF(LD(LFP19+I-1).EQ.0) THEN
91          WRITE(IOUT,10100)LD(LFP19+I-1)
92 10000    FORMAT(' MICAP: Could not find x-section of element ',I8)
93          XSTOP = .TRUE.
94         ENDIF
95    50 CONTINUE
96       IF(XSTOP) THEN
97         PRINT '('' CALOR : Neutron x-section not found ===> STOP '')'
98         STOP
99       ENDIF
100       LFP21=LFP20+NNUC
101 C store xs accuracy at LFP210 (used for thinning  in XSECN3)
102       LFP210 = LFP21 + NNUC
103       LFP22=LFP210+NNUC
104       LFP23=LFP22+NNUC
105       LFP24=LFP23+NNUC
106       LFP25=LFP24+NNUC
107       LFP26=LFP25+NNUC
108       LFP27=LFP26+NNR*NNUC
109       LFP28=LFP27+NNR*NNUC
110       LFP29=LFP28+NNUC
111       LFP30=LFP29+NNUC
112       LFP31=LFP30+NGR*NNUC
113       LFP32=LFP31+NGR*NNUC
114       LFP33=LFP32+MEDIA
115       LFP34=LFP33+MEDIA
116       LFP35=LFP34+NNUC
117       LFP36=LFP35+3*NQ*NNUC
118 C       CLEAR THE STORAGE LOCATIONS FOR THE DICTIONARIES, ETC.
119       CALL CLEAR(D,LFP20,LFP36-1)
120 C       ESTABLISH THE RANDOM WALK STORAGE LOCATIONS
121       LFP41=LFP36
122       LFP42=LFP41+2*NNUC
123       LFP45=LFP42+24*MEDIA
124       LFP46=LFP45+NGR*NNUC
125       NW = 0
126       DO 60 INUC=1,NNUC
127          NW = NW + LD(LFP170+INUC-1)
128    60 CONTINUE
129       NW = NW + 2
130       NWTOT = NWTOT + NW
131       CALL CHKZEB(NW,IXCONS)
132       CALL MZBOOK(IXCONS,LMOX2,0,2,'MOX2',0,0,NW,0,-1)
133       LFP43 = LMOX2 + 2
134       LAST = LFP43 - 1
135       MAXD = LMOX2 + NW
136 C       PLACE THE MICROSCOPIC CROSS SECTION DATA INTO THE CORE
137       CALL XSECN2(D(LFP17),D(LFP18),D(LFP18A),
138      +            D(LFP20),D(LFP21),D(LFP210),D(LFP22),D(LFP23),
139      +            D(LFP24),D(LFP25),D(LFP26),D(LFP27),D(LFP28),
140      +            D(LFP29),D(LFP30),D(LFP31),D(LFP34),D(LFP35),
141      +            D(LFP35+NQ*NNUC),D(LFP35+2*NQ*NNUC),
142      +            D(LFP43),D(LFP43),MAXD,LAST,INEL)
143 C determine length needed for macroscopic xs and mixing
144       NW = 0
145       DO 90  IM=1,MEDIA
146          NM = 0
147          LZ = 0
148          DO 70 IN=1,NMIX
149             IF(LD(LFP10+IN-1).NE.IM) GOTO 70
150             NM = NM+1
151             II = LD(LFP16+IN-1)
152             LZ = MAX0(LD(LFP27+NNR*(II-1)),LZ)
153 C           LZ = MAX0(LDICT(1,II),LZ)
154    70    CONTINUE
155          IF(NM.GT.1) LZ = 4*LZ
156          DO 80 J=1,NMIX
157             IF(LD(LFP10+J-1).NE.IM) GOTO 80
158             II = LD(LFP16+J-1)
159    80    CONTINUE
160          NW = NW + LZ
161    90 CONTINUE
162       NW = NW + 2
163       NWTOT = NWTOT + NW
164       CALL CHKZEB(NW,IXCONS)
165       CALL MZBOOK(IXCONS,LMOX3,0,2,'MOX3',0,0,NW,0,-1)
166       LAST = LMOX3 + 1
167       LFP44=LAST+1
168       MAXD = LMOX3+NW
169 C       SET, MIX AND THIN THE TOTAL CROSS SECTIONS
170 C       ACCORDING TO THE MIXING TABLE
171       CALL XSECN3(D(LFP10),D(LFP11),D(LFP12),D(LFP16),D(LFP26),
172      +            D(LFP27),D(LFP32),D(LFP33),D(LFP44),D(LFP44),
173      +            D,MAXD,LAST)
174 C       ESTABLISH THE PHOTON TOTAL CROSS SECTION DATA DICTIONARY
175 C       STORAGE LOCATIONS
176 C determine number of words needed for photon production xs
177       NW = 0
178       DO 110 I=1,NNUC
179          DO 100 J=1,LD(LFP28+I-1)
180             LZ = LD(LFP31 + 2*J - 1 + NGR*(I-1))
181 C           LZ = LGCB(2*J,I)
182             NW = NW + LZ
183   100    CONTINUE
184   110 CONTINUE
185       NW = NW + 2*NGR*NNUC+2
186       NWTOT = NWTOT + NW + 1
187       CALL CHKZEB(NW,IXCONS)
188       CALL MZBOOK(IXCONS,LMOX4,0,2,'MOX4',0,0,NW,0,-1)
189       LMAG2 = LMOX4 + 1
190       LD(LMAG2) = NMAGIC
191       LFP45 = LMAG2 + 1
192       LFP46 = LFP45 + NGR*NNUC
193       LFP47 = LFP46 + NGR*NNUC
194       LAST = LFP47 - 1
195       MAXD = LMOX4 + NW
196 C       CLEAR THE STORAGE LOCATIONS FOR THE PHOTON DICTIONARIES
197 C       OF THE TOTAL PHOTON PRODUCTION CROSS SECTIONS
198       CALL CLEAR(D,LFP45,LFP47-1)
199 C       SUM THE PHOTON PARTIAL DISTRIBUTIONS OF THE ENDF/B-V
200 C       FILE 12 AND FILE 13 DATA (BY MT NUMBER) AND PLACE THESE
201 C       MICROSCOPIC MULTIPLICITIES TIMES CROSS SECTIONS IN CORE
202       CALL XSECN5(D(LFP28),D(LFP30),D(LFP31),D(LFP45),D(LFP46),
203      +           D(LFP47),D(LFP47),D,D,MAXD,LAST)
204 C
205 C print out media to print unit IOUT
206 C      WRITE(IOUT,10000)
207 10100 FORMAT(23X,'MICAP Material Parameters',/,
208      +       23X,'-------------------------',/)
209       WRITE(IOUT,10200)
210 10200 FORMAT(8X,'GEANT Material Parameters',10X,
211      +        6X,'MICAP Material Parameters',/,
212      +       8X,25('-'),10X,6X,25('-'))
213       WRITE(IOUT,10300)
214 10300 FORMAT(1X,'Material',16X,'No/Iso',4X,'A',5X,'Z',2X,'|',
215      +        4X,'A',5X,'Z',3X,'Density',
216      +        3X,'Coll.Len',/,44('-'),'+',33('-'))
217       MFLAG = 0
218       KMED  = 0
219       NISO  = 1
220       DO 130 I=0,NMIX-1
221 C get GEANT name of material
222          MARK = '/   '
223          IF(LD(LFP11+I)/1000.NE.LD(LFP13+I)) THEN
224             MARK = '/  *'
225             MFLAG=1
226          ENDIF
227          K1 = LD(LFP16+I)-1
228          LS1 = LD(LFP26+NNR*K1)+LMOX2
229          LEN = LD(LFP27+NNR*K1)/2
230          EN = 1.E6
231          CALL TBSPLT(D(LS1),EN,LEN,XSEC)
232          XSEC = 1./XSEC/D(LFP12+I)
233          IF(LD(LFP140+I).NE.0.) THEN
234             WRITE(CGEANT,'(F6.1,I5)')  D(LFP140+I),LD(LFP13+I)
235          ELSE
236             WRITE(CGEANT,'(A11)')  '    -     -'
237          ENDIF
238          IF(KMED.NE.LD(LFP10+I)) THEN
239           NISO = 1
240           CALL GFMATE(LD(LGE2MO+LD(LFP10+I)),MATNAM,AA,ZZ,DENS,
241      +       RADL,ABSL,UB,NW)
242           NBLK = LNBLNK(MATNAM)
243           DO 120 JC=NBLK+1,20
244              WRITE(MATNAM(JC:JC),'(A1)') '.'
245   120     CONTINUE
246           WRITE(MARK(2:3),'(I2)') NISO
247           WRITE(IOUT,10400) MATNAM,LD(LGE2MO+LD(LFP10+I)),MARK,
248      +     CGEANT,
249      +     D(LFP34+LD(LFP16+I)-1)*1.008665,
250      +     LD(LFP11+I)/1000,D(LFP12+I),XSEC
251           KMED = LD(LFP10+I)
252          ELSE
253           WRITE(MARK(2:3),'(I2)') NISO
254           WRITE(IOUT,10500) LD(LGE2MO+LD(LFP10+I)),MARK,CGEANT,
255      +     D(LFP34+LD(LFP16+I)-1)*1.008665,
256      +     LD(LFP11+I)/1000,D(LFP12+I),XSEC
257          ENDIF
258 10400    FORMAT(1X,A20,I6,A4,A11,'  |',F6.1,I5,1X,E11.4,1X,E9.3)
259 10500    FORMAT(1X,20X,I6,A4,A11,'  |',F6.1,I5,1X,E11.4,1X,E9.3)
260          LD(LFP13+I) = LD(LFP11+I)/1000
261          NISO = NISO + 1
262   130 CONTINUE
263       WRITE(IOUT,'(78(''-''),/,48X,''Density in (Atoms/barn/cm)'')')
264       WRITE(IOUT,'(36X,
265      +    ''Collision Length for 1 MeV neutron in (cm)'',/)')
266       IF(MFLAG.EQ.1) WRITE(IOUT,'(/,
267      + 15X,''*******************************************'',/,
268      + 15X,''*               W A R N I N G             *'',/,
269      + 15X,''*   Marked isotopes (*) not found in the  *'',/,
270      + 15X,''*        cross-section file(s)            *'',/,
271      + 15X,''*    Cross-sections of the isotope with   *'',/,
272      + 15X,''*    the closest Z will be used instead   *'',/,
273      + 15X,''*******************************************'',/)')
274 C which x-section files have been used?
275       LT = LTEMP
276       LCI = LCISO
277       LC = 0
278       NOHED=.TRUE.
279   140 CONTINUE
280 C first check if x-section file has been used!
281         NUNIT = IQ(LT+NTUNIT)
282         DO 150 I=0,NMIX-1
283            KISO = LD(LFP16+I)
284            MISO = LD(LFP17+KISO-1)
285            IF(NUNIT.EQ.LD(LFP18A+MISO-1)) GOTO 160
286   150   CONTINUE
287 C unit never used !
288         GOTO 190
289   160   CONTINUE
290 C search for comments for selected isotopes
291         NCOM = IQ(LCI+1)
292         DO 180 J=1,NCOM
293            K = (J-1)*81 + 2
294            JZ = IQ(LCI+K)
295            JA = IQ(LCI+K+1)
296            CCOMM = ' '
297            CALL UHTOC(IQ(LCI+K+2),4,CCOMM,70)
298            DO 170 I=0,NMIX-1
299               KISO = LD(LFP16+I)
300               IA = NINT(D(LFP34+KISO-1)*1.008665)
301               IZ = LD(LFP11+I)/1000
302               MISO = LD(LFP17+KISO-1)
303 C print the comment, if the isotope is correct and has been read from
304 C the current x-section file
305               IF(IA.EQ.JA .AND. IZ.EQ.JZ .AND.
306      +           NUNIT.EQ.LD(LFP18A+MISO-1)) THEN
307                 IF(NOHED) THEN
308                  WRITE(IOUT,'(/,23X,''COMMENTS ABOUT ISOTOPE DATA'')')
309                  WRITE(IOUT,'(  23X,''---------------------------'',/)')
310                  NOHED = .FALSE.
311                 ENDIF
312                 LC = LC + 1
313                 WRITE(IOUT,'(I4,'') '',A70)') LC,CCOMM
314                 GOTO 180
315               ENDIF
316   170      CONTINUE
317   180   CONTINUE
318   190   LT = LQ(LT)
319         LCI = LQ(LCI)
320       IF(LT.GT.0.AND.LCI.GT.0) GOTO 140
321 C print the x-section file names and comments
322       WRITE(IOUT,'(/,20X,''USED NEUTRON CROSS-SECTION FILES'')')
323       WRITE(IOUT,'(  20X,''--------------------------------'',/)')
324       LT = LTEMP
325   200 CONTINUE
326 C first check if x-section file has been used!
327         NUNIT = IQ(LT+NTUNIT)
328         DO 210 I=0,NMIX-1
329            KISO = LD(LFP16+I)
330            MISO = LD(LFP17+KISO-1)
331            IF(NUNIT.EQ.LD(LFP18A+MISO-1)) GOTO 220
332   210   CONTINUE
333 C unit never used !
334         GOTO 230
335   220   CONTINUE
336 C get file name of x-section file
337         XSFILE = ' '
338         COMMEN = ' '
339         DATSTR = ' '
340         CALL UHTOC(IQ(LT+NTNAME+1),4,XSFILE,IQ(LT+NTNAME))
341         CALL UHTOC(IQ(LT+NTCOMM+1),4,COMMEN,IQ(LT+NTCOMM))
342         CALL UHTOC(IQ(LT+NTDATS+1),4,DATSTR,IQ(LT+NTDATS))
343         WRITE(IOUT,'('' File      : '',A66)') XSFILE
344         WRITE(IOUT,'('' Generated : '',A24,/,
345      +               '' Comment   : '',A66,/)') DATSTR,COMMEN
346   230   LT = LQ(LT)
347       IF(LT.GT.0) GOTO 200
348       WRITE(IOUT,'(/,'' MICAP :'',I10,
349      + '' words used in GCBANK for neutron x-section tables''/)') NWTOT
350       RETURN
351       END