1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
|
*DECK MACXSR
SUBROUTINE MACXSR(MAXFIS,NGROUP,NBMIX,NIFISS,NANISO,NDELG,NTYPE,
> XSTOTL,XSTOT1,XSFISS,XSSPEC,XSFIXE,XSTRAN,
> XSDIFF,XSNFTO,XSH,XSSCAT,LOLDXS,LNEWXS,CARLIR,
> LADD,LUPD,IPRINT,ISCATA,XSNUDL,XSCHDL,XSDIFX,
> XSDIFY,XSDIFZ,XSOVRV,XSINT0,XSINT1,HADF,XADF)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Read cross sections from input file.
*
*Copyright:
* Copyright (C) 2006 Ecole Polytechnique de Montreal
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version
*
*Author(s): G. Marleau
*
*Parameters: input
* MAXFIS set to max(1,NIFISS).
* NGROUP number of energy groups.
* NBMIX maximum number of mixtures.
* NIFISS number of fissile isotopes.
* NANISO maximum Legendre order:
* =1 isotropic collision;
* =2 linearly anisotropic collision.
* NDELG number of precursor groups for delayed neutrons.
* NTYPE number of boundary regions types for ADF calculations.
* LOLDXS flag for cross section type already present on the macrolib.
* CARLIR last string read.
* LADD flag (true) for reading invcrementsçal XS.
* LUPD flag (true) for updating XS.
* IPRINT print level.
*
*Parameters: input/output
* XSTOTL P0 total cross section of mixture.
* XSTOT1 P1 total cross section of mixture.
* XSFISS nu*fission cross section of mixture.
* XSNFTO fission cross section of mixture.
* XSSPEC fission spectrum.
* XSFIXE fixe sources.
* XSTRAN transport correction.
* XSDIFF isotropic diffusion coefficient.
* XSH power factor.
* XSSCAT scattering cross section of mixture/group.
* XSNUDL delayed nu*fission cross section of mixture.
* XSCHDL delayed-neutron fission spectrum.
* XSDIFX x-directed diffusion coefficients.
* XSDIFY y-directed diffusion coefficients.
* XSDIFZ z-directed diffusion coefficients.
* XSOVRV reciprocal neutron velocities.
* XSINT0 P0 volume-integrated flux of mixture.
* XSINT1 P1 volume-integrated flux of mixture.
*
*Parameters: output
* LNEWXS flag for cross section modified.
* ISCATA check for scattering anisotropy.
* HADF names of the boundary flux types.
* XADF averaged fluxes in boundary regions.
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
PARAMETER (NCXST=18)
INTEGER MAXFIS,NGROUP,NBMIX,NIFISS,NANISO,NDELG,IPRINT,
> ISCATA(NANISO)
REAL XSTOTL(NBMIX,NGROUP),XSTOT1(NBMIX,NGROUP),
> XSFISS(NBMIX,MAXFIS,NGROUP),XSSPEC(NBMIX,MAXFIS,NGROUP),
> XSFIXE(NBMIX,NGROUP),XSTRAN(NBMIX,NGROUP),
> XSDIFF(NBMIX,NGROUP),XSNFTO(NBMIX,NGROUP),
> XSH(NBMIX,NGROUP),XSSCAT(NGROUP,NBMIX,NANISO,NGROUP),
> XSNUDL(NBMIX,MAXFIS,NDELG,NGROUP),
> XSCHDL(NBMIX,MAXFIS,NDELG,NGROUP),
> XSDIFX(NBMIX,NGROUP),XSDIFY(NBMIX,NGROUP),
> XSDIFZ(NBMIX,NGROUP),XSOVRV(NBMIX,NGROUP),
> XSINT0(NBMIX,NGROUP),XSINT1(NBMIX,NGROUP),
> XADF(NBMIX,NGROUP,NTYPE)
LOGICAL LOLDXS(NCXST),LNEWXS(NCXST),LADD,LUPD
CHARACTER HADF(NTYPE)*8,CARLIR*12
*----
* LOCAL VARIABLES
*----
PARAMETER (IUNOUT=6)
CHARACTER CARXST(NCXST)*6
DOUBLE PRECISION DBLINP
*----
* ALLOCATABLE ARRAYS
*----
LOGICAL, ALLOCATABLE, DIMENSION(:,:) :: LINIXS
*----
* SCRATCH STORAGE ALLOCATION
* LINIXS flag for cross section read per mixture.
*----
ALLOCATE(LINIXS(NCXST,NBMIX))
*
HADF(:)=' '
XADF(:,:,:)=0.0
MATNUM=0
DO 200 IM=1,NBMIX
DO 210 IT=1,NCXST
LINIXS(IT,IM)=.TRUE.
210 CONTINUE
200 CONTINUE
*----
* START READING KEYWORDS
*----
ITYPE=0
1000 CONTINUE
CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLINP)
1001 IF(ITYPLU.NE.3) CALL XABORT('MACXSR: READ ERROR - CHARACTER VARI'
> //'ABLE EXPECTED: TOTA, NUSI, FIXE, TRAN, DIFF, CHI, SCAT, MIX ')
IF((CARLIR.EQ.'NTOT0').OR.(CARLIR.EQ.'TOTAL')) THEN
IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED')
IF(LINIXS(1,MATNUM)) THEN
LINIXS(1,MATNUM)=.FALSE.
ELSE
CALL XABORT('MACXSR: TOTAL XS FOR THIS MATERIAL ALREADY READ')
ENDIF
LNEWXS(1)=.TRUE.
*----
* TOTAL XS
*----
DO 100 IGROUP=1,NGROUP
CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP)
IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VARIA'
> //'BLE EXPECTED: TOTAL XS')
IF(LADD) FLOTT=FLOTT+XSTOTL(MATNUM,IGROUP)
XSTOTL(MATNUM,IGROUP)=FLOTT
100 CONTINUE
ELSE IF(CARLIR.EQ.'NUSIGF') THEN
IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED')
IF(NIFISS.EQ.0)CALL XABORT('MACXSR: NIFISS EXPECTED GREATER TH'
> //'AN ZERO')
IF(LINIXS(2,MATNUM)) THEN
LINIXS(2,MATNUM)=.FALSE.
ELSE
CALL XABORT('MACXSR: NUSIGF FOR THIS MATERIAL ALREADY READ')
ENDIF
LNEWXS(2)=.TRUE.
*----
* NUSIGF XS
*----
DO 110 IFIS=1,NIFISS
DO 120 IGROUP=1,NGROUP
CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP)
IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VAR'
> //'IABLE EXPECTED: NUSIGF')
IF(LADD) FLOTT=FLOTT+XSFISS(MATNUM,IFIS,IGROUP)
XSFISS(MATNUM,IFIS,IGROUP)=FLOTT
120 CONTINUE
110 CONTINUE
ELSE IF(CARLIR.EQ.'FIXE') THEN
IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED')
IF(LINIXS(3,MATNUM)) THEN
LINIXS(3,MATNUM)=.FALSE.
ELSE
CALL XABORT('MACXSR: FIXE FOR THIS MATERIAL ALREADY READ')
ENDIF
LNEWXS(3)=.TRUE.
*----
* FIXED SOURCES
*----
DO 130 IGROUP=1,NGROUP
CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP)
IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VARIA'
> //'BLE EXPECTED: FIXE')
IF(LADD) FLOTT=FLOTT+XSFIXE(MATNUM,IGROUP)
XSFIXE(MATNUM,IGROUP)=FLOTT
130 CONTINUE
ELSE IF(CARLIR.EQ.'TRANC') THEN
IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED')
IF(LINIXS(6,MATNUM)) THEN
LINIXS(6,MATNUM)=.FALSE.
ELSE
CALL XABORT('MACXSR: TRANC FOR THIS MATERIAL ALREADY READ')
ENDIF
LNEWXS(6)=.TRUE.
*----
* TRANSPORT CORRECTION
*----
DO 140 IGROUP=1,NGROUP
CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP)
IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VARIA'
> //'BLE EXPECTED: TRANC')
IF(LADD) FLOTT=FLOTT+XSTRAN(MATNUM,IGROUP)
XSTRAN(MATNUM,IGROUP)=FLOTT
140 CONTINUE
ELSE IF(CARLIR.EQ.'DIFF') THEN
IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED')
IF(LINIXS(7,MATNUM)) THEN
LINIXS(7,MATNUM)=.FALSE.
ELSE
CALL XABORT('MACXSR: DIFF FOR THIS MATERIAL ALREADY READ')
ENDIF
LNEWXS(7)=.TRUE.
*----
* ISOTROPIC DIFFUSION COEFFICIENT
*----
DO 145 IGROUP=1,NGROUP
CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP)
IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VARIA'
> //'BLE EXPECTED: DIFF')
IF(LADD) FLOTT=FLOTT+XSDIFF(MATNUM,IGROUP)
XSDIFF(MATNUM,IGROUP)=FLOTT
145 CONTINUE
ELSE IF(CARLIR.EQ.'DIFFX') THEN
IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED')
IF(LINIXS(10,MATNUM)) THEN
LINIXS(10,MATNUM)=.FALSE.
ELSE
CALL XABORT('MACXSR: DIFFX FOR THIS MATERIAL ALREADY READ')
ENDIF
LNEWXS(10)=.TRUE.
*----
* X-DIRECTED DIFFUSION COEFFICIENT
*----
DO IGROUP=1,NGROUP
CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP)
IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VARIA'
> //'BLE EXPECTED: DIFFX')
IF(LADD) CALL XABORT('MACXSR: INVALID OPTION ADD FOR DIFFX')
XSDIFX(MATNUM,IGROUP)=FLOTT
ENDDO
ELSE IF(CARLIR.EQ.'DIFFY') THEN
IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED')
IF(LINIXS(11,MATNUM)) THEN
LINIXS(11,MATNUM)=.FALSE.
ELSE
CALL XABORT('MACXSR: DIFFY FOR THIS MATERIAL ALREADY READ')
ENDIF
LNEWXS(11)=.TRUE.
*----
* Y-DIRECTED DIFFUSION COEFFICIENT
*----
DO IGROUP=1,NGROUP
CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP)
IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VARIA'
> //'BLE EXPECTED: DIFFY')
IF(LADD) CALL XABORT('MACXSR: INVALID OPTION ADD FOR DIFFY')
XSDIFY(MATNUM,IGROUP)=FLOTT
ENDDO
ELSE IF(CARLIR.EQ.'DIFFZ') THEN
IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED')
IF(LINIXS(12,MATNUM)) THEN
LINIXS(12,MATNUM)=.FALSE.
ELSE
CALL XABORT('MACXSR: DIFFZ FOR THIS MATERIAL ALREADY READ')
ENDIF
LNEWXS(12)=.TRUE.
*----
* Z-DIRECTED DIFFUSION COEFFICIENT
*----
DO IGROUP=1,NGROUP
CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP)
IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VARIA'
> //'BLE EXPECTED: DIFFZ')
IF(LADD) CALL XABORT('MACXSR: INVALID OPTION ADD FOR DIFFZ')
XSDIFZ(MATNUM,IGROUP)=FLOTT
ENDDO
ELSE IF(CARLIR.EQ.'NUSIGD') THEN
IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED')
IF(NDELG.EQ.0)CALL XABORT('MACXSR: NDG EXPECTED GREATER THAN'
> //' ZERO')
IF(LINIXS(13,MATNUM)) THEN
LINIXS(13,MATNUM)=.FALSE.
ELSE
CALL XABORT('MACXSR: NUSIGD FOR THIS MATERIAL ALREADY READ')
ENDIF
LNEWXS(13)=.TRUE.
*----
* DELAYED-NEUTRON NU*FISSION CROSS SECTIONS
*----
DO 12 IFIS=1,NIFISS
DO 11 IDELG=1,NDELG
DO 10 IGROUP=1,NGROUP
CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP)
IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VAR'
> //'IABLE EXPECTED: NUSIGD ')
IF(LADD) CALL XABORT('MACXSR: INVALID OPTION ADD FOR NUSIGD')
XSNUDL(MATNUM,IFIS,IDELG,IGROUP)=FLOTT
10 CONTINUE
11 CONTINUE
12 CONTINUE
ELSE IF(CARLIR.EQ.'CHDL') THEN
IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED')
IF(NDELG.EQ.0)CALL XABORT('MACXSR: NDG EXPECTED GREATER THAN'
> //' ZERO')
IF(LINIXS(14,MATNUM)) THEN
LINIXS(14,MATNUM)=.FALSE.
ELSE
CALL XABORT('MACXSR: CHDL FOR THIS MATERIAL ALREADY READ')
ENDIF
LNEWXS(14)=.TRUE.
*----
* DELAYED-NEUTRON FISSION SPECTRUM
*----
DO 22 IFIS=1,NIFISS
DO 21 IDELG=1,NDELG
DO 20 IGROUP=1,NGROUP
CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP)
IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VAR'
> //'IABLE EXPECTED: CHDL ')
IF(LADD) CALL XABORT('MACXSR: INVALID OPTION ADD FOR CHDL')
XSCHDL(MATNUM,IFIS,IDELG,IGROUP)=FLOTT
20 CONTINUE
21 CONTINUE
22 CONTINUE
ELSE IF(CARLIR.EQ.'OVERV') THEN
IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED')
IF(LINIXS(15,MATNUM)) THEN
LINIXS(15,MATNUM)=.FALSE.
ELSE
CALL XABORT('MACXSR: OVERV FOR THIS MATERIAL ALREADY READ')
ENDIF
LNEWXS(15)=.TRUE.
*----
* RECIPROCAL NEUTRON VELOCITY
*----
DO IGROUP=1,NGROUP
CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP)
IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VARIA'
> //'BLE EXPECTED: OVERV')
IF(LADD) CALL XABORT('MACXSR: INVALID OPTION ADD FOR OVERV')
XSOVRV(MATNUM,IGROUP)=FLOTT
ENDDO
ELSE IF(CARLIR.EQ.'FLUX-INTG') THEN
IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED')
IF(LINIXS(17,MATNUM)) THEN
LINIXS(17,MATNUM)=.FALSE.
ELSE
CALL XABORT('MACXSR: FLUX-INTG FOR THIS MATERIAL ALREADY READ')
ENDIF
LNEWXS(17)=.TRUE.
*----
* P0 VOLUME-INTEGRATED FLUX
*----
DO IGROUP=1,NGROUP
CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP)
IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VARIA'
> //'BLE EXPECTED: FLUX-INTG')
IF(LADD) CALL XABORT('MACXSR: INVALID OPTION ADD FOR FLUX-IN'
> //'TG')
XSINT0(MATNUM,IGROUP)=FLOTT
ENDDO
ELSE IF(CARLIR.EQ.'FLUX-INTG-P1') THEN
IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED')
IF(LINIXS(18,MATNUM)) THEN
LINIXS(18,MATNUM)=.FALSE.
ELSE
CALL XABORT('MACXSR: FLUX-INTG-P1 FOR THIS MATERIAL ALREADY '
> //'READ')
ENDIF
LNEWXS(18)=.TRUE.
*----
* P1 VOLUME-INTEGRATED FLUX
*----
DO IGROUP=1,NGROUP
CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP)
IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VARIA'
> //'BLE EXPECTED: FLUX-INTG-P1')
IF(LADD) CALL XABORT('MACXSR: INVALID OPTION ADD FOR FLUX-IN'
> //'TG-P1')
XSINT1(MATNUM,IGROUP)=FLOTT
ENDDO
ELSE IF(CARLIR.EQ.'H-FACTOR') THEN
IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED')
IF(LINIXS(8,MATNUM)) THEN
LINIXS(8,MATNUM)=.FALSE.
ELSE
CALL XABORT('MACXSR: H-FACTOR FOR THIS MATERIAL ALREADY READ')
ENDIF
LNEWXS(8)=.TRUE.
*----
* POWER FACTOR
*----
DO 146 IGROUP=1,NGROUP
CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP)
IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VARIA'
> //'BLE EXPECTED: H-FACTOR')
IF(LADD) FLOTT=FLOTT+XSH(MATNUM,IGROUP)
XSH(MATNUM,IGROUP)=FLOTT
146 CONTINUE
ELSE IF(CARLIR.EQ.'NTOT1') THEN
IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED')
IF(LINIXS(9,MATNUM)) THEN
LINIXS(9,MATNUM)=.FALSE.
ELSE
CALL XABORT('MACXSR: P1 TOTAL XS FOR THIS MATERIAL ALREADY R'
> //'EAD')
ENDIF
LNEWXS(9)=.TRUE.
*----
* P1 TOTAL XS
*----
DO 147 IGROUP=1,NGROUP
CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP)
IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VARIA'
> //'BLE EXPECTED: P1 TOTAL XS')
IF(LADD) FLOTT=FLOTT+XSTOT1(MATNUM,IGROUP)
XSTOT1(MATNUM,IGROUP)=FLOTT
147 CONTINUE
ELSE IF(CARLIR.EQ.'CHI') THEN
IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED')
IF(NIFISS.EQ.0)CALL XABORT('MACXSR: NIFISS EXPECTED GREATER TH'
> //'AN ZERO')
IF(LINIXS(4,MATNUM)) THEN
LINIXS(4,MATNUM)=.FALSE.
ELSE
CALL XABORT('MACXSR: CHI FOR THIS MATERIAL ALREADY READ')
ENDIF
LNEWXS(4)=.TRUE.
*----
* FISSION SPECTRUM
*----
DO 150 IFIS=1,NIFISS
DO 160 IGROUP=1,NGROUP
CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP)
IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VAR'
> //'IABLE EXPECTED: CHI ')
IF(LADD) FLOTT=FLOTT+XSSPEC(MATNUM,IFIS,IGROUP)
XSSPEC(MATNUM,IFIS,IGROUP)=FLOTT
160 CONTINUE
150 CONTINUE
ELSE IF(CARLIR.EQ.'NFTOT') THEN
IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED')
IF(LINIXS(16,MATNUM)) THEN
LINIXS(16,MATNUM)=.FALSE.
ELSE
CALL XABORT('MACXSR: NFTOT FOR THIS MATERIAL ALREADY READ')
ENDIF
LNEWXS(16)=.TRUE.
*----
* FISSION XS
*----
DO 155 IGROUP=1,NGROUP
CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP)
IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VARIA'
> //'BLE EXPECTED: NFTOT')
IF(LADD) FLOTT=FLOTT+XSNFTO(MATNUM,IGROUP)
XSNFTO(MATNUM,IGROUP)=FLOTT
155 CONTINUE
ELSE IF(CARLIR.EQ.'SCAT') THEN
IF(MATNUM.LE.0)CALL XABORT('MACXSR: NO MIXTURE NUMBER PROVIDED')
IF(LINIXS(5,MATNUM)) THEN
LINIXS(5,MATNUM)=.FALSE.
ELSE
CALL XABORT('MACXSR: SCATT XS FOR THIS MATERIAL ALREADY READ')
ENDIF
LNEWXS(5)=.TRUE.
*----
* SCATTERING XS: XSSCAT(JGROUP,MATNUM,JANS,IGROUP) WHERE IGROUP IS
* THE SECONDARY GROUP.
*----
DO 170 JANS=1,NANISO
ISCATA(JANS)=2
DO 180 IGROUP=1,NGROUP
*----
* READ NUMBER OF GROUPS AND FIRST GROUP
*----
CALL REDGET(ITYPLU,ING,REALIR,CARLIR,DBLINP)
IF(ITYPLU.NE.1) THEN
CALL XABORT('MACXSR: READ ERROR - INTEGER VARIABLE EXPEC'
> //'TED FOR SCAT: NGSCAT ')
ENDIF
CALL REDGET(ITYPLU,IFG,REALIR,CARLIR,DBLINP)
IF(ITYPLU.NE.1) CALL XABORT('MACXSR: READ ERROR - INTEGER '
> //'VARIABLE EXPECTED FOR SCAT: NFSCAT')
*----
* READ SCATTERING XS
*----
DO 190 JGROUP=NGROUP,1,-1
IF((JGROUP.GT.IFG).OR.(JGROUP.LE.(IFG-ING))) THEN
IF(.NOT.LADD) XSSCAT(JGROUP,MATNUM,JANS,IGROUP)=0.0
ELSE
CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP)
IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL'
> //' VARIABLE EXPECTED: SCAT')
IF(LADD) FLOTT=FLOTT+XSSCAT(JGROUP,MATNUM,JANS,IGROUP)
XSSCAT(JGROUP,MATNUM,JANS,IGROUP)=FLOTT
ENDIF
190 CONTINUE
180 CONTINUE
170 CONTINUE
ELSE IF(CARLIR.EQ.'ADF') THEN
CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP)
IF(ITYPLU.NE.3) CALL XABORT('MACXSR: READ ERROR - CHARACTER '
> //'VARIABLE EXPECTED: HADF')
ITYPE=ITYPE+1
IF(ITYPE.GT.NTYPE) CALL XABORT('MACXSR: NTYPE OVERFLOW.')
IF(HADF(ITYPE).EQ.' ') THEN
HADF(ITYPE)=CARLIR(:8)
ELSE IF(CARLIR(:8).NE.HADF(ITYPE)) THEN
CALL XABORT('MACXSR: READ ERROR - ADF NAME '//HADF(ITYPE)//
1 ' EXPECTED.')
ENDIF
DO 205 IGROUP=1,NGROUP
CALL REDGET(ITYPLU,INTLIR,FLOTT,CARLIR,DBLINP)
IF(ITYPLU.NE.2) CALL XABORT('MACXSR: READ ERROR - REAL VAR'
> //'IABLE EXPECTED: XADF ')
XADF(MATNUM,IGROUP,ITYPE)=FLOTT
205 CONTINUE
ELSE
IF(.NOT. LUPD .AND. MATNUM.GT.0 ) THEN
*----
* RESET XS THAT WERE NOT READ FOR THIS MATERIAL TO 0.0
*----
IF(LINIXS(1,MATNUM).AND.LOLDXS(1)) THEN
LNEWXS(1)=.TRUE.
DO 300 IGG=1,NGROUP
XSTOTL(MATNUM,IGG)=0.0
300 CONTINUE
ENDIF
IF(LINIXS(2,MATNUM).AND.LOLDXS(2)) THEN
LNEWXS(2)=.TRUE.
DO 310 IGG=1,NGROUP
DO 320 IFS=1,NIFISS
XSFISS(MATNUM,IFS,IGG)=0.0
320 CONTINUE
310 CONTINUE
ENDIF
IF(LINIXS(3,MATNUM).AND.LOLDXS(3)) THEN
LNEWXS(3)=.TRUE.
DO 330 IGG=1,NGROUP
XSFIXE(MATNUM,IGG)=0.0
330 CONTINUE
ENDIF
IF(LINIXS(4,MATNUM).AND.LOLDXS(4)) THEN
LNEWXS(4)=.TRUE.
DO 340 IGG=1,NGROUP
DO 350 IFS=1,NIFISS
XSSPEC(MATNUM,IFS,IGG)=0.0
350 CONTINUE
340 CONTINUE
ENDIF
IF(LINIXS(5,MATNUM).AND.LOLDXS(5)) THEN
LNEWXS(5)=.TRUE.
DO 360 JANS=1,NANISO
IF(ISCATA(JANS).GE.1) THEN
ISCATA(JANS)=2
DO 370 IGG=1,NGROUP
DO 380 JGG=1,NGROUP
XSSCAT(JGG,MATNUM,JANS,IGG)=0.0
380 CONTINUE
370 CONTINUE
ENDIF
360 CONTINUE
ENDIF
IF(LINIXS(6,MATNUM).AND.LOLDXS(6)) THEN
LNEWXS(6)=.TRUE.
DO 390 IGG=1,NGROUP
XSTRAN(MATNUM,IGG)=0.0
390 CONTINUE
ENDIF
IF(LINIXS(7,MATNUM).AND.LOLDXS(7)) THEN
LNEWXS(7)=.TRUE.
DO 400 IGG=1,NGROUP
XSDIFF(MATNUM,IGG)=0.0
400 CONTINUE
ENDIF
IF(LINIXS(8,MATNUM).AND.LOLDXS(8)) THEN
LNEWXS(8)=.TRUE.
DO 410 IGG=1,NGROUP
XSH(MATNUM,IGG)=0.0
410 CONTINUE
ENDIF
IF(LINIXS(9,MATNUM).AND.LOLDXS(9)) THEN
LNEWXS(9)=.TRUE.
DO 420 IGG=1,NGROUP
XSTOT1(MATNUM,IGG)=0.0
420 CONTINUE
ENDIF
IF(LINIXS(10,MATNUM).AND.LOLDXS(10)) THEN
LNEWXS(10)=.TRUE.
DO 430 IGG=1,NGROUP
XSDIFX(MATNUM,IGG)=0.0
430 CONTINUE
ENDIF
IF(LINIXS(11,MATNUM).AND.LOLDXS(11)) THEN
LNEWXS(11)=.TRUE.
DO 440 IGG=1,NGROUP
XSDIFY(MATNUM,IGG)=0.0
440 CONTINUE
ENDIF
IF(LINIXS(12,MATNUM).AND.LOLDXS(12)) THEN
LNEWXS(12)=.TRUE.
DO 450 IGG=1,NGROUP
XSDIFZ(MATNUM,IGG)=0.0
450 CONTINUE
ENDIF
IF(LINIXS(13,MATNUM).AND.LOLDXS(13)) THEN
LNEWXS(13)=.TRUE.
DO 462 IGG=1,NGROUP
DO 461 IDELG=1,NDELG
DO 460 IFS=1,NIFISS
XSNUDL(MATNUM,IFS,IDELG,IGG)=0.0
460 CONTINUE
461 CONTINUE
462 CONTINUE
ENDIF
IF(LINIXS(14,MATNUM).AND.LOLDXS(14)) THEN
LNEWXS(14)=.TRUE.
DO 472 IGG=1,NGROUP
DO 471 IDELG=1,NDELG
DO 470 IFS=1,NIFISS
XSCHDL(MATNUM,IFS,IDELG,IGG)=0.0
470 CONTINUE
471 CONTINUE
472 CONTINUE
ENDIF
IF(LINIXS(15,MATNUM).AND.LOLDXS(15)) THEN
LNEWXS(15)=.TRUE.
DO 480 IGG=1,NGROUP
XSOVRV(MATNUM,IGG)=0.0
480 CONTINUE
ENDIF
IF(LINIXS(16,MATNUM).AND.LOLDXS(16)) THEN
LNEWXS(16)=.TRUE.
DO 490 IGG=1,NGROUP
XSNFTO(MATNUM,IGG)=0.0
490 CONTINUE
ENDIF
IF(LINIXS(17,MATNUM).AND.LOLDXS(17)) THEN
LNEWXS(17)=.TRUE.
DO 500 IGG=1,NGROUP
XSINT0(MATNUM,IGG)=0.0
500 CONTINUE
ENDIF
IF(LINIXS(18,MATNUM).AND.LOLDXS(18)) THEN
LNEWXS(18)=.TRUE.
DO 510 IGG=1,NGROUP
XSINT1(MATNUM,IGG)=0.0
510 CONTINUE
ENDIF
ENDIF
*----
* READ MIXTURE INDEX
*----
IF(CARLIR.EQ.'MIX') THEN
MATNUM=MATNUM+1
ITYPE=0
CALL REDGET(ITYPLU,MATNUM,REALIR,CARLIR,DBLINP)
IF(MATNUM.GT.NBMIX) CALL XABORT('MACXSR: MATNUM OVERFLOW.')
IF(ITYPLU.NE.1) GO TO 1001
ELSE
*----
* ALL MIXTURE READ RETURN
*----
IF(IPRINT.GE.1) THEN
*----
* FIND MATERIAL FOR WHICH XS ARE READ AND PRINT TYPE OF XS READ
*----
WRITE(IUNOUT,6000) NANISO
DO 220 IM=1,NBMIX
DO 230 IT=1,NCXST
IF(.NOT.LINIXS(IT,IM)) THEN
CARXST(IT)='READ '
ELSE
CARXST(IT)=' '
ENDIF
230 CONTINUE
WRITE(IUNOUT,6001) IM,(CARXST(JJ),JJ=1,7),CARXST(15),
> CARXST(16),CARXST(17),CARXST(18)
220 CONTINUE
ENDIF
GO TO 550
ENDIF
ENDIF
*----
* RETURN TO READ NEXT KEYWORD
*----
GO TO 1000
*----
* SCRATCH STORAGE DEALLOCATION
*----
550 DEALLOCATE(LINIXS)
RETURN
*----
* FORMAT
*----
6000 FORMAT(' CROSS SECTION TYPE',5X,'NTOT0 ',5X,'NUSIGF',5X,'FIXE ',
> 5X,'CHI ',5X,'SCAT (NL= 1,',I3,')',8X,'TRANC ',5X,'DIFF ',
> 5X,'H-FACTOR',3X,'NFTOT',6X,'FLUX-INTG',2X,'FLUX-INTG-P1')
6001 FORMAT(' MATERIAL ',I5,4X,5(5X,A6),16X,A6,3X,5(5X,A6))
END
|
