*DECK LIBNFI
      SUBROUTINE LIBNFI(IPLIB,NGRO,NBISO,NBMIX,NDEL,NESP,IPISO,MIX,
     1 MAXNFI,NFISSI,LSAME)
*
*-----------------------------------------------------------------------
*
*Purpose:
* compute the maximum number of fissionable isotopes in a mixture
*
*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): A. Hebert
*
*Parameters: input
* IPLIB   pointer to the lattice microscopic cross section library
*         (L_LIBRARY signature)
* NGRO    number of energy groups
* NBISO   number of isotopes present in the calculation domain
* NBMIX   number of mixtures present in the calculation domain
* NDEL    number of delayed precursor groups
* NESP    number of energy-dependent fission spectra
* IPISO   pointer array towards microlib isotopes
* MIX     mixture number of each isotope. can be zero
* MAXNFI  second dimension of array INDFIS
*
*Parameters: output
* NFISSI  maximum number of fissionable isotopes in a mixture
* LSAME   fission spectrum mask (=.true. if all the isotopes have the
*         same fission spectrum and the same precursor group decay
*         constants
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      TYPE(C_PTR) IPLIB,IPISO(NBISO)
      INTEGER NGRO,NBISO,NBMIX,NDEL,NESP,MIX(NBISO),MAXNFI,NFISSI
      LOGICAL LSAME
*----
*  LOCAL VARIABLES
*----
      TYPE(C_PTR) JPLIB
      PARAMETER (MAXGRO=50,NSTATE=40)
      CHARACTER HSMG*131,TEXT12*12
      REAL CHI2(MAXGRO),LAM1(MAXGRO),LAM2(MAXGRO)
      INTEGER IDATA(NSTATE)
      LOGICAL LFISS
*----
*  ALLOCATABLE ARRAYS
*----
      INTEGER, ALLOCATABLE, DIMENSION(:) :: IWRK
      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: INDFIS
      REAL, ALLOCATABLE, DIMENSION(:) :: CHI1
*----
*  SCRATCH STORAGE ALLOCATION
*----
      ALLOCATE(INDFIS(NBMIX,MAXNFI),CHI1(NGRO))
*
      NFISSI=0
      CALL LCMLEN(IPLIB,'MACROLIB',ILONG,ITYLCM)
      LSAME=(NGRO.LE.MAXGRO).AND.(NDEL.LE.MAXGRO)
      IF(ILONG.EQ.-1) THEN
         CALL LCMSIX(IPLIB,'MACROLIB',1)
         CALL LCMGTC(IPLIB,'SIGNATURE',12,1,TEXT12)
         IF(TEXT12.NE.'L_MACROLIB') THEN
            CALL XABORT('LIBNFI: INVALID SIGNATURE ON THE MACROLIB.')
         ENDIF
         CALL LCMGET(IPLIB,'STATE-VECTOR',IDATA)
         IF(IDATA(1).NE.NGRO) THEN
            WRITE(HSMG,'(38HLIBNFI: EXISTING MACROLIB HAVE NGROUP=,I4,
     1      26H NEW MACROLIB HAVE NGROUP=,I4,1H.)') IDATA(1),NGRO
            CALL XABORT(HSMG)
         ELSE IF(IDATA(2).GT.NBMIX) THEN
            WRITE(HSMG,'(37HLIBNFI: EXISTING MACROLIB HAVE NBMIX=,I4,
     1      25H NEW MACROLIB HAVE NBMIX=,I4,1H.)') IDATA(2),NBMIX
            CALL XABORT(HSMG)
         ELSE IF(IDATA(4).GT.NBISO) THEN
            WRITE(HSMG,'(38HLIBNFI: EXISTING MACROLIB HAVE NFISSI=,I4,
     1      13H GREATER THAN,I5,1H.)') IDATA(4),NBISO
            CALL XABORT(HSMG)
         ENDIF
         NFISSI=IDATA(4)/NESP
         LSAME=LSAME.AND.(NFISSI.LE.1)
         IF(NFISSI.GT.0) THEN
            CALL LCMLEN(IPLIB,'FISSIONINDEX',LENGTH,ITYLCM)
            IF(LENGTH.EQ.0) THEN
*              THE NAMES ARE NOT DEFINED.
               DO 10 IFIS=1,NFISSI
               DO 10 IBM=1,NBMIX
   10          INDFIS(IBM,IFIS)=0
            ELSE IF(LENGTH.EQ.NFISSI*NBMIX) THEN
               CALL LCMGET(IPLIB,'FISSIONINDEX',INDFIS)
            ELSE IF(LENGTH.LT.NFISSI*NBMIX) THEN
*              REORDER THE 'FISSIONINDEX' MATRIX.
               ALLOCATE(IWRK(LENGTH))
               CALL LCMGET(IPLIB,'FISSIONINDEX',IWRK)
               DO 30 IFIS=1,NFISSI
               DO 20 IBM=1,IDATA(2)
   20          INDFIS(IBM,IFIS)=IWRK((IFIS-1)*IDATA(2)+IBM)
               DO 30 IBM=IDATA(2)+1,NBMIX
   30          INDFIS(IBM,IFIS)=0
               DEALLOCATE(IWRK)
            ELSE
               CALL XABORT('LIBNFI: INVALID NUMBER OF MIXTURES.')
            ENDIF
         ENDIF
         CALL LCMSIX(IPLIB,' ',2)
      ENDIF
      DO 100 ISOT=1,NBISO
      IBM=MIX(ISOT)
      IF(IBM.GT.0) THEN
         JPLIB=IPISO(ISOT)
         IF(C_ASSOCIATED(JPLIB)) THEN
            CALL LCMLEN(JPLIB,'NUSIGF',LENGTH,ITYLCM)
            IF(NESP.EQ.1) THEN
               CALL LCMLEN(JPLIB,'CHI',LENGTZ,ITYLCM)
            ELSE
               CALL LCMLEN(JPLIB,'CHI--01',LENGTZ,ITYLCM)
            ENDIF
            IF((LENGTH.GT.0).AND.(LENGTZ.GT.0)) THEN
               IF(NESP.EQ.1) THEN
                  CALL LCMGET(JPLIB,'CHI',CHI1)
               ELSE
                  CALL LCMGET(JPLIB,'CHI--01',CHI1)
               ENDIF
               LFISS=.FALSE.
               DO 35 IGR=1,NGRO
               LFISS=LFISS.OR.(CHI1(IGR).GT.0.0)
   35          CONTINUE
               IF(.NOT.LFISS) GO TO 100
               IF(LSAME) THEN
                  CALL LCMLEN(JPLIB,'LAMBDA-D',LENGT1,ITYLCM)
                  IF((LENGT1.EQ.NDEL).AND.(NDEL.GT.0)) THEN
                     CALL LCMGET(JPLIB,'LAMBDA-D',LAM1)
                  ENDIF
               ENDIF
               DO 40 IFIS=1,NFISSI
               IWFIS=INDFIS(IBM,IFIS)
               IF((IWFIS.EQ.ISOT).OR.(IWFIS.EQ.0)) THEN
                  KFIS=IFIS
                  GO TO 90
               ENDIF
   40          CONTINUE
               IF(LSAME) THEN
                  DO 70 IFIS=1,NFISSI
                  IWFIS=INDFIS(IBM,IFIS)
                  JPLIB=IPISO(IWFIS)
                  CALL LCMGET(JPLIB,'CHI',CHI2)
                  DO 50 IGR=1,NGRO
   50             LSAME=LSAME.AND.(ABS(CHI1(IGR)-CHI2(IGR)).LE.1.0E-3)
                  CALL LCMLEN(JPLIB,'LAMBDA-D',LENGT2,ITYLCM)
                  IF((LENGT1.EQ.NDEL).AND.(LENGT2.EQ.NDEL)
     1                               .AND.(NDEL.GT.0)) THEN
                     CALL LCMGET(JPLIB,'LAMBDA-D',LAM2)
                     DO 60 IGR=1,NDEL
   60                LSAME=LSAME.AND.(LAM1(IGR).EQ.LAM2(IGR))
                  ENDIF
   70             CONTINUE
               ENDIF
               NFISSI=NFISSI+1
               IF(NFISSI.GT.MAXNFI) CALL XABORT('LIBNFI: INDFIS OVERFL'
     1         //'OW.')
               KFIS=NFISSI
               DO 80 JBM=1,NBMIX
   80          INDFIS(JBM,KFIS)=0
   90          INDFIS(IBM,KFIS)=ISOT
            ENDIF
         ENDIF
      ENDIF
  100 CONTINUE
*----
*  SCRATCH STORAGE DEALLOCATION
*----
      DEALLOCATE(CHI1,INDFIS)
      RETURN
      END
