From 7dfcc480ba1e19bd3232349fc733caef94034292 Mon Sep 17 00:00:00 2001 From: stainer_t Date: Mon, 8 Sep 2025 13:48:49 +0200 Subject: Initial commit from Polytechnique Montreal --- Dragon/src/MPOGEY.f | 216 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 216 insertions(+) create mode 100644 Dragon/src/MPOGEY.f (limited to 'Dragon/src/MPOGEY.f') diff --git a/Dragon/src/MPOGEY.f b/Dragon/src/MPOGEY.f new file mode 100644 index 0000000..3dccadf --- /dev/null +++ b/Dragon/src/MPOGEY.f @@ -0,0 +1,216 @@ +*DECK MPOGEY + SUBROUTINE MPOGEY(IPMPO,IPEDIT,HEDIT,NISO,NG,NMIL,NBISO,ICAL,NDFI, + 1 NISFS,NISPS) +* +*----------------------------------------------------------------------- +* +*Purpose: +* To recover the fission yields of an elementary calculation. +* +*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 +* IPMPO pointer to the MPO file. +* 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'). +* NISO number of particularized isotopes. +* NG number of condensed energy groups. +* NMIL number of mixtures in the MPO file. +* NBISO number of isotopes in the condensed microlib of the edition +* object. A given isotope may appear in many mixtures. +* ICAL index of the current elementary calculation. +* NDFI number of fissile isotopes producing fission products in +* the edition object. +* NISFS number of particularized fissile isotopes. +* NISPS number of particularized fission products. +* +*----------------------------------------------------------------------- +* + USE GANLIB + USE hdf5_wrap +*---- +* SUBROUTINE ARGUMENTS +*---- + TYPE(C_PTR) IPMPO,IPEDIT + INTEGER NISO,NG,NMIL,NBISO,ICAL,NDFI,NISFS,NISPS + CHARACTER(LEN=12) HEDIT +*---- +* LOCAL VARIABLES +*---- + PARAMETER (MAXISO=800) + TYPE(C_PTR) JPEDIT,KPEDIT + CHARACTER TEXT8*8,TEXT12*12,RECNAM*80 + LOGICAL LGIMF +*---- +* ALLOCATABLE ARRAYS +*---- + INTEGER, ALLOCATABLE, DIMENSION(:) :: MIX,ITYPE,PIFI,ADRY + INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ISONAM + REAL, ALLOCATABLE, DIMENSION(:) :: DEN,PYIELD,SIG,PFIRA + REAL, ALLOCATABLE, DIMENSION(:,:) :: FLUXES + REAL, ALLOCATABLE, DIMENSION(:,:,:) :: YLDS + CHARACTER(LEN=24), ALLOCATABLE, DIMENSION(:) :: NOMISO + TYPE(C_PTR), ALLOCATABLE, DIMENSION(:) :: IPISO +*---- +* SCRATCH STORAGE ALLOCATION +* PFIRA fission rate. +* ADRY offset in YLDS array for fissile isotopes (positive) and +* fission products (negative). +*---- + ALLOCATE(ISONAM(3,NBISO),MIX(NBISO),ITYPE(NBISO),PIFI(NDFI)) + ALLOCATE(YLDS(NISFS,NISPS,1),DEN(NBISO),PYIELD(NDFI), + 1 FLUXES(NMIL,NG),SIG(NG),PFIRA(NBISO),ADRY(NISO)) + ALLOCATE(IPISO(NBISO)) +*---- +* RECOVER INFORMATION FROM THE /contents/isotopes GROUP. +*---- + IF(NISO.GT.0) THEN + CALL hdf5_read_data(IPMPO,"/contents/isotopes/ISOTOPENAME", + 1 NOMISO) + ENDIF +* + CALL LCMGET(IPEDIT,'ISOTOPESUSED',ISONAM) + CALL LCMGET(IPEDIT,'ISOTOPESMIX',MIX) + CALL LCMGET(IPEDIT,'ISOTOPESDENS',DEN) + CALL LCMGET(IPEDIT,'ISOTOPESTYPE',ITYPE) + CALL LIBIPS(IPEDIT,NBISO,IPISO) +*---- +* COMPUTE ARRAY ADRY. +*---- + ISF=0 + ISP=0 + ADRY(:NISO)=0 + DO 30 ISO=1,NISO-1 + DO 10 IBISO=1,NBISO + WRITE(TEXT8,'(2A4)') (ISONAM(I0,IBISO),I0=1,2) + IF(NOMISO(ISO).EQ.TEXT8) GO TO 20 + 10 CONTINUE + GO TO 30 + 20 IF(ITYPE(IBISO).EQ.2) THEN + ISF=ISF+1 + ADRY(ISO)=ISF + ELSEIF(ITYPE(IBISO).EQ.3) THEN + ISP=ISP+1 + ADRY(ISO)=-ISP + ENDIF + 30 CONTINUE + LGIMF=NISFS.GT.0 + IF(LGIMF) THEN + ISF=ISF+1 + ADRY(NISO)=ISF ! declare the residual as fissile + ENDIF + IMF=0 + IF(LGIMF) IMF=ADRY(NISO) +*---- +* RECOVER THE NEUTRON FLUX. +*---- + CALL LCMSIX(IPEDIT,'MACROLIB',1) + JPEDIT=LCMGID(IPEDIT,'GROUP') + DO 40 IGR=1,NG + KPEDIT=LCMGIL(JPEDIT,IGR) + CALL LCMGET(KPEDIT,'FLUX-INTG',FLUXES(1,IGR)) + 40 CONTINUE + CALL LCMSIX(IPEDIT,' ',2) +*---- +* RECOVER THE FISSION RATES. +*---- + DO 65 IBISO=1,NBISO + GAR=0.0 + IF(MIX(IBISO).EQ.0) GO TO 60 + KPEDIT=IPISO(IBISO) + CALL LCMLEN(KPEDIT,'NFTOT',ILONG,ITYLCM) + IF(ILONG.GT.0) THEN + CALL LCMGET(KPEDIT,'NFTOT',SIG) + DO 50 IGR=1,NG + GAR=GAR+FLUXES(MIX(IBISO),IGR)*DEN(IBISO)*SIG(IGR) + 50 CONTINUE + ENDIF + 60 PFIRA(IBISO)=GAR + 65 CONTINUE +*---- +* LOOP OVER MPO MIXTURES TO RECOVER THE FISSION YIELDS. +*---- + DO 140 IMIL=1,NMIL + DO 75 IFP=1,NISPS + DO 70 IFI=1,NISFS + YLDS(IFI,IFP,1)=0.0 + 70 CONTINUE + 75 CONTINUE + DO 130 IBISO=1,NBISO + IF(MIX(IBISO).EQ.IMIL) THEN + WRITE(TEXT12,'(3A4)') (ISONAM(I0,IBISO),I0=1,3) + DO 80 ISO=1,NISO + IISO=ISO + IF(NOMISO(ISO).EQ.TEXT12(:8)) GO TO 90 + 80 CONTINUE + GO TO 130 + 90 KPEDIT=IPISO(IBISO) +* +* RECOVER THE FISSION YIELDS. + CALL LCMLEN(KPEDIT,'PYIELD',ILONG,ITYLCM) + IF((ILONG.GT.0).AND.(ILONG.EQ.NDFI)) THEN + CALL LCMGET(KPEDIT,'PIFI',PIFI) + CALL LCMGET(KPEDIT,'PYIELD',PYIELD) + ELSE + GO TO 130 + ENDIF + IFP=-ADRY(IISO) + IF(IFP.GT.0) THEN +* Particular fission product found. +* If exists in medium, find position in microlib +* and search all fissiles. + YLDW=0.0 + DO 120 IDFI=1,NDFI + JBISO=PIFI(IDFI) + IF(JBISO.GT.NBISO) CALL XABORT('MPOGEY: MIX OVERFLOW.') + IF(JBISO.EQ.0) GO TO 120 + IF(MIX(JBISO).NE.IMIL) GO TO 120 + WRITE(TEXT8,'(3A4)') (ISONAM(I0,JBISO),I0=1,2) + DO 100 JSO=1,NISO + JISO=JSO + IF(NOMISO(JSO).EQ.TEXT8) GO TO 110 + 100 CONTINUE +* Mother isotope is in residual macro. + YLDW=YLDW+PFIRA(JBISO) + IF(IMF.EQ.0) CALL XABORT('MPOGEY: LGIMF IS FALSE.') + YLDS(IMF,IFP,1)=YLDS(IMF,IFP,1)+PYIELD(IDFI)*PFIRA(JBISO) + GO TO 120 +* +* Yield for selected isotopes. + 110 IFI=ADRY(JISO) + IF(IFI.LE.0) CALL XABORT('MPOGEY: BAD ADRY.') + YLDS(IFI,IFP,1)=PYIELD(IDFI) + 120 CONTINUE + IF(LGIMF) THEN + IF(YLDW.NE.0.0) YLDS(IMF,IFP,1)=YLDS(IMF,IFP,1)/YLDW + ENDIF + ENDIF + ENDIF + 130 CONTINUE + IF(NISO.GT.0) DEALLOCATE(NOMISO) +*---- +* STORE INFORMATION IN THE statept_id/zone_id GROUP. +*---- + WRITE(RECNAM,'(8H/output/,A,9H/statept_,I0,6H/zone_,I0,1H/)') + > TRIM(HEDIT),ICAL-1,IMIL-1 + CALL hdf5_write_data(IPMPO,TRIM(RECNAM)//"yields/YIELD",YLDS) + 140 CONTINUE +* + CALL hdf5_write_data(IPMPO,TRIM(RECNAM)//"yields/ADDRY",ADRY) +*---- +* SCRATCH STORAGE DEALLOCATION +*---- + DEALLOCATE(IPISO) + DEALLOCATE(ADRY) + DEALLOCATE(PFIRA,SIG,FLUXES,PYIELD,DEN,YLDS) + DEALLOCATE(PIFI,ITYPE,MIX,ISONAM) + RETURN + END -- cgit v1.2.3