diff options
Diffstat (limited to 'Dragon/src/BREERA.f')
| -rw-r--r-- | Dragon/src/BREERA.f | 28 |
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 |