Initial commit from Polytechnique Montreal

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