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
|
*DECK MPOTOC
SUBROUTINE MPOTOC(IPMPO,HEDIT,IMPX,NREA,NBISO,NMIL,NPAR,NLOC,
1 NISOF,NISOP,NISOS,NCAL,NGRP,NSURFD,NALBP,NPRC)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Recover the table of content of an MPO file.
*
*Copyright:
* Copyright (C) 2022 Ecole Polytechnique de Montreal
*
*Author(s):
* A. Hebert
*
*Parameters: input
* IPMPO address of the MPO file.
* HEDIT name of output group for a (multigroup mesh, output geometry)
* couple (generally equal to 'output_0').
* IMPX print parameter (equal to zero for no print).
*
*Parameters: output
* NREA number of neutron-induced reaction
* NBISO number of particularized isotopes
* NMIL number of mixtures in the MPO file
* NPAR number of global parameters
* NLOC number of local parameters
* 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
* NSURFD number of discontinuity factors values in the MPO file
* NALBP number of physical albedos per energy group
* NPRC number of precursors
*
*-----------------------------------------------------------------------
*
USE GANLIB
USE hdf5_wrap
IMPLICIT NONE
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPMPO
INTEGER IMPX,NREA,NBISO,NMIL,NPAR,NLOC,NISOF,NISOP,NISOS,NCAL,
1 NGRP,NSURFD,NALBP,NPRC
CHARACTER(LEN=12) HEDIT
*----
* LOCAL VARIABLES
*----
INTEGER, PARAMETER::IOUT=6
INTEGER I,J,NENERG,NGEOME,ID_G,ID_E,ID,IBM,NGRP2,RANK,TYPE,NBYTE,
1 DIMSR(5)
CHARACTER HSMG*131,RECNAM*80,HFORMAT*132
LOGICAL LNEW
CHARACTER(LEN=100), ALLOCATABLE, DIMENSION(:) :: LIST
INTEGER, ALLOCATABLE, DIMENSION(:) :: DIMS_MPO,ADDRISO
INTEGER, ALLOCATABLE, DIMENSION(:,:) :: OUPUTID
*----
* LIST GROUPS AND DATASETS ON THE ROOT FILE
*----
IF(IMPX.GT.0) THEN
CALL hdf5_list_groups(IPMPO, '/', LIST)
WRITE(*,*)
WRITE(*,*) 'MPOTOC: GROUP TABLE OF CONTENTS'
DO I=1,SIZE(LIST)
WRITE(*,*) TRIM(LIST(I))
ENDDO
DEALLOCATE(LIST)
ENDIF
*----
* RECOVER MPO PARAMETERS
*----
ID_G=-1
ID_E=-1
CALL hdf5_read_data(IPMPO,"/parameters/tree/NSTATEPOINT",NCAL)
CALL hdf5_read_data(IPMPO,"/energymesh/NENERGYMESH",NENERG)
CALL hdf5_read_data(IPMPO,"/geometry/NGEOMETRY",NGEOME)
IF((NENERG.GT.0).AND.(NGEOME.GT.0)) THEN
CALL hdf5_read_data(IPMPO,"/output/OUPUTID",OUPUTID)
READ(HEDIT,'(7X,I2)') ID
DO I=1,NGEOME
DO J=1,NENERG
IF(OUPUTID(J,I).EQ.ID) THEN
ID_G=I-1
ID_E=J-1
GO TO 10
ENDIF
ENDDO
ENDDO
CALL XABORT('MPOTOC: no ID found in /output/OUPUTID.')
10 WRITE(RECNAM,'(23H/energymesh/energymesh_,I0,1H/)') ID_E
IF(IMPX.GT.1) THEN
HFORMAT='(/42H MPOTOC: Process MPO multiparameter file o,'//
> '9Hn output=,A)'
WRITE(IOUT,HFORMAT) TRIM(HEDIT)
WRITE(IOUT,'(24H MPOTOC: energy group=,A)') TRIM(RECNAM)
ENDIF
CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"NG",NGRP2)
IF(NGRP.EQ.0) THEN
NGRP=NGRP2
ELSE IF(NGRP2.NE.NGRP) THEN
WRITE(HSMG,'(44H MPOTOC: THE MPO FILE HAS AN INVALID NUMBER ,
1 18HOF ENERGY GROUPS (,I4,3H VS,I5,2H).)') NGRP2,NGRP
CALL XABORT(HSMG)
ENDIF
DEALLOCATE(OUPUTID)
WRITE(RECNAM,'(19H/geometry/geometry_,I0,1H/)') ID_G
IF(IMPX.GT.1) THEN
WRITE(IOUT,'(24H MPOTOC: geometry group=,A)') TRIM(RECNAM)
ENDIF
CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"NZONE",NMIL)
ENDIF
WRITE(RECNAM,'(8H/output/,A,6H/info/)') TRIM(HEDIT)
CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"NREA",NREA)
CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"ADDRISO",ADDRISO)
NBISO=ADDRISO(SIZE(ADDRISO,1))
*----
* SET NPAR
*----
NPAR=0
CALL hdf5_info(IPMPO,"/parameters/info/NVALUE",RANK,TYPE,NBYTE,
1 DIMSR)
IF(RANK.GT.0) NPAR=DIMSR(1)
*----
* SET NLOC
*----
IF(hdf5_group_exists(IPMPO,"/local_values")) THEN
CALL hdf5_get_shape(IPMPO,"/local_values/LOCVALNAME",DIMS_MPO)
NLOC=DIMS_MPO(1)
DEALLOCATE(DIMS_MPO)
ELSE
NLOC=0
ENDIF
*----
* SET NISOF AND NISOP
*----
NISOF=0
NISOP=0
IF(NBISO.GT.0) THEN
DO IBM=1,NMIL
WRITE(RECNAM,'(8H/output/,A,9H/statept_,I0,6H/zone_,I0,1H/)')
1 TRIM(HEDIT),0,IBM-1
IF(hdf5_group_exists(IPMPO,TRIM(RECNAM)//"yields")) THEN
CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"yields/NISF",NISOF)
CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"yields/NISP",NISOP)
EXIT
ENDIF
ENDDO
ENDIF
NISOS=NBISO-(NISOF+NISOP)
DEALLOCATE(ADDRISO)
*----
* SET NSURFD
*----
NSURFD=0
WRITE(RECNAM,'(8H/output/,A,32H/statept_0/zone_0/discontinuity/)')
& TRIM(HEDIT)
LNEW=hdf5_group_exists(IPMPO,TRIM(RECNAM))
IF(LNEW) THEN
* new specification
CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"NSURF",NSURFD)
ELSE
* old specification
WRITE(RECNAM,'(8H/output/,A,22H/statept_0/flux/NSURF/)')
& TRIM(HEDIT)
CALL hdf5_info(IPMPO,TRIM(RECNAM),RANK,TYPE,NBYTE,DIMSR)
IF(TYPE.NE.99) CALL hdf5_read_data(IPMPO,TRIM(RECNAM),NSURFD)
ENDIF
*----
* SET NALBP
*----
WRITE(RECNAM,'(8H/output/,A,16H/statept_0/flux/)') TRIM(HEDIT)
NALBP=0
CALL hdf5_info(IPMPO,TRIM(RECNAM)//"NALBP",RANK,TYPE,NBYTE,DIMSR)
IF(TYPE.NE.99) CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"NALBP",
1 NALBP)
*----
* SET NPRC
*----
NPRC=0
WRITE(RECNAM,'(8H/output/,A,27H/statept_0/zone_0/kinetics/)')
1 TRIM(HEDIT)
IF(hdf5_group_exists(IPMPO,RECNAM)) THEN
CALL hdf5_get_shape(IPMPO,TRIM(RECNAM)//"LAMBDAD",DIMS_MPO)
NPRC=DIMS_MPO(1)
DEALLOCATE(DIMS_MPO)
ENDIF
*----
* PRINT MPO PARAMETERS
*----
IF(IMPX.GT.0) THEN
WRITE(IOUT,'(/38H MPOTOC: table of content information:)')
WRITE(IOUT,'(36H nb of neutron-induced reactions =,I3)') NREA
WRITE(IOUT,'(34H nb of particularized isotopes =,I4)') NBISO
WRITE(IOUT,'(19H nb of mixtures =,I5)') NMIL
WRITE(IOUT,'(28H nb of global parameters =,I4)') NPAR
WRITE(IOUT,'(27H nb of local parameters =,I4)') NLOC
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,'(38H nb of discontinuity factor values =,I4)')
1 NSURFD
WRITE(IOUT,'(44H nb of physical albedos per energy group =,
1 I4)') NALBP
WRITE(IOUT,'(21H nb of precursors =,I4/)') NPRC
ENDIF
RETURN
END
|
