From 744b40856a035580b786378cae13d453edd26689 Mon Sep 17 00:00:00 2001 From: HEBERT Alain Date: Sun, 28 Dec 2025 15:55:41 -0500 Subject: Resolve "Depreciate use of Version 4 and 5.0 Draglibs" --- Dragon/src/EDIHFC.f | 196 ++++++++++++++++------------------------------------ 1 file changed, 58 insertions(+), 138 deletions(-) (limited to 'Dragon/src/EDIHFC.f') diff --git a/Dragon/src/EDIHFC.f b/Dragon/src/EDIHFC.f index 7cdc561..46f53bd 100644 --- a/Dragon/src/EDIHFC.f +++ b/Dragon/src/EDIHFC.f @@ -1,14 +1,12 @@ *DECK EDIHFC SUBROUTINE EDIHFC(IPEDIT,NGROUP,NGCOND,NREGIO,NMERGE,NBISO, - > NDEPL,NREAC,MATCOD,VOLUME,INADPL,ISONAM,ISONRF, - > IPISO,MIX,FLUXES,DEN,IGCOND,IMERGE,RER,EMEVF2, - > EMEVG2,VOLME,IPRINT) + > MATCOD,VOLUME,ISONAM,IPISO,MIX,FLUXES,DEN, + > IGCOND,IMERGE,VOLME,IPRINT,EMEVF2) * *----------------------------------------------------------------------- * *Purpose: -* Evaluate H-factors using information recovered from the reference -* internal library and store them in the edition macrolib. +* Recover H-factors and normalize the flux. * *Copyright: * Copyright (C) 2002 Ecole Polytechnique de Montreal @@ -26,26 +24,20 @@ * NREGIO number of regions. * NMERGE number of merged regions. * NBISO number of isotopes. -* NDEPL number of depleting isotopes. -* NREAC number of depletion reactions. * MATCOD material per region. * VOLUME volume of region. -* INADPL name of depleting isotopes. * ISONAM isotopes names. -* ISONRF library name of isotopes. * IPISO pointer array towards microlib isotopes. * MIX mixture associated with isotopes. * FLUXES multigroup fluxes. * DEN isotope density. * IGCOND limits of condensed groups. * IMERGE index of merged region. -* RER fission and capture production energy (MeV/reaction). * VOLME merged volume. * IPRINT print level. * *Parameters: output -* EMEVF2 fission production energy by isotope. -* EMEVG2 capture production energy by isotope. +* EMEVF2 equivalent fission production energy by isotope. * *----------------------------------------------------------------------- * @@ -55,113 +47,77 @@ *---- TYPE(C_PTR) IPEDIT,IPISO(NBISO) INTEGER IUNOUT - INTEGER NGROUP,NGCOND,NREGIO,NMERGE,NBISO,NDEPL,NREAC, - > MATCOD(NREGIO),INADPL(3,NDEPL),ISONAM(3,NBISO), - > ISONRF(3,NBISO),MIX(NBISO),IGCOND(NGCOND), + INTEGER NGROUP,NGCOND,NREGIO,NMERGE,NBISO,MATCOD(NREGIO), + > ISONAM(3,NBISO),MIX(NBISO),IGCOND(NGCOND), > IMERGE(NREGIO) REAL VOLUME(NREGIO),FLUXES(NREGIO,NGROUP),DEN(NBISO), - > RER(NREAC,NDEPL),EMEVF2(NBISO),EMEVG2(NBISO) - REAL VOLME(NMERGE) + > EMEVF2(NBISO),VOLME(NMERGE) INTEGER IPRINT - DOUBLE PRECISION TOTPOW,POWF,POWC,POWT - INTEGER, ALLOCATABLE, DIMENSION(:) :: INDX + DOUBLE PRECISION TOTPOW,POWF REAL, ALLOCATABLE, DIMENSION(:) :: SIG,HFACT - DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: FLXMER - DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:) :: WORK + DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: FLXMER,WORK *---- * LOCAL VARIABLES *---- TYPE(C_PTR) JPEDIT,KPEDIT,KPLIB PARAMETER (IUNOUT=6) - INTEGER IGAR(3) - CHARACTER HNISOR*12,TEXT12*12,HSMG*131 - LOGICAL L1,L2 - DOUBLE PRECISION GAR,CONV,XDRCST + CHARACTER HSMG*131 + LOGICAL LH + DOUBLE PRECISION GAR,CONV,XDRCST,Z1,Z2 *---- * SCRATCH STORAGE ALLOCATION * SIG fission/capture cross sections. * HFACT H-factor in a macrogroup. * FLXMER merged and condensed flux. * WORK H-factors. -* INDX depleting isotope index. *---- - ALLOCATE(INDX(NBISO)) ALLOCATE(SIG(NGROUP),HFACT(NMERGE)) - ALLOCATE(FLXMER(NMERGE,NGCOND),WORK(NMERGE,NGCOND,3)) -*---- -* COMPUTE THE DEPLETING ISOTOPE INDEX -*---- - DO 20 ISO=1,NBISO - WRITE(HNISOR,'(3A4)') (ISONRF(I0,ISO),I0=1,3) - I1=INDEX(HNISOR,'_') - IF(I1.EQ.0) THEN - TEXT12=HNISOR - ELSE - TEXT12=HNISOR(:I1-1) - ENDIF - READ(TEXT12,'(3A4)') (IGAR(I0),I0=1,3) - DO 10 IDP=1,NDEPL - L1=((ISONRF(1,ISO).EQ.INADPL(1,IDP)).AND. - 1 (ISONRF(2,ISO).EQ.INADPL(2,IDP)).AND. - 2 (ISONRF(3,ISO).EQ.INADPL(3,IDP))) - L2=((IGAR(1).EQ.INADPL(1,IDP)).AND. - 1 (IGAR(2).EQ.INADPL(2,IDP)).AND. - 2 (IGAR(3).EQ.INADPL(3,IDP))) - IF(L1.OR.L2) THEN - INDX(ISO)=IDP - GO TO 20 - ENDIF - 10 CONTINUE - INDX(ISO)=0 - 20 CONTINUE + ALLOCATE(FLXMER(NMERGE,NGCOND),WORK(NMERGE,NGCOND)) *---- * COMPUTE H-FACTOR *---- CONV=1.0D6 ! convert MeV to eV - IZFISS=0 FLXMER(:NMERGE,:NGCOND)=0.0D0 - WORK(:NMERGE,:NGCOND,:3)=0.0D0 + WORK(:NMERGE,:NGCOND)=0.0D0 + LH=.FALSE. DO 160 ISO=1,NBISO - IDPL=INDX(ISO) - IF(IDPL.EQ.0) GO TO 160 KPLIB=IPISO(ISO) ! set ISO-th isotope IF(.NOT.C_ASSOCIATED(KPLIB)) THEN WRITE(HSMG,'(17HEDIHFC: ISOTOPE '',3A4,16H'' IS NOT AVAILAB, > 19HLE IN THE MICROLIB.)') (ISONAM(I0,ISO),I0=1,3) CALL XABORT(HSMG) ENDIF + Z1=0.0D0 + Z2=0.0D0 + EMEVF2(ISO)=0.0 *---- * RECOVER H-FACTOR INFORMATION IF AVAILABLE *---- CALL LCMLEN(KPLIB,'H-FACTOR',ILLCM,ITLCM) - IF(ILLCM.EQ.NGROUP) THEN - IZFISS=IZFISS+1 - CALL LCMGET(KPLIB,'H-FACTOR',SIG) - DO 90 IREG=1,NREGIO - IMR=IMERGE(IREG) - IF((IMR.GT.0).AND.(MATCOD(IREG).EQ.MIX(ISO))) THEN - IGRFIN=0 - DO 80 IGC=1,NGCOND - IGRDEB=IGRFIN+1 - IGRFIN=IGCOND(IGC) - GAR=0.0D0 - DO 70 IGR=IGRDEB,IGRFIN - GAR=GAR+FLUXES(IREG,IGR)*DEN(ISO)*VOLUME(IREG)* - > SIG(IGR) - 70 CONTINUE - WORK(IMR,IGC,1)=WORK(IMR,IGC,1)+GAR - 80 CONTINUE - ENDIF - 90 CONTINUE - GO TO 165 - ENDIF + IF(ILLCM.EQ.0) GO TO 160 + LH=.TRUE. + CALL LCMGET(KPLIB,'H-FACTOR',SIG) + DO 90 IREG=1,NREGIO + IMR=IMERGE(IREG) + IF((IMR.GT.0).AND.(MATCOD(IREG).EQ.MIX(ISO))) THEN + IGRFIN=0 + DO 80 IGC=1,NGCOND + IGRDEB=IGRFIN+1 + IGRFIN=IGCOND(IGC) + GAR=0.0D0 + DO 70 IGR=IGRDEB,IGRFIN + GAR=GAR+FLUXES(IREG,IGR)*DEN(ISO)*VOLUME(IREG)*SIG(IGR) + 70 CONTINUE + WORK(IMR,IGC)=WORK(IMR,IGC)+GAR + Z1=Z1+GAR + 80 CONTINUE + ENDIF + 90 CONTINUE *---- * COMPUTE FISSION ENERGY *---- CALL LCMLEN(KPLIB,'NFTOT',ILLCM,ITLCM) IF(ILLCM.EQ.NGROUP) THEN - IZFISS=IZFISS+1 - EMEVF2(ISO)=RER(2,IDPL) CALL LCMGET(KPLIB,'NFTOT',SIG) DO 120 IREG=1,NREGIO IMR=IMERGE(IREG) @@ -170,51 +126,23 @@ DO 110 IGC=1,NGCOND IGRDEB=IGRFIN+1 IGRFIN=IGCOND(IGC) - GAR=0.0D0 DO 100 IGR=IGRDEB,IGRFIN - GAR=GAR+FLUXES(IREG,IGR)*DEN(ISO)*VOLUME(IREG)* - > SIG(IGR) + Z2=Z2+FLUXES(IREG,IGR)*DEN(ISO)*VOLUME(IREG)*SIG(IGR) 100 CONTINUE - WORK(IMR,IGC,1)=WORK(IMR,IGC,1)+GAR*RER(2,IDPL)*CONV 110 CONTINUE ENDIF 120 CONTINUE - ENDIF -*---- -* COMPUTE CAPTURE ENERGY -*---- - CALL LCMLEN(KPLIB,'NG',ILLCM,ITLCM) - IF(ILLCM.EQ.NGROUP) THEN - IZFISS=IZFISS+1 - EMEVG2(ISO)=RER(3,IDPL) - CALL LCMGET(KPLIB,'NG',SIG) - DO 150 IREG=1,NREGIO - IMR=IMERGE(IREG) - IF((IMR.GT.0).AND.(MATCOD(IREG).EQ.MIX(ISO))) THEN - IGRFIN=0 - DO 140 IGC=1,NGCOND - IGRDEB=IGRFIN+1 - IGRFIN=IGCOND(IGC) - GAR=0.0D0 - DO 130 IGR=IGRDEB,IGRFIN - GAR=GAR+FLUXES(IREG,IGR)*DEN(ISO)*VOLUME(IREG)* - > SIG(IGR) - 130 CONTINUE - WORK(IMR,IGC,2)=WORK(IMR,IGC,2)+GAR*RER(3,IDPL)*CONV - 140 CONTINUE - ENDIF - 150 CONTINUE + IF(Z2.NE.0.0) EMEVF2(ISO)=REAL(Z1/Z2) ENDIF 160 CONTINUE *---- * Normalize total power to 1 W * Print fission, capture and total power density *---- - 165 TOTPOW=0.0D0 + TOTPOW=0.0D0 DO IGC=1,NGCOND DO IMR=1,NMERGE - WORK(IMR,IGC,3)=WORK(IMR,IGC,1)+WORK(IMR,IGC,2) - TOTPOW=TOTPOW+WORK(IMR,IGC,3)*XDRCST('eV','J') + TOTPOW=TOTPOW+WORK(IMR,IGC)*XDRCST('eV','J') ENDDO ENDDO IF(TOTPOW.GT.0.0D0) THEN @@ -222,18 +150,12 @@ WRITE(IUNOUT,6000) DO IMR=1,NMERGE POWF=0.0D0 - POWC=0.0D0 - POWT=0.0D0 DO IGC=1,NGCOND - POWF=POWF+WORK(IMR,IGC,1) - POWC=POWC+WORK(IMR,IGC,2) - POWT=POWT+WORK(IMR,IGC,3) + POWF=POWF+WORK(IMR,IGC) ENDDO IF(VOLME(IMR).NE.0.0) THEN POWF=POWF/(TOTPOW*VOLME(IMR)) - POWC=POWC/(TOTPOW*VOLME(IMR)) - POWT=POWT/(TOTPOW*VOLME(IMR)) - WRITE(IUNOUT,6001) IMR,VOLME(IMR),POWF,POWC,POWT + WRITE(IUNOUT,6001) IMR,VOLME(IMR),POWF ENDIF ENDDO ENDIF @@ -241,7 +163,7 @@ *---- * COMPUTE THE HOMOGENIZED/CONDENSED FLUX *---- - IF(IZFISS.NE.0) THEN + IF(LH) THEN DO 190 IREG=1,NREGIO IMR=IMERGE(IREG) IF(IMR.GT.0) THEN @@ -260,36 +182,34 @@ DO 210 IGC=1,NGCOND DO 200 IMR=1,NMERGE IF(FLXMER(IMR,IGC).GT.0.0) THEN - WORK(IMR,IGC,3)=WORK(IMR,IGC,3)/FLXMER(IMR,IGC) + WORK(IMR,IGC)=WORK(IMR,IGC)/FLXMER(IMR,IGC) ENDIF 200 CONTINUE 210 CONTINUE - ENDIF *---- * SAVE ON LCM *---- - CALL LCMSIX(IPEDIT,'MACROLIB',1) - JPEDIT=LCMLID(IPEDIT,'GROUP',NGCOND) - DO 230 IGC=1,NGCOND - DO 220 IMR=1,NMERGE - HFACT(IMR)=REAL(WORK(IMR,IGC,3)) - 220 CONTINUE - KPEDIT=LCMDIL(JPEDIT,IGC) - CALL LCMPUT(KPEDIT,'H-FACTOR',NMERGE,2,HFACT) - 230 CONTINUE - CALL LCMSIX(IPEDIT,' ',2) + CALL LCMSIX(IPEDIT,'MACROLIB',1) + JPEDIT=LCMLID(IPEDIT,'GROUP',NGCOND) + DO 230 IGC=1,NGCOND + DO 220 IMR=1,NMERGE + HFACT(IMR)=REAL(WORK(IMR,IGC)) + 220 CONTINUE + KPEDIT=LCMDIL(JPEDIT,IGC) + CALL LCMPUT(KPEDIT,'H-FACTOR',NMERGE,2,HFACT) + 230 CONTINUE + CALL LCMSIX(IPEDIT,' ',2) + ENDIF *---- * SCRATCH STORAGE DEALLOCATION *---- DEALLOCATE(WORK,FLXMER) DEALLOCATE(HFACT,SIG) - DEALLOCATE(INDX) RETURN *---- * FORMAT *---- 6000 FORMAT(/' EDIHFC: POWER DENSITY (W/cc) NORMALIZED TO 1 W TOTAL ', - > 'POWER '/' REGION',6X,'VOLUME',7X,'FISSION',7X,'CAPTURE',9X, - > 'TOTAL') - 6001 FORMAT(1X,I4,1P,4E14.5) + > 'POWER '/' REGION',6X,'VOLUME',7X,'FISSION') + 6001 FORMAT(1X,I4,1P,2E14.5) END -- cgit v1.2.3