summaryrefslogtreecommitdiff
path: root/Dragon/src/LIBCMB.f
diff options
context:
space:
mode:
Diffstat (limited to 'Dragon/src/LIBCMB.f')
-rw-r--r--Dragon/src/LIBCMB.f222
1 files changed, 222 insertions, 0 deletions
diff --git a/Dragon/src/LIBCMB.f b/Dragon/src/LIBCMB.f
new file mode 100644
index 0000000..3b784c6
--- /dev/null
+++ b/Dragon/src/LIBCMB.f
@@ -0,0 +1,222 @@
+*DECK LIBCMB
+ SUBROUTINE LIBCMB(MAXMIX,MAXISO,NBISO,NEWISO,NNMIX,MIXCMB,VOLTOT,
+ > VOLFRA,DENMIX,ISONAM,ISONRF,SHINA,ISOMIX,HLIB,
+ > ILLIB,DENISO,TMPISO,LSHI,SNISO,SBISO,NTFG,NIR,
+ > GIR,MASKI,IEVOL,ITYP)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Combine mixtures by volume fraction.
+*
+*Copyright:
+* Copyright (C) 2002 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/output
+* MAXMIX maximum value of nbmix.
+* MAXISO maximum number of isotopes permitted.
+* NBISO number of isotopes before combination.
+* NEWISO number of isotopes after combination.
+* NNMIX new mixture to create or modify.
+* MIXCMB mixture to add.
+* VOLTOT total volume fraction to date.
+* VOLFRA volume fraction of current mixture.
+* DENMIX density of each mixture.
+* ISONAM name of isotopes.
+* ISONRF reference name of isotopes.
+* SHINA self-shielding name of isotopes.
+* ISOMIX mix number of each isotope.
+* HLIB isotope options.
+* ILLIB xs library index for each isotope.
+* DENISO density of isotopes.
+* TMPISO temperature of isotopes.
+* LSHI self-shielding flag.
+* SNISO dilution cross section.
+* SBISO dilution cross section used in Livolant-Jeanpierre
+* normalization.
+* NTFG number of thermal inelastic groups,
+* NIR Goldstein-Cohen flag:
+* use IR approximation for groups with index.ge.NIR;
+* use library value if NIR=0.
+* GIR Goldstein-Cohen IR parameter of each isotope.
+* MASKI treat isotope logical.
+* IEVOL depletion suppression flag (=1/2 to suppress/force depletion).
+* ITYP type of isotope.
+*
+*-----------------------------------------------------------------------
+*
+*----
+* SUBROUTINE ARGUMENTS
+*----
+ INTEGER MAXMIX,MAXISO,NBISO,NEWISO,NNMIX,MIXCMB,
+ > ISONAM(3,MAXISO),ISONRF(3,MAXISO),ISOMIX(MAXISO),
+ > ILLIB(MAXISO),LSHI(MAXISO),NTFG(MAXISO),NIR(MAXISO),
+ > IEVOL(MAXISO),ITYP(MAXISO)
+ LOGICAL MASKI(MAXISO)
+ REAL VOLTOT,VOLFRA,DENMIX(MAXMIX),DENISO(MAXISO),
+ > TMPISO(MAXISO),SNISO(MAXISO),SBISO(MAXISO),
+ > GIR(MAXISO)
+ CHARACTER(LEN=12) SHINA(MAXISO)
+ CHARACTER(LEN=8) HLIB(MAXISO,4)
+ DOUBLE PRECISION TOTWPC
+*----
+* LOCAL PARAMETERS
+*----
+ CHARACTER HSMG*131
+*
+ CMBVOL=VOLTOT+VOLFRA
+ IF(MIXCMB.EQ.NNMIX) GO TO 150
+ RMAS1=1.0
+ RMAS2=1.0
+ IF(MIXCMB.EQ.0) THEN
+*----
+* MIXTURE TO ADD IS VOID
+*----
+ IF(DENMIX(NNMIX).EQ.-1.0) THEN
+*----
+* REDUCE ATOMIC DENSITY
+*----
+ RMAS1=VOLTOT/CMBVOL
+ ELSE
+*----
+* REDUCE MIXTURE DENSITY BUT NOT WEIGHT PERCENT
+*----
+ DENMIX(NNMIX)=DENMIX(NNMIX)*VOLTOT/CMBVOL
+ ENDIF
+ ELSE
+*----
+* MIXTURE TO ADD IS NOT VOID
+*----
+ IF(DENMIX(NNMIX).EQ.-1.0) THEN
+ IF(DENMIX(MIXCMB).EQ.-1.0) THEN
+*----
+* REDUCE ATOMIC DENSITY
+*----
+ RMAS1=VOLTOT/CMBVOL
+ RMAS2=VOLFRA/CMBVOL
+ ELSE
+ IF(VOLTOT.GT.0.0)
+ > CALL XABORT('LIBCMB: CANNOT COMBINE MIXTURE WITH '//
+ > ' WEIGHT PERCENT AND ATOM CONTENTS')
+*----
+* TRANSFER MIXTURE DENSITY WITH INITIAL WEIGHT PERCENT TO NEWISO
+*----
+ DENMIX(NNMIX)=DENMIX(MIXCMB)
+ ENDIF
+ ELSE
+ IF(DENMIX(MIXCMB).EQ.-1.0)
+ > CALL XABORT('LIBCMB: CANNOT COMBINE MIXTURE WITH '//
+ > ' WEIGHT PERCENT AND ATOM CONTENTS')
+*----
+* REDUCE MIXTURE DENSITY AND WEIGHT PERCENT FOR OLD ISO
+* TRANSFER MIXTURE DENSITY WITH REDUCED WEIGHT PERCENT TO NEWISO
+*----
+ RMAS1=VOLTOT*DENMIX(NNMIX)
+ RMAS2=VOLFRA*DENMIX(MIXCMB)
+ CMBMAS=RMAS1+RMAS2
+ RMAS1=RMAS1/CMBMAS
+ RMAS2=RMAS2/CMBMAS
+ DENMIX(NNMIX)=CMBMAS/CMBVOL
+ ENDIF
+ ENDIF
+ NEWISO=NBISO
+*----
+* RESET OLD DENSITIES
+*----
+ IF(VOLTOT.EQ.0.0) THEN
+ DO 90 ISO=1,NBISO
+ IF(ISOMIX(ISO).EQ.NNMIX) THEN
+ IF(MASKI(ISO)) THEN
+ WRITE(HSMG,'(15HLIBCMB: MIXTURE,I6,18H IS ALREADY DEFINE,
+ > 14HD FOR ISOTOPE ,3A4,1H.)') NNMIX,(ISONAM(I,ISO),I=1,3)
+ CALL XABORT(HSMG)
+ ENDIF
+ ISOMIX(ISO)=0
+ ENDIF
+ 90 CONTINUE
+ ENDIF
+ IF(DENMIX(MIXCMB).EQ.-1.0) THEN
+ TOTWPC=1.0D0
+ ELSE
+ TOTWPC=0.0D0
+ DO ISO=1,NBISO
+ IF(ISOMIX(ISO).EQ.MIXCMB) THEN
+ TOTWPC=TOTWPC+DBLE(DENISO(ISO))
+ ENDIF
+ ENDDO
+ TOTWPC=1.0D0/TOTWPC
+ ENDIF
+ DO 100 ISO=1,NBISO
+ IF(ISOMIX(ISO).EQ.NNMIX) THEN
+ DENISO(ISO)=DENISO(ISO)*RMAS1
+ ENDIF
+ 100 CONTINUE
+ DO 110 ISO=1,NBISO
+ IF(ISOMIX(ISO).EQ.MIXCMB) THEN
+*----
+* SCAN ISO IN NNMIX TO IDENTIFY IDENTICAL ISOTOPES
+*----
+ DO 111 JSO=1,NBISO
+ IF(ISOMIX(JSO).EQ.NNMIX) THEN
+ IF(ISONRF(1,JSO).EQ.ISONRF(1,ISO).AND.
+ > ISONRF(2,JSO).EQ.ISONRF(2,ISO)) THEN
+ IF(ISONAM(1,JSO).NE.ISONAM(1,ISO).OR.
+ > ISONAM(2,JSO).NE.ISONAM(2,ISO).OR.
+ > TMPISO(JSO) .NE.TMPISO(ISO) .OR.
+ > LSHI(JSO) .NE.LSHI(ISO) .OR.
+ > SNISO(JSO) .NE.SNISO(ISO) .OR.
+ > SBISO(JSO) .NE.SBISO(ISO) ) THEN
+ WRITE(HSMG,'(17HLIBCMB: ISOTOPES ,3A4,5H AND ,3A4,
+ > 18H CANNOT BE MERGED.)') (ISONAM(I,ISO),I=1,3),
+ > (ISONAM(I,JSO),I=1,3)
+ CALL XABORT(HSMG)
+ ENDIF
+ DENISO(JSO)=DENISO(JSO)+REAL(TOTWPC)*DENISO(ISO)*RMAS2
+ GO TO 115
+ ENDIF
+ ENDIF
+ 111 CONTINUE
+ ISO2=0
+ DO 112 JSO=1,NBISO
+ IF(ISOMIX(JSO).EQ.0) THEN
+ ISO2=JSO
+ GO TO 113
+ ENDIF
+ 112 CONTINUE
+ NEWISO=NEWISO+1
+ IF(NEWISO.GT.MAXISO) CALL XABORT('LIBCMB: MAXISO OVERFLOW.')
+ ISO2=NEWISO
+ 113 ISOMIX(ISO2)=NNMIX
+ DENISO(ISO2)=REAL(TOTWPC)*DENISO(ISO)*RMAS2
+ TMPISO(ISO2)=TMPISO(ISO)
+ NTFG(ISO2)=NTFG(ISO)
+ NIR(ISO2)=NIR(ISO)
+ GIR(ISO2)=GIR(ISO)
+ SNISO(ISO2)=SNISO(ISO)
+ SBISO(ISO2)=SBISO(ISO)
+ LSHI(ISO2)=LSHI(ISO)
+ MASKI(ISO2)=.TRUE.
+ IEVOL(ISO2)=IEVOL(ISO)
+ ITYP(ISO2)=ITYP(ISO)
+ DO 120 ITC=1,3
+ ISONAM(ITC,ISO2)=ISONAM(ITC,ISO)
+ ISONRF(ITC,ISO2)=ISONRF(ITC,ISO)
+ 120 CONTINUE
+ SHINA(ISO2)=SHINA(ISO)
+ DO 140 ILC=1,4
+ HLIB(ISO2,ILC)=HLIB(ISO,ILC)
+ 140 CONTINUE
+ ILLIB(ISO2)=ILLIB(ISO)
+ ENDIF
+ 115 CONTINUE
+ 110 CONTINUE
+ 150 NBISO=NEWISO
+ VOLTOT=CMBVOL
+ RETURN
+ END
generated by cgit v1.2.3 (git 2.46.0) at 2026-02-16 11:33:34 +0000