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
|
*DECK LIBLIC
SUBROUTINE LIBLIC (IPLIB,NBISO,MASKI,IMPX,NGRO,NL,ITRANC,ITIME,
1 NLIB,NED,HVECT,ISONAM,ISONRF,IPISO,ISHINA,TMPISO,IHLIB,ILLIB,
2 INAME,NTFG,LSHI,SN,SB,NIR,GIR,NGF,IGRMAX,NDEL,NBESP,NPART,IPROC,
3 NDEPL)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Transcription of the useful interpolated microscopic cross section
* data from various format of libraries to lcm. A two dimensional
* interpolation in temperature and dilution is performed (Part B).
*
*Copyright:
* Copyright (C) 2002 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): A. Hebert
*
*Parameters: input
* IPLIB pointer to the lattice microscopic cross section library
* (L_LIBRARY signature).
* NBISO number of isotopes present in the calculation domain.
* MASKI isotopic masks. An isotope with index I is processed if
* MASKI(I)=.true.
* IMPX print flag.
* NGRO number of energy groups.
* NL number of Legendre orders required in the calculation
* NL=1 (for isotropic scattering) or higher.
* ITRANC type of transport correction: =0 no transport correction
* =1 Apollo type transport correction; =2 recover from
* library; =3 Wims-D type; =4 leakage correction alone.
* ITIME MATXS type of fission spectrum:
* =1 steady-state; =2 prompt.
* NLIB number of independent libraries.
* NED number of requested vector edits.
* HVECT names of the requested vector edits.
* ISONAM alias name of each isotope.
* ISONRF library reference name of each isotope.
* IPISO pointer array towards microlib isotopes.
* ISHINA self-shielding name of each isotope.
* TMPISO temperature of each isotope.
* IHLIB isotope options.
* ILLIB xs library index for each isotope (.le.NLIB).
* INAME names of the NLIB xs libraries.
* NTFG number of thermal groups where the thermal inelastic
* correction is applied.
* LSHI resonant region number associated with each isotope.
* Infinite dilution will be assumed if LSHI(i)=0.
* SN dilution cross section in each energy group of each
* isotope. a value of 1.0E10 is used for infinite dilution.
* SB dilution cross section as used in Livolant and Jeanpierre
* normalization.
* NIR first group index with an imposed IR slowing-down model;
* =0 for no IR model.
* GIR value of the imposed Goldstein-Cohen parameter for groups
* with an IR model.
* NGF number of fast groups without self-shielding.
* IGRMAX maximum group index with self-shielding.
* NDEL number of precursor groups for delayed neutrons.
* NBESP number of energy-dependent fission spectra.
* NPART number of particles.
* IPROC type of library processing.
* NDEPL number of depleting isotopes.
*
*-----------------------------------------------------------------------
*
USE GANLIB
#if defined(HDF5_LIB)
USE hdf5_wrap
#endif /* defined(HDF5_LIB) */
IMPLICIT NONE
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPLIB,IPISO(NBISO)
INTEGER NBISO,IMPX,NGRO,NL,ITRANC,ITIME,NLIB,NED,NGF,IGRMAX,NDEL,
> NBESP,NPART,IPROC,NDEPL,ISONAM(3,NBISO),ISONRF(3,NBISO),
> ISHINA(3,NBISO),IHLIB(2,NBISO,4),ILLIB(NBISO),INAME(16,NLIB),
> NTFG(NBISO),LSHI(NBISO),NIR(NBISO)
LOGICAL MASKI(NBISO)
CHARACTER*(*) HVECT(NED)
REAL TMPISO(NBISO),SN(NGRO,NBISO),SB(NGRO,NBISO),GIR(NBISO)
*----
* INTERNAL PARAMETERS
*----
TYPE(C_PTR) IPDRL,IPMIC
INTEGER MAXDIL
PARAMETER (MAXDIL=65)
*----
* LOCAL VARIABLES
*----
INTEGER I,J,IND1,NBIS,NDEL0,NGF0,NGFR0,MAXTRA,ILIB,ILONG,NBESP0,
1 NPART0
CHARACTER NAMLBT*8,NAMFIL*64,HSMG*131,NAMLCM*12,NAMMY*12
LOGICAL LTEST,EMPTY,LCM,LEXIST
*----
* CHECK FOR DUPLICATE ISOTOPE NAMES.
*----
DO 40 I=1,NBISO
IF(MASKI(I).AND.(ILLIB(I).NE.0).AND.(LSHI(I).NE.0)) THEN
DO 30 J=I+1,NBISO
IF(MASKI(J).AND.(ISONAM(1,I).EQ.ISONAM(1,J)).AND.
1 (ISONAM(2,I).EQ.ISONAM(2,J)).AND.
2 (ISONAM(3,I).EQ.ISONAM(3,J))) THEN
WRITE (HSMG,200) ISONAM(1,I),ISONAM(2,I),ISONAM(3,I)
CALL XABORT(HSMG)
ENDIF
30 CONTINUE
ENDIF
40 CONTINUE
*
NPART=1
NGF0=NGRO+1
NGFR0=0
IND1=1
50 NBIS=1
LTEST=MASKI(IND1)
DO 60 I=IND1+1,NBISO
IF(ILLIB(I).EQ.0) THEN
NBIS=NBIS+1
ELSE IF((IHLIB(1,I,1).EQ.IHLIB(1,IND1,1)).AND.
1 (IHLIB(2,I,1).EQ.IHLIB(2,IND1,1)).AND.
2 (ILLIB(I).EQ.ILLIB(IND1))) THEN
NBIS=NBIS+1
LTEST=LTEST.OR.MASKI(I)
ELSE
GO TO 70
ENDIF
60 CONTINUE
70 WRITE(NAMLBT,'(2A4)') IHLIB(1,IND1,1),IHLIB(2,IND1,1)
ILIB=ILLIB(IND1)
IF(ILIB.EQ.0) THEN
NAMFIL=' '
ELSE
WRITE(NAMFIL,'(16A4)') (INAME(I,ILIB),I=1,16)
ENDIF
NDEL0=0
CALL LCMINF(IPLIB,NAMLCM,NAMMY,EMPTY,ILONG,LCM)
IF(LTEST.AND.(NAMLBT.EQ.'DRAGON')) THEN
* TRANSFER INFORMATION FROM DRAGON LIBRARY TO LCM.
CALL LCMOP(IPDRL,NAMFIL(:12),2,2,0)
CALL LIBDRA(IPLIB,IPDRL,NAMFIL,NGRO,NBIS,NL,ISONAM(1,IND1),
1 ISONRF(1,IND1),IPISO(IND1),TMPISO(IND1),SN(1,IND1),SB(1,IND1),
2 MASKI(IND1),NED,HVECT,IMPX,NGF0,NGFR0,NDEL0,NBESP0)
CALL LCMCL(IPDRL,1)
NBESP=MAX(NBESP,NBESP0)
ELSE IF(LTEST.AND.(NAMLBT(1:4).EQ.'WIMS')) THEN
* TRANSFER INFORMATION FROM WIMS LIBRARY FILE TO LCM.
IF(NAMLBT.EQ.'WIMSD4') THEN
* WIMS-D4 FORMAT
CALL LIBWD4(IPLIB,IMPX,NAMFIL,NGRO,NBIS,NL,ISONAM(1,IND1),
1 ISONRF(1,IND1),IPISO(IND1),ISHINA(1,IND1),TMPISO(IND1),
2 SN(1,IND1),SB(1,IND1),MASKI(IND1),NGF0,NGFR0)
ELSE IF(NAMLBT.EQ.'WIMSE') THEN
* WIMS-E FORMAT
CALL LIBWE(IPLIB,IMPX,NAMFIL,NGRO,NBIS,NL,ISONAM(1,IND1),
1 ISONRF(1,IND1),IPISO(IND1),ISHINA(1,IND1),TMPISO(IND1),
2 SN(1,IND1),SB(1,IND1),MASKI(IND1),NGF0,NGFR0)
ELSE IF(NAMLBT.EQ.'WIMSAECL') THEN
* WIMS-AECL FORMAT
CALL LIBWIM(IPLIB,IMPX,NAMFIL,NGRO,NBIS,NL,ISONAM(1,IND1),
1 ISONRF(1,IND1),IPISO(IND1),ISHINA(1,IND1),TMPISO(IND1),
2 SN(1,IND1),SB(1,IND1),MASKI(IND1),NGF0,NGFR0)
ENDIF
ELSE IF(LTEST.AND.(NAMLBT.EQ.'MATXS')) THEN
* TRANSFER INFORMATION FROM MATXS (NJOY-89) TO LCM.
CALL LIBTR1(IPLIB,NAMFIL,NGRO,NBIS,NL,ISONAM(1,IND1),
1 ISONRF(1,IND1),IPISO(IND1),IHLIB(1,IND1,2),IHLIB(1,IND1,3),
2 NTFG(IND1),TMPISO(IND1),SN(1,IND1),SB(1,IND1),MASKI(IND1),NED,
3 HVECT,ITIME,IMPX,NGF0,NGFR0)
ELSE IF(LTEST.AND.(NAMLBT.EQ.'MATXS2')) THEN
* TRANSFER INFORMATION FROM MATXS (NJOY-91) TO LCM.
CALL LIBTR2(IPLIB,NAMFIL,NGRO,NBIS,NL,ISONAM(1,IND1),
1 ISONRF(1,IND1),IPISO(IND1),IHLIB(1,IND1,2),IHLIB(1,IND1,3),
2 IHLIB(1,IND1,4),NTFG(IND1),TMPISO(IND1),SN(1,IND1),SB(1,IND1),
3 MASKI(IND1),NED,HVECT,ITIME,IMPX,NGF0,NGFR0,NPART0)
NPART=MAX(NPART,NPART0)
ELSE IF(LTEST.AND.(NAMLBT.EQ.'APLIB1')) THEN
* TRANSFER INFORMATION FROM APOLIB-1 TO LCM.
MAXTRA=NL*NGRO**2
CALL LIBAPL(IPLIB,NAMFIL,MAXTRA,NGRO,NBIS,NL,ISONAM(1,IND1),
1 ISONRF(1,IND1),IPISO(IND1),ISHINA(1,IND1),MASKI(IND1),
2 TMPISO(IND1),SN(1,IND1),SB(1,IND1),IMPX,NGF0,NGFR0)
ELSE IF(LTEST.AND.(NAMLBT.EQ.'APLIB2')) THEN
* TRANSFER INFORMATION FROM APOLIB-2 TO LCM.
CALL LIBA20(IPLIB,NAMFIL,NGRO,NBIS,NL,IPROC,ISONAM(1,IND1),
1 ISONRF(1,IND1),IPISO(IND1),ISHINA(1,IND1),MASKI(IND1),
2 TMPISO(IND1),SN(1,IND1),SB(1,IND1),IMPX,NGF0,NGFR0,NDEL0)
ELSE IF(LTEST.AND.(NAMLBT.EQ.'APXSM')) THEN
* TRANSFER INFORMATION FROM APOLIB-XSM TO LCM.
CALL LIBXS4(IPLIB,NAMFIL,NGRO,NBIS,NL,IPROC,ISONAM(1,IND1),
1 ISONRF(1,IND1),IPISO(IND1),ISHINA(1,IND1),MASKI(IND1),
2 TMPISO(IND1),SN(1,IND1),SB(1,IND1),IMPX,NGF0,NGFR0,NDEL0)
ELSE IF(LTEST.AND.(NAMLBT.EQ.'APLIB3')) THEN
* TRANSFER INFORMATION FROM APOLIB-3 TO LCM.
#if defined(HDF5_LIB)
CALL LIBA30 (IPLIB,NAMFIL,NGRO,NBIS,NL,ISONAM(1,IND1),
1 ISONRF(1,IND1),IPISO(IND1),MASKI(IND1),TMPISO(IND1),LSHI(IND1),
2 SN(1,IND1),SB(1,IND1),IMPX,NGF0,NGFR0,NDEL0)
#else
CALL XABORT('LIBLIC: THE HDF5 API IS NOT AVAILABLE.')
#endif /* defined(HDF5_LIB) */
ELSE IF(LTEST.AND.(NAMLBT.EQ.'NDAS')) THEN
CALL LIBND1(IPLIB,NAMFIL,NGRO,NBIS,NL,ISONAM(1,IND1),
1 ISONRF(1,IND1),IPISO(IND1),MASKI(IND1),TMPISO(IND1),SN(1,IND1),
2 SB(1,IND1),IMPX,NGF0,NGFR0,NDEL0)
ELSE IF(LTEST.AND.(NAMLBT.EQ.'MICROLIB')) THEN
* TRANSFER INFORMATION FROM MICROLIB LIBRARY TO LCM.
CALL LCMINF(IPLIB,NAMLCM,NAMMY,EMPTY,ILONG,LCM)
IF(NAMFIL.EQ.NAMLCM) THEN
IPMIC=IPLIB
ELSE
INQUIRE(FILE=TRIM(NAMFIL),EXIST=LEXIST)
IF(.NOT.LEXIST) THEN
WRITE(HSMG,'(17HLIBLIC: XSM FILE ,A,14H DOESNT EXIST.)')
1 TRIM(NAMFIL)
CALL XABORT(HSMG)
ENDIF
CALL LCMOP(IPMIC,NAMFIL(:12),2,2,0)
ENDIF
CALL LIBMIC(IPLIB,IPMIC,NAMFIL,NGRO,NBIS,ISONAM(1,IND1),
1 ISONRF(1,IND1),IPISO(IND1),MASKI(IND1),IMPX,NGF0,NGFR0,NDEL0,
2 NBESP0)
IF(NAMFIL.NE.NAMLCM) CALL LCMCL(IPMIC,1)
NBESP=MAX(NBESP,NBESP0)
ENDIF
IF(LTEST) THEN
NGF=MIN(NGF,NGF0)
IGRMAX=MAX(IGRMAX,NGFR0)
IF(NDEL.EQ.0) THEN
NDEL=NDEL0
ELSE IF((NDEL0.NE.NDEL).AND.(NDEL0.NE.0)) THEN
ILIB=ILLIB(IND1)
IF(ILIB.GT.0) WRITE(6,210) (INAME(I,ILIB),I=1,4),NDEL0,NDEL
NDEL=MAX(NDEL,NDEL0)
ENDIF
*
* COMPUTE THE TRANSPORT XS AND ADD COMPLEMENTARY INFORMATION.
CALL LIBADD(IPLIB,NBIS,MASKI(IND1),IMPX,NGRO,NL,ITRANC,NDEPL,
1 ISONAM(1,IND1),ISONRF(1,IND1),IPISO(IND1),NIR(IND1),GIR(IND1))
ENDIF
*
IND1=IND1+NBIS
IF(IND1.LE.NBISO) GO TO 50
RETURN
*
200 FORMAT(8HLIBLIC: ,3A4,34H IS A DUPLICATE ISOTOPE/MATERIAL N,
1 4HAME.)
210 FORMAT(/51H LIBLIC: INVALID NB OF PRECURSOR GROUPS IN LIBRARY ,
1 4A4,8H (NDEL0=,I3,6H NDEL=,I3,2H).)
END
|
