diff options
Diffstat (limited to 'Dragon/src/MPOCAL.f')
| -rw-r--r-- | Dragon/src/MPOCAL.f | 180 |
1 files changed, 180 insertions, 0 deletions
diff --git a/Dragon/src/MPOCAL.f b/Dragon/src/MPOCAL.f new file mode 100644 index 0000000..66178d2 --- /dev/null +++ b/Dragon/src/MPOCAL.f @@ -0,0 +1,180 @@ +*DECK MPOCAL + SUBROUTINE MPOCAL(IMPX,IPMPO,IPDEPL,IPEDIT,HEDIT) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Store the results of an elementary calculation in the MPO file. +* +*Copyright: +* Copyright (C) 2022 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 +* IMPX print parameter. +* IPMPO pointer to the MPO file. +* IPDEPL pointer to the burnup object (L_BURNUP signature). +* IPEDIT pointer to the edition object (L_EDIT signature). +* HEDIT name of output group for a (multigroup mesh, output geometry) +* couple (generally equal to 'output_0'). +* +*----------------------------------------------------------------------- +* + USE GANLIB + USE hdf5_wrap +*---- +* SUBROUTINE ARGUMENTS +*---- + TYPE(C_PTR) IPMPO,IPDEPL,IPEDIT,IPSPH + INTEGER IMPX + CHARACTER(LEN=12) HEDIT +*---- +* LOCAL VARIABLES +*---- + PARAMETER (NSTATE=40) + INTEGER IPAR(NSTATE),RANK,TYPE,NBYTE,DIMSR(5) + REAL BIRRAD(2) + CHARACTER CDIRO*12,HSMG*131,RECNAM*80 +*---- +* ALLOCATABLE ARRAYS +*---- + INTEGER, ALLOCATABLE, DIMENSION(:) :: DIMS_MPO + INTEGER, ALLOCATABLE, DIMENSION(:,:) :: OUPUTID + REAL, ALLOCATABLE, DIMENSION(:) :: VOLMIL + REAL, ALLOCATABLE, DIMENSION(:,:) :: FLXMIL +*---- +* RECOVER MICROLIB AND MACROLIB INFORMATION +*---- + CALL LCMGTC(IPEDIT,'LAST-EDIT',12,CDIRO) + CALL LCMSIX(IPEDIT,CDIRO,1) + CALL LCMLEN(IPEDIT,'STATE-VECTOR',ILONG,ITYLCM) + IF(ILONG.NE.0) THEN + CALL LCMGET(IPEDIT,'STATE-VECTOR',IPAR) + NBISO=IPAR(2) + NED=IPAR(13) + NPRC=IPAR(19) + NDFI=IPAR(20) + ELSE + NBISO=0 + NDFI=0 + ENDIF + CALL LCMSIX(IPEDIT,'MACROLIB',1) + CALL LCMGET(IPEDIT,'STATE-VECTOR',IPAR) + NG=IPAR(1) + NMIL=IPAR(2) + NL=IPAR(3) + IF(IPAR(4).GT.1) CALL XABORT('MPOCAL: CANNOT PROCESS MULTIPLE ' + 1 //'FISSION SPECTRA.') + NED=IPAR(5) + ITRANC=IPAR(6) + NPRC=IPAR(7) + NALBP=IPAR(8) + ILEAK=IPAR(9) + IDF=IPAR(12) + CALL LCMLEN(IPEDIT,'SPH',ILEN,ITYLCM) + IF(ILEN.NE.0) THEN + IPSPH=LCMGID(IPEDIT,'SPH') + CALL LCMGET(IPSPH,'STATE-VECTOR',IPAR) + IMC=IPAR(6) + ELSE + IMC=0 + ENDIF + CALL LCMSIX(IPEDIT,' ',2) +*---- +* RECOVER ENERGY ID_G AND ID_E +*---- + CALL hdf5_read_data(IPMPO,"/output/NOUTPUT",NOUTPUT) + ID_G=-1 + ID_E=-1 + CALL hdf5_read_data(IPMPO,"/output/OUPUTID",OUPUTID) + CALL hdf5_read_data(IPMPO,"/energymesh/NENERGYMESH",NENERG) + CALL hdf5_read_data(IPMPO,"/geometry/NGEOMETRY",NGEOME) + 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('MPOCAL: no ID found in /output/OUPUTID.') + 10 CALL hdf5_read_data(IPMPO,"/parameters/tree/NSTATEPOINT",NCALS) + ICAL=NCALS+1 +*---- +* RECOVER THE FLUX NORMALIZATION FACTOR. +*---- + IF(C_ASSOCIATED(IPDEPL)) THEN + CALL LCMGET(IPDEPL,'BURNUP-IRRAD',BIRRAD) + BURN=BIRRAD(1) + CALL LCMLEN(IPDEPL,'FLUX-NORM',ILONG,ITYLCM) + IF(ILONG.EQ.0) THEN + WRITE(HSMG,'(40HMPOCAL: THE ''FLUX-NORM'' RECORD IS NOT SE, + 1 20HT FOR BURNUP STEP AT,E12.5,14H MW-DAY/TONNE.)') BURN + CALL XABORT(HSMG) + ENDIF + CALL LCMGET(IPDEPL,'FLUX-NORM',FNORM) + IF(IMPX.GT.0) WRITE(6,100) FNORM,BURN + ELSE + FNORM=1.0 + IF(IMPX.GT.0) WRITE(6,110) + ENDIF +*---- +* RECOVER THE NUMBER OF ADRX (NADRX) AND TRANSPROFILE (NADRI) SETS. +*---- + WRITE(RECNAM,'(8H/output/,A,6H/info/)') TRIM(HEDIT) + NADRX=0 + CALL hdf5_info(IPMPO,TRIM(RECNAM)//"ADDRXS",RANK,TYPE,NBYTE,DIMSR) + IF(TYPE.NE.99) THEN + NADRX=DIMSR(3) + ENDIF + NADRI=0 + CALL hdf5_info(IPMPO,TRIM(RECNAM)//"TRANSPROFILE",RANK,TYPE,NBYTE, + 1 DIMSR) + IF(TYPE.NE.99) NADRI=DIMSR(1)/(2*NG+1) +*---- +* RECOVER THE CROSS SECTIONS. +*---- + CALL hdf5_get_shape(IPMPO,"/contents/isotopes/ISOTOPENAME", + 1 DIMS_MPO) + NISO=DIMS_MPO(1) + DEALLOCATE(DIMS_MPO) + CALL hdf5_get_shape(IPMPO,"/contents/reactions/REACTIONAME", + 1 DIMS_MPO) + NREA=DIMS_MPO(1) + DEALLOCATE(DIMS_MPO) + MAXRDA=(NREA*NG+NL*NG+NL*NG*NG)*NISO + MAXIDA=(2*NG+1)*(NADRI+NISO*NMIL) + ALLOCATE(VOLMIL(NMIL),FLXMIL(NMIL,NG)) + CALL MPOCA2(IPMPO,IPEDIT,HEDIT,NREA,NISO,NADRX,NED,NPRC,ILEAK, + 1 NG,NMIL,NL,ITRANC,NALBP,IMC,NBISO,ICAL,MAXRDA,MAXIDA,FNORM,IMPX, + 2 NISOTS,NISFS,NISPS,VOLMIL,FLXMIL) +*---- +* RECOVER DISCONTINUITY FACTOR INFORMATION. +*---- + IF((IDF.EQ.2).OR.(IDF.EQ.3).OR.(IDF.EQ.4).OR.(NALBP.GT.0)) THEN + CALL MPOIDF(IPMPO,IPEDIT,HEDIT,NG,NMIL,ICAL,IDF,NALBP,FNORM, + 1 VOLMIL,FLXMIL) + ENDIF + DEALLOCATE(FLXMIL,VOLMIL) +*---- +* RECOVER THE FISSION YIELDS. +*---- + IF(NISFS*NISPS.GT.0) THEN + CALL MPOGEY(IPMPO,IPEDIT,HEDIT,NISO,NG,NMIL,NBISO,ICAL,NDFI, + 1 NISFS,NISPS) + ENDIF +* + CALL LCMSIX(IPEDIT,' ',2) + RETURN +* + 100 FORMAT(45H MPOCAL: NORMALIZE THE FLUX WITH THE FACTOR =,1P,E12.5, + 1 26H TAKEN FROM BURNUP STEP AT,E12.5,14H MW-DAY/TONNE.) + 110 FORMAT(36H MPOCAL: THE FLUX IS NOT NORMALIZED.) + END |