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
|
*DECK APXTOC
SUBROUTINE APXTOC(IPAPX,IMPX,NLAM,NREA,NBISO,NBMAC,NMIL,NPAR,
1 NVP,NISOF,NISOP,NISOS,NCAL,NGRP,NISOTS,NSURFD,NPRC)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Recover the table of content of an Apex file.
*
*Copyright:
* Copyright (C) 2021 Ecole Polytechnique de Montreal
*
*Author(s):
* A. Hebert
*
*Parameters: input
* IPAPX address of the Apex file.
* IMPX print parameter (equal to zero for no print).
*
*Parameters: output
* NLAM number of types of radioactive decay reactions
* NREA number of neutron-induced reaction
* NBISO number of particularized isotopes
* NBMAC number of macroscopic sets
* NMIL number of mixtures in the APEX
* NPAR number of parameters
* NVP number of nodes in the global parameter tree
* NISOF number of particularized fissile isotopes
* NISOP number of particularized fission products
* NISOS number of particularized stable isotopes
* NCAL number of elementary calculations
* NGRP number of energy groups
* NISOTS maximum number of isotopes in output tables
* NSURFD number of discontinuity factors values in the Apex file
* NPRC number of precursors
*
*-----------------------------------------------------------------------
*
USE GANLIB
USE hdf5_wrap
IMPLICIT NONE
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPAPX
INTEGER IMPX,NLAM,NREA,NBISO,NBMAC,NMIL,NPAR,NVP,NISOF,NISOP,
1 NISOS,NCAL,NGRP,NISOTS,NSURFD,NPRC
*----
* LOCAL VARIABLES
*----
INTEGER, PARAMETER::IOUT=6
INTEGER I,II,RANK,TYPE,NBYTE,DIMSR(5)
CHARACTER HSMG*131,RECNAM*80
CHARACTER(LEN=100), ALLOCATABLE, DIMENSION(:) :: LIST
INTEGER, ALLOCATABLE, DIMENSION(:) :: DIMS_APX
CHARACTER(LEN=4), ALLOCATABLE, DIMENSION(:) :: TYPISO
*----
* LIST GROUPS AND DATASETS ON THE ROOT FILE
*----
IF(IMPX.GT.0) THEN
CALL hdf5_list_groups(IPAPX, '/', LIST)
WRITE(*,*)
WRITE(*,*) 'APXTOC: GROUP TABLE OF CONTENTS'
DO I=1,SIZE(LIST)
WRITE(*,*) TRIM(LIST(I))
ENDDO
DEALLOCATE(LIST)
CALL hdf5_list_datasets(IPAPX, '/', LIST)
WRITE(*,*)
WRITE(*,*) 'APXTOC: DATASET TABLE OF CONTENTS'
DO I=1,SIZE(LIST)
WRITE(*,*) TRIM(LIST(I))
ENDDO
DEALLOCATE(LIST)
ENDIF
*----
* RECOVER APEX PARAMETERS
*----
NMIL=1
NGRP=0
CALL hdf5_read_data(IPAPX,"NCALS",NCAL)
IF(hdf5_group_exists(IPAPX,"/physconst/")) THEN
CALL hdf5_info(IPAPX,"/physconst/ENRGS",RANK,TYPE,NBYTE,DIMSR)
IF(TYPE.NE.99) THEN
CALL hdf5_get_shape(IPAPX,"/physconst/ENRGS",DIMS_APX)
ELSE
GO TO 10
ENDIF
ELSE IF(hdf5_group_exists(IPAPX,"/physco001/")) THEN
CALL hdf5_info(IPAPX,"/physc001/ENRGS",RANK,TYPE,NBYTE,DIMSR)
IF(TYPE.NE.99) THEN
CALL hdf5_get_shape(IPAPX,"/physc001/ENRGS",DIMS_APX)
ELSE
GO TO 10
ENDIF
ELSE
CALL XABORT('APXTOC: GROUP physconst NOT FOUND IN HDF5 FILE.')
ENDIF
IF(NGRP.EQ.0) THEN
NGRP=DIMS_APX(1)-1
ELSE IF(NGRP.NE.DIMS_APX(1)-1) THEN
WRITE(HSMG,'(46H APXTOC: THE APEX FILE HAS AN INVALID NUMBER O,
1 17HF ENERGY GROUPS (,I4,3H VS,I5,2H).)') NGRP,DIMS_APX(1)-1
CALL XABORT(HSMG)
ENDIF
DEALLOCATE(DIMS_APX)
10 NBMAC=0
NREA=0
IF(hdf5_group_exists(IPAPX,"/explicit/")) THEN
NBISO=0
CALL hdf5_info(IPAPX,"/explicit/ISONAME",RANK,TYPE,NBYTE,DIMSR)
IF(RANK.NE.99) NBISO=DIMSR(1)
NBMAC=0
CALL hdf5_info(IPAPX,"/explicit/MACNAME",RANK,TYPE,NBYTE,DIMSR)
IF(RANK.NE.99) NBMAC=DIMSR(1)
NREA=0
CALL hdf5_info(IPAPX,"/explicit/REANAME",RANK,TYPE,NBYTE,DIMSR)
IF(RANK.NE.99) NREA=DIMSR(1)
ELSE IF(hdf5_group_exists(IPAPX,"/expli001/")) THEN
NBISO=0
CALL hdf5_info(IPAPX,"/expli001/ISONAME",RANK,TYPE,NBYTE,DIMSR)
IF(RANK.NE.99) NBISO=DIMSR(1)
NBMAC=0
CALL hdf5_info(IPAPX,"/expli001/MACNAME",RANK,TYPE,NBYTE,DIMSR)
IF(RANK.NE.99) NBMAC=DIMSR(1)
NREA=0
CALL hdf5_info(IPAPX,"/expli001/REANAME",RANK,TYPE,NBYTE,DIMSR)
IF(RANK.NE.99) NREA=DIMSR(1)
ELSE
CALL XABORT('APXTOC: GROUP explicit NOT FOUND IN APEX FILE.')
ENDIF
*----
* SET NISOF AND NISOP
*----
NISOF=0
NISOP=0
NISOS=0
NSURFD=0
IF(NBISO.GT.0) THEN
IF(hdf5_group_exists(IPAPX,"/physconst/")) THEN
CALL hdf5_get_shape(IPAPX,"/physconst/ISOTA",DIMS_APX)
ELSE IF(hdf5_group_exists(IPAPX,"/physco001/")) THEN
CALL hdf5_get_shape(IPAPX,"/physc001/ISOTA",DIMS_APX)
ENDIF
IF(DIMS_APX(1).NE.NBISO) THEN
WRITE(HSMG,'(44H APXTOC: INCONSISTENT number of ISOTOPES IN ,
1 31Hexplicit AND physconst GROUPS (,I4,3H VS,I5,2H).)') NBISO,
2 DIMS_APX(1)
CALL XABORT(HSMG)
ENDIF
DEALLOCATE(DIMS_APX)
IF(hdf5_group_exists(IPAPX,"/physconst/")) THEN
CALL hdf5_read_data(IPAPX,"/physconst/ISOTYP",TYPISO)
ELSE IF(hdf5_group_exists(IPAPX,"/physco001/")) THEN
CALL hdf5_read_data(IPAPX,"/physc001/ISOTYP",TYPISO)
ENDIF
DO I=1,NBISO
IF(TYPISO(I).EQ.'FISS') NISOF=NISOF+1
IF(TYPISO(I).EQ.'F.P.') NISOP=NISOP+1
IF(TYPISO(I).EQ.'OTHE') NISOS=NISOS+1
ENDDO
DEALLOCATE(TYPISO)
ENDIF
IF(NCAL.EQ.0) GO TO 20
*----
* SET DECAYC, NVALUE AND TREEVAL
*----
NLAM=0
NISOTS=0
IF(hdf5_group_exists(IPAPX,"/physconst/")) THEN
CALL hdf5_info(IPAPX,"/physconst/DECAYC",RANK,TYPE,NBYTE,DIMSR)
ELSE IF(hdf5_group_exists(IPAPX,"/physco001/")) THEN
CALL hdf5_info(IPAPX,"/physc001/DECAYC",RANK,TYPE,NBYTE,DIMSR)
ENDIF
IF(RANK.NE.99) THEN
NLAM=DIMSR(1)
NISOTS=DIMSR(2)
ENDIF
NPAR=0
CALL hdf5_info(IPAPX,"/paramdescrip/NVALUE",RANK,TYPE,NBYTE,DIMSR)
IF(RANK.NE.99) NPAR=DIMSR(1)
NVP=0
IF(hdf5_group_exists(IPAPX,"/paramtree")) THEN
CALL hdf5_info(IPAPX,"/paramtree/TREEVAL",RANK,TYPE,NBYTE,DIMSR)
IF(RANK.NE.99) NVP=DIMSR(1)
ENDIF
*----
* SET NSURFD
*----
RECNAM='calc 1/miscellaneous/'
CALL hdf5_info(IPAPX,TRIM(RECNAM)//"ADF",RANK,TYPE,NBYTE,DIMSR)
IF(TYPE.NE.99) NSURFD=NSURFD+DIMSR(1)
CALL hdf5_info(IPAPX,TRIM(RECNAM)//"CPDF",RANK,TYPE,NBYTE,DIMSR)
IF(TYPE.NE.99) NSURFD=NSURFD+DIMSR(1)
CALL hdf5_info(IPAPX,TRIM(RECNAM)//"INTERNAL_ADF",RANK,TYPE,NBYTE,
1 DIMSR)
IF(TYPE.NE.99) NSURFD=NSURFD+DIMSR(1)
CALL hdf5_info(IPAPX,TRIM(RECNAM)//"INTERNAL_CPDF",RANK,TYPE,
1 NBYTE,DIMSR)
IF(TYPE.NE.99) NSURFD=NSURFD+DIMSR(1)
*----
* SET NPRC
*----
NPRC=0
CALL hdf5_list_groups(IPAPX, "calc 1", LIST)
DO I=1,SIZE(LIST)
IF(TRIM(LIST(I)).EQ.'kinetics') THEN
RECNAM='calc 1/kinetics/LAMBDA'
CALL hdf5_info(IPAPX,TRIM(RECNAM)//"INTERNAL_ADF",RANK,TYPE,
1 NBYTE,DIMSR)
IF(TYPE.NE.99) NPRC=DIMSR(1)
EXIT
ENDIF
*----
* SET NMIL
*----
IF(LIST(I)(:2).EQ.'xs') THEN
IF(LEN(LIST(I)).EQ.2) CYCLE
READ(LIST(I),'(2X,I8)') II
NMIL=MAX(II,NMIL)
ENDIF
ENDDO
DEALLOCATE(LIST)
*----
* PRINT APEX PARAMETERS
*----
20 IF(IMPX.GT.0) THEN
WRITE(IOUT,'(/38H APXTOC: table of content information:)')
WRITE(IOUT,'(32H nb of radioactive reactions =,I3)') NLAM
WRITE(IOUT,'(36H nb of neutron-induced reactions =,I3)') NREA
WRITE(IOUT,'(34H nb of particularized isotopes =,I4)') NBISO
WRITE(IOUT,'(27H nb of macroscopic sets =,I2)') NBMAC
WRITE(IOUT,'(19H nb of mixtures =,I5)') NMIL
WRITE(IOUT,'(28H nb of global parameters =,I4)') NPAR
WRITE(IOUT,'(38H nb of nodes in the parameter tree =,I4)') NVP
WRITE(IOUT,'(42H nb of particularized fissile isotopes =,I4)')
1 NISOF
WRITE(IOUT,'(42H nb of particularized fission products =,I4)')
1 NISOP
WRITE(IOUT,'(41H nb of particularized stable isotopes =,I4)')
1 NISOS
WRITE(IOUT,'(23H nb of calculations =,I9)') NCAL
WRITE(IOUT,'(24H nb of energy groups =,I4)') NGRP
WRITE(IOUT,'(44H maximum nb of isotopes in output tables =,
1 I4)') NISOTS
WRITE(IOUT,'(39H nb of discontinuity factors values =,I4)')
1 NSURFD
WRITE(IOUT,'(21H nb of precursors =,I4/)') NPRC
ENDIF
RETURN
END
|
