diff options
Diffstat (limited to 'Dragon/src/APXGEY.f')
| -rw-r--r-- | Dragon/src/APXGEY.f | 205 |
1 files changed, 205 insertions, 0 deletions
diff --git a/Dragon/src/APXGEY.f b/Dragon/src/APXGEY.f new file mode 100644 index 0000000..d6974a0 --- /dev/null +++ b/Dragon/src/APXGEY.f @@ -0,0 +1,205 @@ +*DECK APXGEY + SUBROUTINE APXGEY(IPAPX,IPEDIT,NISO,NG,NMIL,NBISO,NDFI,NISFS, + 1 NISPS) +* +*----------------------------------------------------------------------- +* +*Purpose: +* To recover the fission yields of an elementary calculation. +* +*Copyright: +* Copyright (C) 2025 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 +* IPAPX pointer to the Apex file. +* IPEDIT pointer to the edition object (L_EDIT signature). +* 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. +* 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) IPAPX,IPEDIT + INTEGER NISO,NG,NMIL,NBISO,NDFI,NISFS,NISPS +*---- +* 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,PIFI,ADRY + INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ISONAM + REAL, ALLOCATABLE, DIMENSION(:) :: DEN,PYIELD,SIG,PFIRA + REAL, ALLOCATABLE, DIMENSION(:,:) :: FLUXES + REAL, ALLOCATABLE, DIMENSION(:,:,:) :: YLDS + CHARACTER(LEN=4), ALLOCATABLE, DIMENSION(:) :: TYPISO + CHARACTER(LEN=8), 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),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(IPAPX,"/physconst/ISOTA",NOMISO) + CALL hdf5_read_data(IPAPX,"/physconst/ISOTYP",TYPISO) + ENDIF +* + CALL LCMGET(IPEDIT,'ISOTOPESUSED',ISONAM) + CALL LCMGET(IPEDIT,'ISOTOPESMIX',MIX) + CALL LCMGET(IPEDIT,'ISOTOPESDENS',DEN) + CALL LIBIPS(IPEDIT,NBISO,IPISO) +*---- +* COMPUTE ARRAY ADRY. +*---- + ISF=0 + ISP=0 + ADRY(:NISO)=0 + DO 30 ISO=1,NISO + 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(TYPISO(ISO).EQ.'FISS') THEN + ISF=ISF+1 + ADRY(ISO)=ISF + ELSEIF(TYPISO(ISO).EQ.'F.P.') THEN + ISP=ISP+1 + ADRY(ISO)=-ISP + ENDIF + 30 CONTINUE + LGIMF=NISFS.GT.0 + 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 + YLDS(:NISFS,:NISPS,1)=0.0 + 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('APXGEY: 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('APXGEY: 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('APXGEY: 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,TYPISO) +*---- +* STORE INFORMATION IN THE physconst GROUP. +*---- + IF(NMIL.EQ.1) THEN + CALL hdf5_write_data(IPAPX,"/physconst/FYIELDS",YLDS) + ELSE + WRITE(RECNAM,'(18H/physconst/FYIELDS,I8)') IMIL + CALL hdf5_write_data(IPAPX,TRIM(RECNAM),YLDS) + ENDIF + 140 CONTINUE +*---- +* SCRATCH STORAGE DEALLOCATION +*---- + DEALLOCATE(IPISO) + DEALLOCATE(ADRY) + DEALLOCATE(PFIRA,SIG,FLUXES,PYIELD,DEN,YLDS) + DEALLOCATE(PIFI,MIX,ISONAM) + RETURN + END |