diff options
Diffstat (limited to 'Dragon/src/MPOTOC.f')
| -rw-r--r-- | Dragon/src/MPOTOC.f | 215 |
1 files changed, 215 insertions, 0 deletions
diff --git a/Dragon/src/MPOTOC.f b/Dragon/src/MPOTOC.f new file mode 100644 index 0000000..be1067e --- /dev/null +++ b/Dragon/src/MPOTOC.f @@ -0,0 +1,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 |