This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / neutron / xsecn2.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1995/10/24 10:22:00  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 XSECN2(ICOM,IREC,IUNIT,IGAMS,LGAM,ELTOL,INABS,LNAB,
13      + ITHRMS,LTHRM,IDICTS,LDICT,NTX,NTS,IGCBS,LGCB,AWR,Q,LR,QLR,
14      + BUF,IBUF,LIM,LAST,INEL)
15 C       THIS ROUTINE READS THE REMAINDER OF INPUT I/O UNIT(s),
16 C       SELECTS THE ELEMENTS NEEDED FOR THE CALCULATIONS,
17 C       AND STORES THE CROSS SECTION DATA IN CORE
18 #include "geant321/minput.inc"
19 #include "geant321/mconst.inc"
20 #include "geant321/mmicab.inc"
21       CHARACTER*4 MARK
22       DIMENSION BUF(*),IBUF(*),ICOM(*),IGAMS(*),LGAM(*),INABS(*),
23      +LNAB(*),ITHRMS(*),LTHRM(*),AWR(*),IDICTS(NNR,NNUC),ELTOL(*),
24      +LDICT(NNR,NNUC),Q(NQ,NNUC),NTX(*),NTS(*),IGCBS(NGR,NNUC),
25      +LGCB(NGR,NNUC),IREC(*),LR(NQ,NNUC),QLR(NQ,NNUC)
26       DIMENSION INEL(*),IUNIT(*)
27 C       ASSIGN THE DEFAULT VALUES
28       LEN=0
29 C       INITIALIZE THE COUNTERS FOR THE LOOP
30 C       NISR EQUALS THE NUMBER OF ISOTOPES READ
31 C       IRECNO EQUALS THE NEXT RECORD NUMBER TO BE READ ON INPUT
32 C  I/O UNIT (NUNIT)
33 C       LAST EQUALS THE LAST CORE POSITION USED IN THE CALLING
34 CROUTINE (INPUT1)
35 C       LST EQUALS THE LAST POSITION USED IN THE BUF ARRAY
36 C   (I.E. (BUF(LST) = D(LAST)))
37       NISR=0
38       IRECNO=1
39       LST=0
40 C       PRINT OUT THE CROSS SECTION DIRECTORY IF CALLED FOR
41    10 CONTINUE
42 C       START LOOP TO READ IN THE DATA ON INPUT I/O UNIT
43       DO 370 II=1,NI
44          IR   = IREC(II)
45          IF(NUNIT.NE.IUNIT(II)) IRECNO = 1
46          NUNIT= IUNIT(II)
47          IF(NUNIT.LE.0) THEN
48            WRITE(IOUT,'(/,'' XSECN2 : Wrong unit number '',I10)') NUNIT
49            GOTO 370
50          ENDIF
51          IF(NISR.GE.NNUC)GO TO 370
52          IF(IR.EQ.0)GO TO 370
53 C       LOOP TO LOCATE THE I CONTROL BLOCK RECORD (IR=IREC(II))
54 CZ x-section endmark = 'ENDE'
55 CZ file endmark ='ENDF'
56          MARK = '   '
57    20    IF(MARK.EQ.'ENDE') IRECNO = IRECNO + 1
58          IF(MARK.EQ.'ENDF') GOTO 50
59          IF(IR.EQ.IRECNO) GOTO 30
60          READ(NUNIT,'(A)') MARK
61          GO TO 20
62 C       CHECK TO DETERMINE THE ISOTOPE NUMBER FOR THE RANDOM WALK
63    30    DO 40 I=1,NNUC
64             IF(ICOM(I).EQ.II)GO TO 60
65    40    CONTINUE
66    50    WRITE(IOUT,10000)II
67 10000 FORMAT('0',10X,'ERROR IN ROUTINE XSECN2, II=',I6,/)
68          GO TO 390
69 C       READ I CONTROL BLOCK RECORD OFF INPUT I/O UNIT (NUNIT) FOR
70 C       THE ELEMENT CORRESPONDING TO IREC(II) AND ICOM(I)
71    60    IJK=I
72          READ(NUNIT,'(I10,4G13.7,1I10,/,6I10)') IBUF(LST+1),(BUF(LST+
73      +   IK),IK=2,5),(IBUF(LST+IJ),IJ=6,12)
74          NISR=NISR+1
75 C       ASSIGN VALUES TO ARRAYS NEEDED FOR THE RANDOM WALK
76          ISO=IJK
77          NEL=INEL(II)
78          AWR(ISO)=BUF(LST+2)
79 CZ store accuracy of xs
80          ELTOL(ISO) = BUF(LST+4)
81          IFLAGU=IBUF(LST+6)
82          LGAM(ISO)=IBUF(LST+7)
83          NTX(ISO)=IBUF(LST+8)
84          NTS(ISO)=IBUF(LST+9)
85          LTHRM(ISO)=IBUF(LST+11)
86          LNAB(ISO)=IBUF(LST+12)
87 C       READ IN THE ISOTOPE DICTIONARY (IDICT ARRAY)
88 C       FROM INPUT I/O UNIT (NUNIT)
89          READ(NUNIT,'((8I10))')(LDICT(J,ISO),J=1,NNR)
90    70    CONTINUE
91 C       READ IN ENDF/B FILE3 CROSS SECTION DATA
92 C       READ IN ENDF/B FILE4 ANGULAR DISTRIBUTION DATA
93 C       READ IN ENDF/B FILE5 SECONDARY ENERGY DISTRIBUTION DATA
94          DO 190 I2=1,NNR
95             LZ=LDICT(I2,ISO)
96             IF(LZ.EQ.0)GO TO 190
97             LEN=LIM-LAST
98             IF(LEN.LT.LZ)GO TO 380
99             IDICTS(I2,ISO)=LAST+1-LMOX2
100 CZ changed in order to read ASCII input file
101 C I2 < 67  -> x-section data
102 C I2 < 123 -> angular distribution
103 C I2 < 134 -> secondary energy distribution
104 C I2 = 134 ->
105             IF(I2.LT.67) THEN
106                READ(NUNIT,'((6G13.7))')(BUF(LST+I),I=1,LZ)
107             ELSE IF(I2.LT.123) THEN
108 C ------------------- I2 = 67 -----------------------------
109                READ(NUNIT,'((8I10))') (IBUF(LST+I),I=1,2), (IBUF(LST+
110      +         J+2),J=1,2*IBUF(LST+1))
111                K = 2*IBUF(LST+1) + 2 + 1
112                DO 80 J=1,IBUF(LST+2)
113                   READ(NUNIT,'(G13.7,I10,/,(6G13.7))') BUF(LST+K),
114      +            IBUF(LST+K+1), (BUF(LST+IK+K+1),IK=1,IBUF(LST+K+1)*2)
115                   K = K + 2 + IBUF(LST+K+1)*2
116    80          CONTINUE
117             ELSE IF(I2.LT.134) THEN
118 C-------------------- I2 = 123 ----------------------------
119                READ(NUNIT,'(2I10,G13.7,2I10,/,(8I10))') (IBUF(LST+I),
120      +         I=1,2),BUF(LST+3),(IBUF(LST+J),J=4,5), (IBUF(LST+K+5),K=
121      +         1,2*IBUF(LST+4))
122                ID = 2*IBUF(LST+4) + 5
123                LF = IBUF(LST+2)
124                NP2 = 2*IBUF(LST+5)
125                READ(NUNIT,'((6G13.7))') (BUF(LST+ID+I),I=1,NP2)
126                ID = ID + NP2
127                KEND = 1
128                IF(LF.EQ.5.OR.LF.EQ.11) KEND = 2
129                DO 100 K=1,KEND
130                   READ(NUNIT,'((8I10))') (IBUF(LST+ID+I),I=1,2)
131                   NR2 = 2*IBUF(LST+ID+1)
132                   NE = IBUF(LST+ID+2)
133                   ID = ID + 2
134                   READ(NUNIT,'((8I10))') (IBUF(LST+ID+I),I=1,NR2)
135                   ID = ID + NR2
136                   IEND = NE
137                   IF(LF.EQ.5.OR.LF.EQ.11) IEND = 1
138                   IF(LF.EQ.7.OR.LF.EQ.9) IEND = 1
139                   DO 90 I=1,IEND
140                      IF(LF.EQ.1) THEN
141                         READ(NUNIT,'(G13.7,2I10)') BUF(LST+ID+1),
142      +                  (IBUF(LST+ID+J),J=2,3)
143                         NR2 = 2*IBUF(LST+ID+2)
144                         NP2 = 2*IBUF(LST+ID+3)
145                         ID = ID + 3
146                         READ(NUNIT,'((8I10))') (IBUF(LST+ID+J),J=1,
147      +                  NR2)
148                         ID = ID + NR2
149                      ELSE
150                         NP2 = 2*NE
151                      ENDIF
152                      READ(NUNIT,'((6G13.7))') (BUF(LST+ID+J),J=1,NP2)
153                      ID = ID + NP2
154    90             CONTINUE
155   100          CONTINUE
156             ELSE
157 C ------------------ I2 = 134 --------------------------------------
158                READ(NUNIT,'(I10)') IBUF(LST+1)
159                LNU = IBUF(LST+1)
160                IF(LNU.NE.2) THEN
161                   READ(NUNIT,'(I10,/,(6G13.7))') IBUF(LST+2), (BUF(LST
162      +            +I+2),I=1,IBUF(LST+2))
163                ELSE
164                   READ(NUNIT,'((8I10))') (IBUF(LST+I),I=2,3)
165                   NR2 = IBUF(LST+2)*2
166                   READ(NUNIT,'((8I10))') (IBUF(LST+3+J),J=1,NR2)
167                   NP2 = IBUF(LST+3)*2
168                   READ(NUNIT,'((6G13.7))') (BUF(LST+3+NR2+J),J=1,NP2)
169                ENDIF
170             ENDIF
171 CZ end of change
172             IF(I2.GT.66)GO TO 120
173   110       CONTINUE
174             GO TO 180
175   120       IF(I2.GT.122)GO TO 150
176   130       CONTINUE
177             CALL ANGCDF(BUF(LST+1),BUF(LST+1),LZ)
178   140       CONTINUE
179             GO TO 180
180   150       IF(I2.GT.133)GO TO 170
181   160       CONTINUE
182             GO TO 180
183   170       CONTINUE
184   180       CONTINUE
185             LAST=LAST+LZ
186             LST=LST+LZ
187   190    CONTINUE
188 C       READ IN THE AVERAGE PHOTON PRODUCTION ARRAY
189          LZ=LGAM(ISO)
190          IF(LZ.EQ.0)GO TO 210
191          LEN=LIM-LAST
192          IF(LEN.LT.LZ)GO TO 380
193          IGAMS(ISO)=LAST+1-LMOX2
194          READ(NUNIT,'((6G13.7))')(BUF(LST+I),I=1,LZ)
195   200    CONTINUE
196          LAST=LAST+LZ
197          LST=LST+LZ
198   210    CONTINUE
199 C       READ IN THE TOTAL NEUTRON DISAPPERANCE ARRAY
200          LZ=LNAB(ISO)
201          IF(LZ.EQ.0)GO TO 230
202          LEN=LIM-LAST
203          IF(LEN.LT.LZ)GO TO 380
204          INABS(ISO)=LAST+1-LMOX2
205          READ(NUNIT,'((6G13.7))')(BUF(LST+I),I=1,LZ)
206   220    CONTINUE
207          LAST=LAST+LZ
208          LST=LST+LZ
209   230    CONTINUE
210 C       READ IN THE Q VALUE ARRAY
211          READ(NUNIT,'((6G13.7))')(Q(I,ISO),I=1,NQ)
212   240    CONTINUE
213 C       READ IN THE LR VALUE ARRAY
214          READ(NUNIT,'((8I10))')(LR(I,ISO),I=1,NQ)
215   250    CONTINUE
216 C       READ IN THE QLR VALUE ARRAY
217          READ(NUNIT,'((6G13.7))')(QLR(I,ISO),I=1,NQ)
218   260    CONTINUE
219 C       READ IN THE PHOTON DATA DICTIONARY (GCB ARRAY)
220 C       FROM INPUT I/O UNIT (NUNIT)
221 C       CURRENT STORAGE IS SET TO ACCOMODATE UP TO 30 INTERACTIONS
222 C       (I.E. (2*NTX(ISO)+2*NTS(ISO)).LE.NGR)
223          L=2*NTX(ISO)+2*NTS(ISO)
224          IF(L.EQ.0)GO TO 350
225          L1=2*NTX(ISO)
226          L2=L1+1
227          READ(NUNIT,'((8I10))')(LGCB(J,ISO),J=1,L)
228   270    CONTINUE
229 C       READ IN ENDF/B FILE12 PHOTON MULTIPLICATION DATA
230 C       READ IN ENDF/B FILE13 PHOTON CROSS SECTION DATA
231          NNTX=NTX(ISO)
232          DO 300 I2=1,NNTX
233             LZ=LGCB(2*I2,ISO)
234             IF(LZ.EQ.0)GO TO 300
235             LEN=LIM-LAST
236             IF(LEN.LT.LZ)GO TO 380
237             IGCBS(2*I2-1,ISO)=LGCB(2*I2-1,ISO)
238             IGCBS(2*I2,ISO)=LAST+1-LMOX2
239 CZ changed in order to read ASCII xsection file
240             READ(NUNIT,'((8I10))') (IBUF(LST+I),I=1,2)
241             READ(NUNIT,'((6G13.7))') (BUF(LST+J+2),J=1,IBUF(LST+2))
242             ID = IBUF(LST+2) + 2 + LST
243             DO 280 K = 1, IBUF(LST+1)
244                READ(NUNIT,'(2(G13.7,I10))') BUF(ID+1),IBUF(ID+2),
245      +         BUF(ID+3),IBUF(ID+4)
246                ID = ID + 4
247                READ(NUNIT,'((6G13.7))') (BUF(ID + J),J=1,IBUF(LST+2))
248                ID = ID + IBUF(LST+2)
249   280       CONTINUE
250 CZ end of change
251   290       CONTINUE
252             LAST=LAST+LZ
253             LST=LST+LZ
254   300    CONTINUE
255 C       READ IN ENDF/B FILE15 PHOTON SECONDARY ENERGY DISTRIBUTIONS
256          NNTS=NTS(ISO)
257          IF(NNTS.EQ.0)GO TO 350
258          DO 340 I2=1,NNTS
259             LZ=LGCB(L1+2*I2,ISO)
260             IF(LZ.EQ.0)GO TO 340
261             LEN=LIM-LAST
262             IF(LEN.LT.LZ)GO TO 380
263             IGCBS(L1+2*I2-1,ISO)=LGCB(L1+2*I2-1,ISO)
264             IGCBS(L1+2*I2,ISO)=LAST+1-LMOX2
265 CZ changed in order to read ASCII xsection file
266             READ(NUNIT,'(2I10,G13.7,2I10,/,(8I10))') (IBUF(LST+I),I=1,
267      +      2),BUF(LST+3), (IBUF(LST+J),J=4,5), (IBUF(LST+K+5),K=1,2*
268      +      IBUF(LST+4))
269             ID = 2*IBUF(LST+4) + 5
270             LF = IBUF(LST+2)
271             NP2 = 2*IBUF(LST+5)
272             READ(NUNIT,'((6G13.7))') (BUF(LST+ID+I),I=1,NP2)
273             ID = ID + NP2
274             KEND = 1
275             IF(LF.EQ.5.OR.LF.EQ.11) KEND = 2
276             DO 320 K=1,KEND
277                READ(NUNIT,'((8I10))') (IBUF(LST+ID+I),I=1,2)
278                NR2 = 2*IBUF(LST+ID+1)
279                NE = IBUF(LST+ID+2)
280                ID = ID + 2
281                READ(NUNIT,'((8I10))') (IBUF(LST+ID+I),I=1,NR2)
282                ID = ID + NR2
283                IEND = NE
284                IF(LF.EQ.5.OR.LF.EQ.11) IEND = 1
285                IF(LF.EQ.7.OR.LF.EQ.9) IEND = 1
286                DO 310 I=1,IEND
287                   IF(LF.EQ.1) THEN
288                      READ(NUNIT,'(G13.7,2I10)') BUF(LST+ID+1), (IBUF(L
289      +               ST+ID+J),J=2,3)
290                      NR2 = 2*IBUF(LST+ID+2)
291                      NP2 = 2*IBUF(LST+ID+3)
292                      ID = ID + 3
293                      READ(NUNIT,'((8I10))') (IBUF(LST+ID+J),J=1,NR2)
294                      ID = ID + NR2
295                   ELSE
296                      NP2 = 2*NE
297                   ENDIF
298                   READ(NUNIT,'((6G13.7))') (BUF(LST+ID+J),J=1,NP2)
299                   ID = ID + NP2
300   310          CONTINUE
301   320       CONTINUE
302 CZ end of change
303   330       CONTINUE
304             LAST=LAST+LZ
305             LST=LST+LZ
306   340    CONTINUE
307   350    CONTINUE
308 C       READ IN THE THERMAL CROSS SECTION DATA ARRAY
309          LZ=LTHRM(ISO)
310          IF(LZ.EQ.0)GO TO 360
311          LEN=LIM-LAST
312          IF(LEN.LT.LZ)GO TO 380
313          ITHRMS(ISO)=LAST+1
314          READ(NUNIT,'((6G13.7))')(BUF(LST+I),I=1,LZ)
315          LAST=LAST+LZ
316          LST=LST+LZ
317   360    CONTINUE
318   370 CONTINUE
319       GO TO 400
320   380 WRITE(IOUT,10100)LZ,LEN
321 10100 FORMAT('0','NOT ENOUGH SPACE TO READ IN RECORD',/,5X,
322      +'LENGTH OF RECORD=',I10,/,5X,'SPACE AVAILABLE=',I10)
323   390 PRINT '('' CALOR: ERROR in XSECN2 ====> STOP '')'
324       STOP
325   400 RETURN
326       END