*DECK LIBCMB
      SUBROUTINE LIBCMB(MAXMIX,MAXISO,NBISO,NEWISO,NNMIX,MIXCMB,VOLTOT,
     >                  VOLFRA,DENMIX,ISONAM,ISONRF,ISHINA,ISOMIX,IHLIB,
     >                  ILLIB,DENISO,TMPISO,LSHI,SNISO,SBISO,NTFG,NIR,
     >                  GIR,MASKI,IEVOL,ITYP,LCOPY)
*
*-----------------------------------------------------------------------
*
*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
* NBIS    number of isotopes before combination
* NEWISO  number of isotopes after combination
* NNMI    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
* ISHINA  self-shielding name of isotopes
* ISOMIX  mix number of each isotope
* IHLIB   isotope options
* ILLIB   xs library index for each isotope
* DENISO  density of isotopes
* TMPISO  temperature of isotopes
* LSHI    self-shielding flag
* SNIS    dilution cross section
* SBIS    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 to suppress depletion)
* ITYP    type of isotope
* LCOPY   duplication flag (=.FALSE.: combination; =.TRUE.: duplication)
*
*-----------------------------------------------------------------------
*
*----
*  SUBROUTINE ARGUMENTS
*----
      INTEGER      MAXMIX,MAXISO,NBISO,NEWISO,NNMIX,MIXCMB,
     >             ISONAM(3,MAXISO),ISONRF(3,MAXISO),ISHINA(3,MAXISO),
     >             ISOMIX(MAXISO),IHLIB(2,MAXISO,3),ILLIB(MAXISO),
     >             LSHI(MAXISO),NTFG(MAXISO),NIR(MAXISO),IEVOL(MAXISO),
     >             ITYP(MAXISO)
      LOGICAL      MASKI(MAXISO),LCOPY
      REAL         VOLTOT,VOLFRA,DENMIX(MAXMIX),DENISO(MAXISO),
     >             TMPISO(MAXISO),SNISO(MAXISO),SBISO(MAXISO),
     >             GIR(MAXISO)
      DOUBLE PRECISION TOTWPC
*----
*  LOCAL PARAMETERS
*----
      CHARACTER    TEXT4*4
*
      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
*----
      DO 100 ISO=1,NBISO
        IF(ISOMIX(ISO).EQ.NNMIX) THEN
          DENISO(ISO)=DENISO(ISO)*RMAS1
        ENDIF
 100  CONTINUE
      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 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(ISONAM(1,JSO).EQ.ISONAM(1,ISO).AND.
     >           ISONAM(2,JSO).EQ.ISONAM(2,ISO).AND.
     >           ISONRF(1,JSO).EQ.ISONRF(1,ISO).AND.
     >           ISONRF(2,JSO).EQ.ISONRF(2,ISO).AND.
     >           TMPISO(JSO)  .EQ.TMPISO(ISO)  .AND.
     >           LSHI(JSO)    .EQ.LSHI(ISO)    .AND.
     >           SNISO(JSO)   .EQ.SNISO(ISO)   .AND.
     >           SBISO(JSO)   .EQ.SBISO(ISO)        ) THEN
                DENISO(JSO)=DENISO(JSO)+REAL(TOTWPC)*DENISO(ISO)*RMAS2
                GO TO 115
              ENDIF
            ENDIF
 111      CONTINUE
          NEWISO=NEWISO+1
          ISOMIX(NEWISO)=NNMIX
          DENISO(NEWISO)=REAL(TOTWPC)*DENISO(ISO)*RMAS2
          TMPISO(NEWISO)=TMPISO(ISO)
          NTFG(NEWISO)=NTFG(ISO)
          NIR(NEWISO)=NIR(ISO)
          GIR(NEWISO)=GIR(ISO)
          SNISO(NEWISO)=SNISO(ISO)
          SBISO(NEWISO)=SBISO(ISO)
          LSHI(NEWISO)=LSHI(ISO)
          MASKI(NEWISO)=.TRUE.
          IEVOL(NEWISO)=IEVOL(ISO)
          ITYP(NEWISO)=ITYP(ISO)
          DO 120 ITC=1,3
            ISONAM(ITC,NEWISO)=ISONAM(ITC,ISO)
            ISONRF(ITC,NEWISO)=ISONRF(ITC,ISO)
            ISHINA(ITC,NEWISO)=ISHINA(ITC,ISO)
 120      CONTINUE
          MASKI(NEWISO)=.TRUE.
          IF(LCOPY) THEN
            TEXT4=' '
            READ(TEXT4,'(A4)') III
            DO 130 ILC=1,3
              DO 131 ITC=1,2
                IHLIB(ITC,NEWISO,ILC)=III
 131          CONTINUE
 130        CONTINUE
            ILLIB(NEWISO)=0
          ELSE
            DO 140 ILC=1,3
              DO 141 ITC=1,2
                IHLIB(ITC,NEWISO,ILC)=IHLIB(ITC,ISO,ILC)
 141          CONTINUE
 140        CONTINUE
            ILLIB(NEWISO)=ILLIB(ISO)
          ENDIF
        ENDIF
 115    CONTINUE
 110  CONTINUE
 150  NBISO=NEWISO
      VOLTOT=CMBVOL
      RETURN
      END
