summaryrefslogtreecommitdiff
path: root/Dragon/src/LIBWRE.f
diff options
context:
space:
mode:
Diffstat (limited to 'Dragon/src/LIBWRE.f')
-rw-r--r--Dragon/src/LIBWRE.f270
1 files changed, 270 insertions, 0 deletions
diff --git a/Dragon/src/LIBWRE.f b/Dragon/src/LIBWRE.f
new file mode 100644
index 0000000..2e707f5
--- /dev/null
+++ b/Dragon/src/LIBWRE.f
@@ -0,0 +1,270 @@
+*DECK LIBWRE
+ SUBROUTINE LIBWRE(NTYP,IPRINT,ITLIB ,NGROUP,NL,IGRF,IGRL,NGR,
+ > SCAT,SIGS,TOTAL,XSNG,SIGF,XSFI,XNU,DELTA,
+ > DIL,DLJ,XSOUT,XSCOR,DSIGPL)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Resonance integral temperature and dilution interpolation.
+*
+*Copyright:
+* Copyright (C) 1997 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version.
+*
+*Author(s):
+* G. Marleau
+*
+*Parameters: input
+* NTYP types of self shielding rates:
+* = 1 only absorption;
+* = 2 absorption+fission;
+* = 3 absorption+fission+scattering.
+* IPRINT print flag.
+* ITLIB types of library:
+* = 1 WIMS-AECL;
+* = 2 WIMS-D4.
+* NGROUP number of groups.
+* NL number of Legendre scattering order.
+* IGRF first resonance group to treat.
+* IGRL last resonance group to treat.
+* NGR number of resonance groups.
+* SCAT complete scattering matrix
+* SCAT(JG,IG) is from IG to JG.
+* SIGS total scattering out of group.
+* TOTAL total XS.
+* XSNG (n,g) XS.
+* SIGF nu*fission XS.
+* XSFI fission XS
+* XNU 1/nu
+* DELTA lethargy.
+* DIL standard dilution.
+* DLJ Livolant-Jeanpierre dilution.
+* XSOUT resonnances integrals.
+* XSCOR total correction.
+* DSIGPL potential XS times G-C parameters.
+*
+*-----------------------------------------------------------------------
+*
+ IMPLICIT NONE
+ INTEGER IOUT
+ CHARACTER NAMSBR*6
+ PARAMETER (IOUT=6,NAMSBR='LIBWRE')
+*----
+* INTEFACE VRAIABLES
+*----
+ INTEGER NTYP,IPRINT,ITLIB,NGROUP,NL,IGRF,IGRL,NGR
+ REAL SCAT(NGROUP,NGROUP,NL),SIGS(NGROUP,NL),TOTAL(NGROUP),
+ 1 XSNG(NGROUP),SIGF(NGROUP),XSFI(NGROUP),
+ 2 XNU(NGROUP),DELTA(NGROUP),DIL(NGROUP),
+ 3 DLJ(NGROUP),XSOUT(NGROUP,7),XSCOR(4),DSIGPL(NGR)
+*----
+* LOCAL VARIABLES
+*----
+ INTEGER IGRR,JG,IG1,IG2,IL
+ REAL XSF,DDIL,DDLJ
+ DOUBLE PRECISION XNUMER,XDENOM
+*
+*-----
+*
+ IF(ABS(IPRINT) .GE. 100) THEN
+ WRITE(IOUT,6000) NAMSBR
+ ENDIF
+ DO 100 IGRR=IGRF,IGRL
+ DDLJ=DLJ(IGRR)
+ DDIL=DIL(IGRR)
+ IF(ABS(IPRINT) .GE. 1000) THEN
+ WRITE(IOUT,*) 'Potential XS*GC parameter ',DSIGPL(IGRR-IGRF+1)
+ ENDIF
+ IF(NTYP.EQ.3.AND.XSCOR(3).GT.0.0) THEN
+*----
+* COMPUTE FLUX
+* SCATTERING IS SELF-SHIELDED
+*----
+ IF(IGRR .EQ. IGRF) THEN
+ IF(ABS(IPRINT) .GE. 100) THEN
+ WRITE(IOUT,6020)
+ ENDIF
+ ENDIF
+ IF(ITLIB.EQ.1) THEN
+ XNUMER=DBLE(DDLJ-XSOUT(IGRR,1))
+ DO 110 JG=1,IGRR-1
+ XNUMER=XNUMER+DBLE(
+ > XSOUT(JG,4)*DELTA(JG)*SCAT(IGRR,JG,1)/DELTA(IGRR))
+ 110 CONTINUE
+ XDENOM=DBLE(DDLJ+SIGS(IGRR,1)-SCAT(IGRR,IGRR,1))
+ XSOUT(IGRR,4)=REAL(XNUMER/XDENOM)
+ XNUMER=DBLE(DDIL-XSOUT(IGRR,1))
+ DO 115 JG=1,IGRR-1
+ XNUMER=XNUMER+DBLE(
+ > XSOUT(JG,5)*DELTA(JG)*SCAT(IGRR,JG,1)/DELTA(IGRR))
+ 115 CONTINUE
+ XDENOM=DBLE(DDIL+SIGS(IGRR,1)-SCAT(IGRR,IGRR,1))
+ XSOUT(IGRR,5)=REAL(XNUMER/XDENOM)
+ ELSE
+ XSOUT(IGRR,4)=(DDLJ-XSOUT(IGRR,1))/DDLJ
+ XSOUT(IGRR,5)=(DDIL-XSOUT(IGRR,1))/DDIL
+ ENDIF
+ IF(ABS(IPRINT) .GE. 1000) THEN
+ WRITE(IOUT,*) 'Flux 2 ',XSOUT(IGRR,4)
+ ENDIF
+ IF(XNU(IGRR).NE.0.0) THEN
+ XSOUT(IGRR,6)=XSOUT(IGRR,2)/XNU(IGRR)
+ ELSE
+ XSOUT(IGRR,6)=0.0
+ ENDIF
+ XSOUT(IGRR,7)=XSOUT(IGRR,1)-XSOUT(IGRR,6)
+ IF(ABS(IPRINT) .GE. 1000) THEN
+ WRITE(IOUT,*) 'Total ',XSOUT(IGRR,1),XSOUT(IGRR,3),
+ > XSOUT(IGRR,1)+XSOUT(IGRR,3)
+ ENDIF
+ XSOUT(IGRR,1)=XSOUT(IGRR,1)+XSOUT(IGRR,3)
+ ELSE IF(XSCOR(1).GT.0.0) THEN
+*----
+* COMPUTE FLUX AND DRAGLIB FLUX
+* SCATTERING IS NOT SELF-SHIELDED
+*----
+ IF(IGRR .EQ. IGRF) THEN
+ IF(ABS(IPRINT) .GE. 100) THEN
+ WRITE(IOUT,6021)
+ ENDIF
+ ENDIF
+ IF(ITLIB.EQ.1) THEN
+ XNUMER=DBLE(DDLJ-XSOUT(IGRR,1))
+ DO 120 JG=1,IGRR-1
+ XNUMER=XNUMER+DBLE(
+ > XSOUT(JG,4)*DELTA(JG)*SCAT(IGRR,JG,1)/DELTA(IGRR))
+ 120 CONTINUE
+ XDENOM=DBLE(DDLJ+SIGS(IGRR,1)-SCAT(IGRR,IGRR,1))
+ XSOUT(IGRR,4)=REAL(XNUMER/XDENOM)
+ IF(ABS(IPRINT) .GE. 1000) THEN
+ WRITE(IOUT,*) 'Flux 1 ',XSOUT(IGRR,4),XNUMER,XDENOM
+ ENDIF
+ XNUMER=DBLE(DDIL-XSOUT(IGRR,1))
+ DO 130 JG=1,IGRR-1
+ XNUMER=XNUMER+DBLE(
+ > XSOUT(JG,5)*DELTA(JG)*SCAT(IGRR,JG,1)/DELTA(IGRR))
+ 130 CONTINUE
+ XDENOM=DBLE(DDIL+SIGS(IGRR,1)-SCAT(IGRR,IGRR,1))
+ XSOUT(IGRR,5)=REAL(XNUMER/XDENOM)
+ ELSE
+ XSOUT(IGRR,4)=(DDLJ-XSOUT(IGRR,1))/DDLJ
+ XSOUT(IGRR,5)=(DDIL-XSOUT(IGRR,1))/DDIL
+ IF(ABS(IPRINT) .GE. 1000) THEN
+ WRITE(IOUT,*) 'Flux 2 ',XSOUT(IGRR,4)
+ ENDIF
+ ENDIF
+ XSOUT(IGRR,3)=SIGS(IGRR,1)*XSOUT(IGRR,4)
+ IF(NTYP.LT.2) THEN
+ XSOUT(IGRR,2)=SIGF(IGRR)*XSOUT(IGRR,4)
+ ENDIF
+ IF(XNU(IGRR).NE.0.0) THEN
+ XSOUT(IGRR,6)=XSOUT(IGRR,2)/XNU(IGRR)
+ ELSE
+ XSOUT(IGRR,6)=0.0
+ ENDIF
+ IF(ABS(IPRINT) .GE. 1000) THEN
+ WRITE(IOUT,*) 'Total ',XSOUT(IGRR,1),
+ > SIGS(IGRR,1)*XSOUT(IGRR,5),
+ > XSOUT(IGRR,1)+SIGS(IGRR,1)*XSOUT(IGRR,5)
+ ENDIF
+ XSOUT(IGRR,1)=SIGS(IGRR,1)*XSOUT(IGRR,5)+XSOUT(IGRR,1)
+ XSOUT(IGRR,7)=XSOUT(IGRR,1)-XSOUT(IGRR,3)-XSOUT(IGRR,6)
+ ELSE IF(XSOUT(IGRR,4).NE.0.0) THEN
+ IF(IGRR .EQ. IGRF) THEN
+ IF(ABS(IPRINT) .GE. 100) THEN
+ WRITE(IOUT,6022)
+ ENDIF
+ ENDIF
+ IF(XNU(IGRR).NE.0.0) THEN
+ XSOUT(IGRR,6)=SIGF(IGRR)*XSOUT(IGRR,4)/XNU(IGRR)
+ ELSE
+ XSOUT(IGRR,6)=0.0
+ ENDIF
+ XSOUT(IGRR,1)=TOTAL(IGRR)*XSOUT(IGRR,4)
+ XSOUT(IGRR,2)=SIGF(IGRR)*XSOUT(IGRR,4)
+ XSOUT(IGRR,3)=SIGS(IGRR,1)*XSOUT(IGRR,4)
+ XSOUT(IGRR,7)=XSOUT(IGRR,1)-XSOUT(IGRR,3)-XSOUT(IGRR,6)
+ IF(ABS(IPRINT) .GE. 1000) THEN
+ WRITE(IOUT,*) 'Total ',TOTAL(IGRR)*XSOUT(IGRR,4)
+ ENDIF
+ ELSE
+ IF(IGRR .EQ. IGRF) THEN
+ IF(ABS(IPRINT) .GE. 100) THEN
+ WRITE(IOUT,6023)
+ ENDIF
+ ENDIF
+ XSOUT(IGRR,4)=1.0
+ IF(XNU(IGRR).NE.0.0) THEN
+ XSOUT(IGRR,6)=SIGF(IGRR)/XNU(IGRR)
+ ELSE
+ XSOUT(IGRR,6)=0.0
+ ENDIF
+ XSOUT(IGRR,1)=TOTAL(IGRR)
+ XSOUT(IGRR,2)=SIGF(IGRR)
+ XSOUT(IGRR,3)=SIGS(IGRR,1)
+ XSOUT(IGRR,7)=XSOUT(IGRR,1)-XSOUT(IGRR,3)-XSOUT(IGRR,6)
+ IF(ABS(IPRINT) .GE. 1000) THEN
+ WRITE(IOUT,*) 'Total ',TOTAL(IGRR)
+ ENDIF
+ ENDIF
+ 100 CONTINUE
+ DO 142 IG2=IGRF,IGRL
+ XSF=XSOUT(IG2,3)/(XSOUT(IG2,4)*SIGS(IG2,1))
+ DO 141 IL=1,NL
+ DO 140 IG1=1,NGROUP
+ SCAT(IG1,IG2,IL)=XSF*SCAT(IG1,IG2,IL)
+ 140 CONTINUE
+ 141 CONTINUE
+ 142 CONTINUE
+ IF(ABS(IPRINT) .GE. 100) THEN
+ WRITE(IOUT,6010) 'FLUX '
+ WRITE(IOUT,6011) (XSOUT(IG1,4),IG1=IGRF,IGRL)
+ WRITE(IOUT,6010) 'TOTAL RATE '
+ WRITE(IOUT,6011) (XSOUT(IG1,1),IG1=IGRF,IGRL)
+ WRITE(IOUT,6010) 'TOTAL XS '
+ WRITE(IOUT,6011) (XSOUT(IG1,1)/XSOUT(IG1,4),IG1=IGRF,IGRL)
+ WRITE(IOUT,6010) 'FISSION RATE '
+ WRITE(IOUT,6011) (XSOUT(IG1,2),IG1=IGRF,IGRL)
+ WRITE(IOUT,6010) 'FISSION XS '
+ WRITE(IOUT,6011) (XSOUT(IG1,2)/XSOUT(IG1,4),IG1=IGRF,IGRL)
+ WRITE(IOUT,6010) 'SCATTERING RATE '
+ WRITE(IOUT,6011) (XSOUT(IG1,3),IG1=IGRF,IGRL)
+ WRITE(IOUT,6010) 'SCATTERING XS '
+ WRITE(IOUT,6011) (XSOUT(IG1,3)/XSOUT(IG1,4),IG1=IGRF,IGRL)
+ WRITE(IOUT,6010) 'NG RATE '
+ WRITE(IOUT,6011) (XSOUT(IG1,7),IG1=IGRF,IGRL)
+ WRITE(IOUT,6010) 'NG XS '
+ WRITE(IOUT,6011) (XSOUT(IG1,7)/XSOUT(IG1,4),IG1=IGRF,IGRL)
+ WRITE(IOUT,6001) NAMSBR
+ ENDIF
+ DO 150 IG1=IGRF,IGRL
+ TOTAL(IG1)=XSOUT(IG1,1)/XSOUT(IG1,4)
+ SIGF(IG1)=XSOUT(IG1,2)/XSOUT(IG1,4)
+ XSF=XSOUT(IG1,3)/(XSOUT(IG1,4)*SIGS(IG1,1))
+ SIGS(IG1,1)=XSOUT(IG1,3)/XSOUT(IG1,4)
+ DO IL=2,NL
+ SIGS(IG1,IL)=XSF*SIGS(IG1,IL)
+ ENDDO
+ XSFI(IG1)=XSOUT(IG1,6)/XSOUT(IG1,4)
+ XSNG(IG1)=XSOUT(IG1,7)/XSOUT(IG1,4)
+ 150 CONTINUE
+*----
+* RETURN LIBWRE
+*----
+ RETURN
+*----
+* FORMAT
+*----
+ 6000 FORMAT('(* Output from --',A6,'-- follows ')
+ 6001 FORMAT(' Output from --',A6,'-- completed *)')
+ 6010 FORMAT(' Record = ',A16)
+ 6011 FORMAT(1P,5E15.7)
+ 6020 FORMAT(' Flux computed with self shielded scattering XS.')
+ 6021 FORMAT(' Flux computed without self shielded scattering XS.')
+ 6022 FORMAT(' Flux tabulated.')
+ 6023 FORMAT(' Flux initialized to unity.')
+ END
generated by cgit v1.2.3 (git 2.46.0) at 2026-02-16 13:17:47 +0000