Merge branch '19-depreciate-use-of-version-4-and-5-0-draglibs' into 'main'

Resolve "Depreciate use of Version 4 and 5.0 Draglibs"

See merge request dragon/5.1!40

1 files changed, 18 insertions, 10 deletions

diff --git a/Dragon/src/BREERA.f b/Dragon/src/BREERA.f
index 336032f..0aedba7 100644
--- a/Dragon/src/BREERA.f
+++ b/Dragon/src/BREERA.f
@@ -1,7 +1,7 @@
 *DECK BREERA
-      SUBROUTINE BREERA(IPMAC1,NC,NG,NL,LX1,NMIX1,IMIX,ICODE,ISPH,ZKEFF,
-     1 B2,ENER,XXX1,VOL1,FLX1,DC1,TOT1,CHI1,SIGF1,SCAT1,JXM,JXP,FHETXM,
-     2 FHETXP,ADF1,NGET,ADFREF,IPRINT)
+      SUBROUTINE BREERA(IPMAC1,NC,NG,NL,LX1,NMIX1,IMIX,ICODE,ISPH,IH,
+     1 ZKEFF,B2,ENER,XXX1,VOL1,FLX1,DC1,TOT1,CHI1,SIGF1,SCAT1,HFACT1,
+     2 JXM,JXP,FHETXM,FHETXP,ADF1,NGET,ADFREF,IPRINT)
 *
 *-----------------------------------------------------------------------
 *
@@ -28,6 +28,7 @@
 * IMIX    mix index of each node.
 * ICODE   physical albedo index on each side of the domain.
 * ISPH    SPH flag (=0: use discontinuity factors; =1: use SPH factors).
+* IH      H-FACTOR flag (=0: not used; =1: recovered).
 * ZKEFF   effective multiplication factor.
 * B2      buckling.
 * ENER    energy limits.
@@ -39,6 +40,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,12 +59,13 @@
 *  SUBROUTINE ARGUMENTS
 *----
       TYPE(C_PTR) IPMAC1
-      INTEGER NC,NG,NL,LX1,NMIX1,IMIX(LX1),ICODE(2),ISPH,NGET,IPRINT
+      INTEGER NC,NG,NL,LX1,NMIX1,IMIX(LX1),ICODE(2),ISPH,IH,NGET,IPRINT
       REAL ZKEFF(NC),B2(NC),ENER(NG+1),XXX1(LX1+1),VOL1(NMIX1,NC),
      1 FLX1(NMIX1,NG,NC),DC1(NMIX1,NG,NC),TOT1(NMIX1,NG,NL,NC),
      2 CHI1(NMIX1,NG,NC),SIGF1(NMIX1,NG,NC),SCAT1(NMIX1,NG,NG,NL,NC),
-     3 JXM(NMIX1,NG,NC),JXP(NMIX1,NG,NC),FHETXM(NMIX1,NG,NL,NC),
-     4 FHETXP(NMIX1,NG,NL,NC),ADF1(NMIX1,NG,NC),ADFREF(NG)
+     3 HFACT1(NMIX1,NG,NC),JXM(NMIX1,NG,NC),JXP(NMIX1,NG,NC),
+     4 FHETXM(NMIX1,NG,NL,NC),FHETXP(NMIX1,NG,NL,NC),ADF1(NMIX1,NG,NC),
+     5 ADFREF(NG)
 *----
 *  LOCAL VARIABLES
 *----
@@ -76,7 +79,7 @@
       INTEGER, ALLOCATABLE, DIMENSION(:) :: IJJ,NJJ,IPOS
       REAL, ALLOCATABLE, DIMENSION(:) :: WORK1D,WORK1,WORK2,WORK4,WORK5,
      1 VOLTOT
-      REAL, ALLOCATABLE, DIMENSION(:,:) :: FLX,DC,TOT,CHI,SIGF,
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: FLX,DC,TOT,CHI,SIGF,HFACT,
      1 ADF,AFACTOR,BETA,WORK3
       REAL, ALLOCATABLE, DIMENSION(:,:,:) ::FDXM,FDXP,SCAT
       REAL(KIND=8), ALLOCATABLE, DIMENSION(:) :: TAU,B,X
@@ -87,7 +90,8 @@
 *----
       ALLOCATE(WORK1(NG),WORK2(NG),WORK4(NG),WORK5(NG),VOLTOT(NMIX1),
      1 FLX(NMIX1,NG),DC(NMIX1,NG),TOT(NMIX1,NG),CHI(NMIX1,NG),
-     1 SIGF(NMIX1,NG),ADF(NMIX1,NG),AFACTOR(NG,NG),BETA(NG,NG))
+     1 SIGF(NMIX1,NG),HFACT(NMIX1,NG),ADF(NMIX1,NG),AFACTOR(NG,NG),
+     2 BETA(NG,NG))
       ALLOCATE(FDXM(NMIX1,NG,NG),FDXP(NMIX1,NG,NG),SCAT(NMIX1,NG,NG),
      1 WORK3(NG,NG))
       ALLOCATE(FHOMM(NC,NG,NMIX1),FHOMP(NC,NG,NMIX1),L(NG,2*NG,LX1),
@@ -102,6 +106,7 @@
       CHI(:,:)=0.0
       SIGF(:,:)=0.0
       SCAT(:,:,:)=0.0
+      HFACT(:,:)=0.0
       ADF(:,:)=0.0
       FHOMM(:NC,:NG,:NMIX1)=0.0D0
       FHOMP(:NC,:NG,:NMIX1)=0.0D0
@@ -117,6 +122,7 @@
             DO JGR=1,NG
              SCAT(IBM,IGR,JGR)=SCAT(IBM,IGR,JGR)+SCAT1(IBM,IGR,JGR,1,IC)
             ENDDO
+            IF(IH.EQ.1) HFACT(IBM,IGR)=HFACT(IBM,IGR)+HFACT1(IBM,IGR,IC)
             ADF(IBM,IGR)=ADF(IBM,IGR)+ADF1(IBM,IGR,IC)
           ENDDO
         ENDDO
@@ -128,6 +134,7 @@
       CHI(:,:)=CHI(:,:)/REAL(NC)
       SIGF(:,:)=SIGF(:,:)/REAL(NC)
       SCAT(:,:,:)=SCAT(:,:,:)/REAL(NC)
+      IF(IH.EQ.1) HFACT(:,:)=HFACT(:,:)/REAL(NC)
       ADF(:,:)=ADF(:,:)/REAL(NC)
 *----
 *  LOOP OVER CASES
@@ -430,14 +437,15 @@
         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,HFACT(:,IGR))
       ENDDO
 *----
 *  SCRATCH STORAGE DEALLOCATION
 *----
       DEALLOCATE(R,L,FHOMP,FHOMM)
       DEALLOCATE(SCAT,FDXP,FDXM)
-      DEALLOCATE(WORK3,BETA,AFACTOR,ADF,SIGF,CHI,TOT,DC,FLX,VOLTOT,
-     1 WORK5,WORK4,WORK2,WORK1)
+      DEALLOCATE(WORK3,BETA,AFACTOR,ADF,HFACT,SIGF,CHI,TOT,DC,FLX,
+     1 VOLTOT,WORK5,WORK4,WORK2,WORK1)
       RETURN
    20 FORMAT(1X,A9,1P,10E12.4,/(10X,10E12.4))
       END