diff options
Diffstat (limited to 'Dragon/src/BREMAC.f')
| -rw-r--r-- | Dragon/src/BREMAC.f | 50 |
1 files changed, 34 insertions, 16 deletions
diff --git a/Dragon/src/BREMAC.f b/Dragon/src/BREMAC.f index eaba3e9..d742354 100644 --- a/Dragon/src/BREMAC.f +++ b/Dragon/src/BREMAC.f @@ -1,7 +1,7 @@ *DECK BREMAC SUBROUTINE BREMAC(NC,IPMAC2,NG,NL,LX1,NMIX1,NMIX2,IMIX,IMIX1, - 1 IGAP,ILEAKS,IDF,IPRINT,ZKEFF,B2,VOL1,FLX1,DC1,TOT1,CHI1,SIGF1, - 2 SCAT1,JXM,JXP,FHETXM,FHETXP,ADF1) + 1 IGAP,ILEAKS,IDF,IPRINT,IH,ZKEFF,B2,VOL1,FLX1,DC1,TOT1,CHI1, + 2 SIGF1,SCAT1,HFACT1,JXM,JXP,FHETXM,FHETXP,ADF1) * *----------------------------------------------------------------------- * @@ -36,6 +36,7 @@ * IPRINT print parameter * *Parameters: output +* IH H-FACTOR flag (=0: not used; =1: recovered). * ZKEFF effective multiplication factor. * B2 buckling. * VOL1 volumes. @@ -45,6 +46,7 @@ * CHI1 fission spectra. * SIGF1 nu*fission cross sections. * SCAT1 scattering cross sections. +* HFACT1 H-FACTOR values. * JXM left boundary currents. * JXP right boundary currents. * FHETXM left boundary fluxes. @@ -60,12 +62,12 @@ INTEGER NC TYPE(C_PTR) IPMAC2(NC) INTEGER NG,NL,LX1,NMIX1,NMIX2,IMIX(LX1),IMIX1(LX1),IGAP(LX1), - 1 ILEAKS,IDF,IPRINT + 1 ILEAKS,IDF,IPRINT,IH REAL ZKEFF(NC),B2(NC),VOL1(NMIX1,NC),FLX1(NMIX1,NG,NC), 1 DC1(NMIX1,NG,NC),TOT1(NMIX1,NG,NL,NC),CHI1(NMIX1,NG,NC), - 2 SIGF1(NMIX1,NG,NC),SCAT1(NMIX1,NG,NG,NL,NC),JXM(NMIX1,NG,NC), - 3 JXP(NMIX1,NG,NC),FHETXM(NMIX1,NG,NL,NC),FHETXP(NMIX1,NG,NL,NC), - 4 ADF1(NMIX1,NG,NC) + 2 SIGF1(NMIX1,NG,NC),SCAT1(NMIX1,NG,NG,NL,NC),HFACT1(NMIX1,NG,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) *---- * LOCAL VARIABLES *---- @@ -77,7 +79,7 @@ *---- INTEGER, ALLOCATABLE, DIMENSION(:) :: IJJ,NJJ,IPOS,IMIX2 REAL, ALLOCATABLE, DIMENSION(:) :: VOL,WORK,SFIS,SFIS1 - REAL, ALLOCATABLE, DIMENSION(:,:) :: DC,CHI,SIGF + REAL, ALLOCATABLE, DIMENSION(:,:) :: DC,CHI,SIGF,HFACT REAL, ALLOCATABLE, DIMENSION(:,:,:) :: FLX,TOT REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: SCAT DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: DCOU @@ -86,7 +88,8 @@ *---- ALLOCATE(VOL(NMIX2),FLX(NMIX2,NG,NL),TOT(NMIX2,NG,NL), 1 DC(NMIX2,NG),CHI(NMIX2,NG),SIGF(NMIX2,NG),SCAT(NMIX2,NG,NG,NL), - 2 IMIX2(NMIX2),SFIS(NMIX2),SFIS1(NMIX1),DCOU(NMIX2+1,NG)) + 2 HFACT(NMIX2,NG),IMIX2(NMIX2),SFIS(NMIX2),SFIS1(NMIX1), + 3 DCOU(NMIX2+1,NG)) ALLOCATE(IJJ(NMIX2),NJJ(NMIX2),IPOS(NMIX2),WORK(NG*NMIX2)) *---- * SET IMIX2 @@ -111,11 +114,12 @@ CALL LCMGET(IPMAC2(IC),'K-EFFECTIVE',ZKEFF(IC)) B2(IC)=0.0 IF(ILEAKS.GT.0) THEN - CALL LCMLEN(IPMAC2(IC),'B2 B1HOM',ILONG,ITYLCM) - IF(ILONG.EQ.1) CALL LCMGET(IPMAC2(IC),'B2 B1HOM',B2(IC)) + CALL LCMLEN(IPMAC2(IC),'B2 B1HOM',ILCMLN,ITYLCM) + IF(ILCMLN.EQ.1) CALL LCMGET(IPMAC2(IC),'B2 B1HOM',B2(IC)) ENDIF JPMAC2=LCMGID(IPMAC2(IC),'GROUP') SCAT(:,:,:,:)=0.0 + IH=0 DO IGR=1,NG KPMAC2=LCMGIL(JPMAC2,IGR) CALL LCMGET(KPMAC2,'FLUX-INTG',FLX(1,IGR,1)) @@ -155,8 +159,8 @@ CALL LCMGET(KPMAC2,'NUSIGF',SIGF(1,IGR)) DO IL=1,NL WRITE(CM,'(I2.2)') IL-1 - CALL LCMLEN(KPMAC2,'IJJS'//CM,ILONG,ITYLCM) - IF(ILONG.EQ.0) CYCLE + CALL LCMLEN(KPMAC2,'IJJS'//CM,ILCMLN,ITYLCM) + IF(ILCMLN.EQ.0) CYCLE CALL LCMGET(KPMAC2,'IJJS'//CM,IJJ) CALL LCMGET(KPMAC2,'NJJS'//CM,NJJ) CALL LCMGET(KPMAC2,'IPOS'//CM,IPOS) @@ -169,6 +173,11 @@ ENDDO ENDDO ENDDO + CALL LCMLEN(KPMAC2,'H-FACTOR',ILCMLN,ITYLCM) + IF(ILCMLN.GT.0) THEN + IH=1 + CALL LCMGET(KPMAC2,'H-FACTOR',HFACT(1,IGR)) + ENDIF DO IBM=1,NMIX2 FLX(IBM,IGR,:NL)=FLX(IBM,IGR,:NL)/VOL(IBM) ENDDO @@ -220,6 +229,7 @@ SIGF1(:,:,IC)=0.0 CHI1(:,:,IC)=0.0 SCAT1(:,:,:,:,IC)=0.0 + HFACT1(:,:,IC)=0.0 DO IL=1,NL,2 FHETXM(:,:,IL,IC)=1.0 FHETXP(:,:,IL,IC)=1.0 @@ -278,6 +288,10 @@ 1 VOL(IBM2)*FLX(IBM2,JGR,1)*SCAT(IBM2,IGR,JGR,IL) ENDDO ENDDO + IF(IH.EQ.1) THEN + HFACT1(IBM,IGR,IC)=HFACT1(IBM,IGR,IC)+VOL(IBM2)* + 1 FLX(IBM2,IGR,1)*HFACT(IBM2,IGR) + ENDIF ENDDO ENDDO DO IBM=1,NMIX1 @@ -295,6 +309,9 @@ 1 FLX1(IBM,JGR,IC) ENDDO ENDDO + IF(IH.EQ.1) THEN + HFACT1(IBM,IGR,IC)=HFACT1(IBM,IGR,IC)/FLX1(IBM,IGR,IC) + ENDIF ENDDO DO IGR=1,NG FLX1(IBM,IGR,IC)=FLX1(IBM,IGR,IC)/VOL1(IBM,IC) @@ -309,8 +326,8 @@ CALL LCMLEN(IPMAC2(IC),'HADF',NTYPE,ITYLCM) IF(NTYPE/2.NE.1) CALL XABORT('BREMAC: NTYPE=1 EXPECTED.') CALL LCMGTC(IPMAC2(IC),'HADF',8,HADF) - CALL LCMLEN(IPMAC2(IC),HADF,ILONG,ITYLCM) - IF(ILONG.NE.NMIX1*NG) CALL XABORT('BREMAC: ADF OVERFLOW.') + CALL LCMLEN(IPMAC2(IC),HADF,ILCMLN,ITYLCM) + IF(ILCMLN.NE.NMIX1*NG) CALL XABORT('BREMAC: ADF OVERFLOW.') CALL LCMGET(IPMAC2(IC),HADF,ADF1(1,1,IC)) ENDIF *---- @@ -332,6 +349,7 @@ WRITE(6,20) 'DC1',DC1(:,IGR,IC) WRITE(6,20) 'CHI1',CHI1(:,IGR,IC) WRITE(6,20) 'SIGF1',SIGF1(:,IGR,IC) + IF(IH.EQ.1) WRITE(6,20) 'H-FACTOR',HFACT1(:,IGR,IC) DO JGR=1,NG IF(IGR.EQ.JGR) THEN WRITE(6,20) 'INSCAT1-P0',SCAT1(:,IGR,IGR,1,IC) @@ -360,8 +378,8 @@ *---- * SCRATCH STORAGE DEALLOCATION *---- - DEALLOCATE(WORK,IPOS,NJJ,IJJ,DCOU,SFIS1,SFIS,IMIX2,SCAT,SIGF,CHI, - 1 DC,TOT,FLX,VOL) + DEALLOCATE(WORK,IPOS,NJJ,IJJ,DCOU,SFIS1,SFIS,IMIX2,HFACT,SCAT, + 1 SIGF,CHI,DC,TOT,FLX,VOL) RETURN * 10 FORMAT(1X,A12,10I13/(12X,10I13)) |