From 744b40856a035580b786378cae13d453edd26689 Mon Sep 17 00:00:00 2001
From: HEBERT Alain <alain.hebert@polymtl.ca>
Date: Sun, 28 Dec 2025 15:55:41 -0500
Subject: Resolve "Depreciate use of Version 4 and 5.0 Draglibs"

---
 Dragon/src/BREANM.f | 15 ++++++++++-----
 1 file changed, 10 insertions(+), 5 deletions(-)

(limited to 'Dragon/src/BREANM.f')

diff --git a/Dragon/src/BREANM.f b/Dragon/src/BREANM.f
index 345268d..8a2b2c0 100644
--- a/Dragon/src/BREANM.f
+++ b/Dragon/src/BREANM.f
@@ -1,7 +1,7 @@
 *DECK BREANM
-      SUBROUTINE BREANM(IPMAC1,NG,LX1,NMIX1,IMIX,ICODE,ISPH,ZKEFF,B2,
-     1 ENER,XXX1,VOL1,FLX1,DC1,TOT1,CHI1,SIGF1,SCAT1,JXM,JXP,FHETXM,
-     2 FHETXP,ADF1,NGET,ADFREF,IPRINT)
+      SUBROUTINE BREANM(IPMAC1,NG,LX1,NMIX1,IMIX,ICODE,ISPH,IH,ZKEFF,
+     1 B2,ENER,XXX1,VOL1,FLX1,DC1,TOT1,CHI1,SIGF1,SCAT1,HFACT1,JXM,JXP,
+     2 FHETXM,FHETXP,ADF1,NGET,ADFREF,IPRINT)
 *
 *-----------------------------------------------------------------------
 *
@@ -36,6 +36,7 @@
 * CHI1    fission spectra.
 * SIGF1   nu*fission cross sections.
 * SCAT1   scattering P0 cross sections.
+* HFACT1  H-FACTOR values.
 * JXM     left boundary currents.
 * JXP     right boundary currents.
 * FHETXM  left boundary fluxes.
@@ -57,8 +58,8 @@
       INTEGER NG,LX1,NMIX1,IMIX(LX1),ICODE(2),ISPH,NGET,IPRINT
       REAL ZKEFF,B2,ENER(NG+1),XXX1(LX1+1),VOL1(NMIX1),FLX1(NMIX1,NG),
      1 DC1(NMIX1,NG),TOT1(NMIX1,NG),CHI1(NMIX1,NG),SIGF1(NMIX1,NG),
-     2 SCAT1(NMIX1,NG,NG),JXM(NMIX1,NG),JXP(NMIX1,NG),FHETXM(NMIX1,NG),
-     3 FHETXP(NMIX1,NG),ADF1(NMIX1,NG),ADFREF(NG)
+     2 SCAT1(NMIX1,NG,NG),HFACT1(NMIX1,NG),JXM(NMIX1,NG),JXP(NMIX1,NG),
+     3 FHETXM(NMIX1,NG),FHETXP(NMIX1,NG),ADF1(NMIX1,NG),ADFREF(NG)
 *----
 *  LOCAL VARIABLES
 *----
@@ -227,6 +228,9 @@
             DO JGR=1,NG
               SCAT1(IBM,IGR,JGR)=SCAT1(IBM,IGR,JGR)/FDXM(IBM,JGR)
             ENDDO
+            IF(IH.EQ.1) THEN
+              HFACT1(IBM,IGR)=HFACT1(IBM,IGR)/FDXM(IBM,IGR)
+            ENDIF
           ENDDO
         ENDDO
         IF(ICODE(2).NE.0) THEN
@@ -332,6 +336,7 @@
         CALL LCMPUT(KPMAC1,'NJJS00',NMIX1,1,NJJ)
         CALL LCMPUT(KPMAC1,'IJJS00',NMIX1,1,IJJ)
         CALL LCMPUT(KPMAC1,'IPOS00',NMIX1,1,IPOS)
+        IF(IH.EQ.1) CALL LCMPUT(KPMAC1,'H-FACTOR',NMIX1,2,HFACT1(:,IGR))
       ENDDO
 *----
 *  SCRATCH STORAGE DEALLOCATION
-- 
cgit v1.2.3