*DECK NCRLIB
      SUBROUTINE NCRLIB(MAXNIS,MAXISO,MAXFEL,IPLIB,IPCPO,IACCS,NMIX,
     1 NGRP,IMPX,NCAL,TERP,NISO,LISO,HISO,CONC,MIXC,LXS,LRES,B2)
*
*-----------------------------------------------------------------------
*
*Purpose:
* build the microlib by scanning the NCAL elementary calculations and
* weighting them with TERP factors.
*
*Copyright:
* Copyright (C) 2006 Ecole Polytechnique de Montreal
*
*Author(s): A. Hebert
*
*Parameters: input
* MAXNIS  maximum value of NISO(I) in user data.
* MAXISO  maximum allocated space for output microlib TOC information.
* MAXFEL  number of fuel rings used for the micro-depletion.
* IPLIB   address of the output microlib LCM object.
* IPCPO   address of the multicompo object.
* IACCS   =0 microlib is created; =1 ... is updated.
* NMIX    maximum number of material mixtures in the microlib.
* NGRP    number of energy groups.
* IMPX    print parameter (equal to zero for no print).
* NCAL    number of elementary calculations in the compo.
* TERP    interpolation factors.
* NISO    number of user-selected isotopes.
* LISO    type of treatment (=.true.: ALL; =.false.: ONLY).
* HISO    name of the user-selected isotopes.
* CONC    user-defined number density of the user-selected isotopes. A
*         value of -99.99 is set to indicate that the compo value is
*         used.
* MIXC    mixture index in the compo corresponding to each microlib
*         mixture. Equal to zero if a microlib mixture is not updated.
* LXS     =.true. if keyword 'ALLX' is specified
* LRES    =.true. if the interpolation is done without updating isotopic 
*         densities
* B2      buckling
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      TYPE(C_PTR) IPLIB,IPCPO
      INTEGER MAXNIS,MAXISO,MAXFEL,IACCS,NMIX,NGRP,IMPX,NCAL,NISO(NMIX),
     1 HISO(2,NMIX,MAXNIS),MIXC(NMIX)
      REAL TERP(NCAL,NMIX),CONC(NMIX,MAXNIS),B2
      LOGICAL LISO(NMIX),LXS,LRES
*----
*  LOCAL VARIABLES
*----
      PARAMETER (NSTATE=40,MAXED=50,IOUT=6)
      CHARACTER TEXT12*12,HNAME*12,HSMG*131,HVECT1(MAXED)*8,
     1 HVECT2(MAXED)*8,CHAR1*4,CHAR2*4,HHISO*8
      INTEGER ISTATE(NSTATE),KCHAR(3)
      LOGICAL LUSER
      TYPE(C_PTR) JPCPO,KPCPO,LPCPO,MPCPO,JPLIB,KPLIB
      INTEGER, ALLOCATABLE, DIMENSION(:) :: ITYP1,ITOD1,IMIX2,ITYP2,
     1 ITOD2,MILVO
      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: HUSE1,HNAM1,HUSE2,HNAM2
      REAL, ALLOCATABLE, DIMENSION(:) :: DENS1,TEMP1,VOL1,DENS2,TEMP2,
     1 VOL2,ENER,DELT,FACT,VOLMI2,GAR1,GAR2
*----
*  SCRATCH STORAGE ALLOCATION
*----
      ALLOCATE(HUSE1(3,MAXISO),HNAM1(3,MAXISO),ITYP1(MAXISO),
     1 ITOD1(MAXISO),IMIX2(MAXISO),ITYP2(MAXISO),ITOD2(MAXISO),
     2 HUSE2(3,MAXISO),HNAM2(3,MAXISO),MILVO(NMIX))
      ALLOCATE(DENS1(MAXISO),TEMP1(MAXISO),VOL1(MAXISO),DENS2(MAXISO),
     1 TEMP2(MAXISO),VOL2(MAXISO),ENER(NGRP+1),DELT(NGRP),FACT(NCAL),
     2 VOLMI2(NMIX))
*----
*  MICROLIB INITIALIZATION
*----
      ITRANC=0
      IF(IACCS.EQ.0) THEN
         IF(LRES) CALL XABORT('NCRLIB: RES OPTION IS INVALID.')
         NBISO2=0
         NCOMB2=0
         NED2=0
         TEXT12='L_LIBRARY'
         READ(TEXT12,'(3A4)') (KCHAR(I0),I0=1,3)
         CALL LCMPUT(IPLIB,'SIGNATURE',3,3,KCHAR)
         CALL XDRSET(VOLMI2,NMIX,0.0)
         CALL XDRSET(DENS2,MAXISO,0.0)
         CALL XDRSET(VOL2,MAXISO,0.0)
         CALL XDRSET(TEMP2,MAXISO,0.0)
         CALL XDISET(IMIX2,MAXISO,0)
         CALL XDISET(ITYP2,MAXISO,0)
         CALL XDISET(ITOD2,MAXISO,0)
      ELSE
         CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
         IF(ISTATE(1).NE.NMIX) CALL XABORT('NCRLIB: INVALID NUMBER OF '
     1   //'MATERIAL MIXTURES IN THE MICROLIB.')
         IF(ISTATE(3).NE.NGRP) CALL XABORT('NCRLIB: INVALID NUMBER OF '
     1   //'ENERGY GROUPS IN THE MICROLIB.')
         NBISO2=ISTATE(2)
         NCOMB2=ISTATE(12)
         IF(NBISO2.GT.MAXISO) CALL XABORT('NCRLIB: MAXISO OVERFLOW(1).')
         NED2=ISTATE(13)
         IF(NED2.GT.MAXED) CALL XABORT('NCRLIB: MAXED OVERFLOW.')
         CALL LCMLEN(IPLIB,'MIXTURESVOL',ILONG,ITYLCM)
         IF(ILONG.GT.0) THEN
           CALL LCMGET(IPLIB,'MIXTURESVOL',VOLMI2)
         ELSE
           CALL XDRSET(VOLMI2,NMIX,0.0)
         ENDIF
         CALL LCMGET(IPLIB,'ISOTOPESUSED',HUSE2)
         CALL LCMGET(IPLIB,'ISOTOPERNAME',HNAM2)
         CALL LCMGET(IPLIB,'ISOTOPESTYPE',ITYP2)
         CALL LCMGET(IPLIB,'ISOTOPESTODO',ITOD2)
         IF(LRES) THEN
           CALL LCMGET(IPLIB,'ISOTOPESDENS',DENS2)
           CALL LCMGET(IPLIB,'ISOTOPESVOL',VOL2)
           CALL LCMGET(IPLIB,'ISOTOPESMIX',IMIX2)
           CALL LCMGET(IPLIB,'ISOTOPESTEMP',TEMP2)
         ELSE
           CALL XDRSET(DENS2,MAXISO,0.0)
           CALL XDRSET(VOL2,MAXISO,0.0)
           CALL XDISET(IMIX2,MAXISO,0)
           CALL XDRSET(TEMP2,MAXISO,0.0)
         ENDIF
         IF(NED2.GT.0) CALL LCMGTC(IPLIB,'ADDXSNAME-P0',8,NED2,HVECT2)
         CALL LCMGET(IPLIB,'ENERGY',ENER)
         CALL LCMGET(IPLIB,'DELTAU',DELT)
      ENDIF
*----
*  RECOVER NDEPL
*----
      NDEPL=0
      CALL LCMLEN(IPCPO,'DEPL-CHAIN',ILONG,ITYLCM)
      IF(ILONG.NE.0) THEN
        CALL LCMSIX(IPCPO,'DEPL-CHAIN',1)
        CALL LCMGET(IPCPO,'STATE-VECTOR',ISTATE)
        NDEPL=ISTATE(1)
        CALL LCMSIX(IPCPO,' ',2)
      ENDIF
*----
*  LOOP OVER MICROLIB MIXTURES
*----
      CALL XDISET(MILVO,NMIX,0)
      NCOMB=0
      JPCPO=LCMGID(IPCPO,'MIXTURES')
      DO 190 IBM=1,NMIX
      IBMOLD=MIXC(IBM)
      IF(IBMOLD.EQ.0) GO TO 190
      IF(NISO(IBM).GT.MAXNIS) CALL XABORT('NCRLIB: MAXNIS OVERFLOW.')
      KPCPO=LCMGIL(JPCPO,IBMOLD)
      LPCPO=LCMGID(KPCPO,'CALCULATIONS')
*----
*  LOOP OVER ELEMENTARY CALCULATIONS
*----
      NBISO1=0
      JSO1=0
      DO 110 ICAL=1,NCAL
      WEIGHT=TERP(ICAL,IBM)
      IF(WEIGHT.EQ.0.0) GO TO 110
      MPCPO=LCMGIL(LPCPO,ICAL)
      IF(IMPX.GT.0) THEN
         WRITE(IOUT,'(33H NCRLIB: COMPO ACCESS FOR MIXTURE,I6,5H (<==,
     1   I4,17H) AND CALCULATION,I5,9H. WEIGHT=,1P,E12.4)') IBM,IBMOLD,
     2   ICAL,WEIGHT
         IF(IMPX.GT.50) CALL LCMLIB(MPCPO)
      ENDIF
      CALL LCMGET(MPCPO,'STATE-VECTOR',ISTATE)
      NL=ISTATE(4)
      ITRANC=ISTATE(5)
      NDEPL=MAX(ISTATE(11),NDEPL)
      NDEL=ISTATE(19)
      NDFI=ISTATE(20)
      IF(ISTATE(1).NE.1) CALL XABORT('NCRLIB: INVALID NUMBER OF MATERI'
     1 //'AL MIXTURES IN THE COMPO.')
      IF(ISTATE(3).NE.NGRP) CALL XABORT('NCRLIB: INVALID NUMBER OF ENE'
     1 //'RGY GROUPS IN THE COMPO.')
      NBISO1=ISTATE(2)
      IF(NBISO1.GT.MAXISO) CALL XABORT('NCRLIB: MAXISO OVERFLOW(2).')
      NED1=ISTATE(13)
      IF(NED1.GT.MAXED) CALL XABORT('NCRLIB: MAXED OVERFLOW.')
      CALL LCMLEN(MPCPO,'MIXTURESVOL',ILONG,ITYLCM)
      IF(ILONG.GT.0) CALL LCMGET(MPCPO,'MIXTURESVOL',VOLMI2(IBM))
      CALL LCMGET(MPCPO,'ISOTOPESUSED',HUSE1)
      CALL LCMGET(MPCPO,'ISOTOPERNAME',HNAM1)
      CALL LCMGET(MPCPO,'ISOTOPESDENS',DENS1)
      CALL LCMGET(MPCPO,'ISOTOPESTYPE',ITYP1)
      CALL LCMGET(MPCPO,'ISOTOPESTODO',ITOD1)
      CALL LCMGET(MPCPO,'ISOTOPESVOL',VOL1)
      CALL LCMGET(MPCPO,'ISOTOPESTEMP',TEMP1)
      IF(NED1.GT.0) CALL LCMGTC(MPCPO,'ADDXSNAME-P0',8,NED1,HVECT1)
      CALL LCMGET(MPCPO,'ENERGY',ENER)
      CALL LCMGET(MPCPO,'DELTAU',DELT)
      DO 30 IED1=1,NED1
      DO 20 IED2=1,NED2
      IF(HVECT1(IED1).EQ.HVECT2(IED2)) GO TO 30
   20 CONTINUE
      NED2=NED2+1
      HVECT2(NED2)=HVECT1(IED1)
   30 CONTINUE
      IF(IBM.GT.9999) CALL XABORT('NCRLIB: IBM OVERFLOW.')
      IF(.NOT.LRES) THEN
        DO 100 ISO=1,NBISO1 ! compo isotope
        WRITE(TEXT12,'(2A4,I4.4)') (HUSE1(I,ISO),I=1,2),IBM
        IF(LXS) THEN
          WRITE(CHAR1,'(A4)') HUSE1(3,ISO)
          READ(CHAR1,'(I4)') NBRG
          NBISOT=NBRG+MAXFEL*(IBM-1)
          IF(NBISOT.GT.9999) CALL XABORT('NCRLIB: NBISOT OVERFLOW.')
          WRITE(TEXT12,'(2A4,I4.4)') (HUSE1(I,ISO),I=1,2),NBISOT
        ENDIF
        KSO1=0
        DO 40 KSO=1,NISO(IBM) ! user-selected isotope
        WRITE(HHISO,'(2A4)') (HISO(I0,IBM,KSO),I0=1,2)
        IF(TEXT12(:8).EQ.HHISO) THEN
          KSO1=KSO
          GO TO 50
        ENDIF
   40   CONTINUE
        IF(.NOT.LISO(IBM)) GO TO 100
   50   DO 60 JSO=1,NBISO2 ! microlib isotope
        IF((HUSE1(1,ISO).EQ.HUSE2(1,JSO)).AND.(HUSE1(2,ISO).EQ.
     1  HUSE2(2,JSO)).AND.(IMIX2(JSO).EQ.IBM)) THEN
          IF(ITYP1(ISO).NE.ITYP2(JSO)) THEN
            WRITE(HSMG,500) 'ITYP',ISO,ITYP1(ISO),ITYP2(JSO)
            CALL XABORT(HSMG)
          ENDIF
          IF(LXS) THEN
            WRITE(CHAR1,'(A4)') HUSE1(3,ISO)
            WRITE(CHAR2,'(A4)') HUSE2(3,JSO)
            READ(CHAR2,'(I4.4)') NBISOT2
            NBISOT2=NBISOT2-MAXFEL*(IBM-1)
            WRITE(CHAR2,'(I4.4)') NBISOT2
            IF(CHAR1.EQ.CHAR2) THEN
              JSO1=JSO
              GO TO 90
            ENDIF
          ELSE
            JSO1=JSO
            GO TO 90
          ENDIF
        ENDIF
   60   CONTINUE
        NBISO2=NBISO2+1
        IF(NBISO2.GT.MAXISO) THEN
          WRITE(IOUT,'(/16H NCRLIB: NBISO2=,I6,8H MAXISO=,I6)') NBISO2,
     1    MAXISO
          CALL XABORT('NCRLIB: MAXISO OVERFLOW(3).')
        ENDIF
        READ(TEXT12,'(3A4)') (HUSE2(I0,NBISO2),I0=1,3)
        DO 70 I0=1,3
   70   HNAM2(I0,NBISO2)=HNAM1(I0,ISO)
        IMIX2(NBISO2)=IBM
        ITYP2(NBISO2)=ITYP1(ISO)
        ITOD2(NBISO2)=ITOD1(ISO)
        IF(ITYP2(NBISO2).EQ.1) ITOD2(NBISO2)=1
        DENS2(NBISO2)=0.0
        JSO1=NBISO2
        IF(ITOD2(NBISO2).NE.1) THEN
          DO 80 J=1,NCOMB
          IF(IBM.EQ.MILVO(J)) GO TO 90
   80     CONTINUE
          NCOMB=NCOMB+1
          IF(NCOMB.GT.NMIX) CALL XABORT('NCRLIB: MILVO OVERFLOW.')
          MILVO(NCOMB)=IBM
        ENDIF
   90   LUSER=.FALSE.
        IF(KSO1.GT.0) LUSER=(CONC(IBM,KSO1).NE.-99.99)
        IF(LUSER) DENS1(ISO)=CONC(IBM,KSO1)
        DENS2(JSO1)=DENS2(JSO1)+WEIGHT*DENS1(ISO)
        VOL2(JSO1)=VOL2(JSO1)+WEIGHT*VOL1(ISO)
        TEMP2(JSO1)=TEMP2(JSO1)+WEIGHT*TEMP1(ISO)
  100   CONTINUE
      ENDIF
  110 CONTINUE
*----
*  PROCESS ISOTOPE DIRECTORIES FOR MICROLIB MIXTURE IBM
*----
      DO 180 ISO=1,NBISO2 ! microlib isotope
      IF(IMIX2(ISO).NE.IBM) GO TO 180
      WRITE(TEXT12,'(3A4)') (HUSE2(I0,ISO),I0=1,3)
      DO 120 JSO=1,NBISO1 ! compo isotope
      IF((HUSE1(1,JSO).EQ.HUSE2(1,ISO)).AND.(HUSE1(2,JSO).EQ.
     1 HUSE2(2,ISO))) THEN
        IF(LXS) THEN
          WRITE(CHAR1,'(A4)') HUSE1(3,JSO)
          WRITE(CHAR2,'(A4)') HUSE2(3,ISO)
          READ(CHAR1,'(I4.4)') NBRG
          NBISOT=NBRG+MAXFEL*(IBM-1)
          READ(CHAR2,'(I4.4)') NBISOT2
          IF(NBISOT.EQ.NBISOT2) THEN
            WRITE(HNAME,'(3A4)') (HUSE1(I0,JSO),I0=1,3)
            JSO1=JSO
            GO TO 130
          ENDIF
        ELSE
          WRITE(HNAME,'(3A4)') (HUSE1(I0,JSO),I0=1,3)
          JSO1=JSO
          GO TO 130
        ENDIF
      ENDIF
  120 CONTINUE
      CALL XABORT('NCRLIB: UNABLE TO FIND '//TEXT12//'.')
  130 CALL XDRSET(FACT,NCAL,0.0)
      KSO1=0
      DO 140 KSO=1,NISO(IBM) ! user-selected isotope
      WRITE(HHISO,'(2A4)') (HISO(I0,IBM,KSO),I0=1,2)
      IF(HNAME(:8).EQ.HHISO) THEN
         KSO1=KSO
         GO TO 150
      ENDIF
  140 CONTINUE
      IF(.NOT.LISO(IBM)) GO TO 170
  150 DO 160 ICAL=1,NCAL
      WEIGHT=TERP(ICAL,IBM)
      IF(WEIGHT.EQ.0.0) GO TO 160
      LUSER=.FALSE.
      IF(KSO1.GT.0) LUSER=(CONC(IBM,KSO1).NE.-99.99)
      IF(LUSER) THEN
         FACT(ICAL)=CONC(IBM,KSO1)
      ELSE
         MPCPO=LCMGIL(LPCPO,ICAL)
         CALL LCMGET(MPCPO,'ISOTOPESDENS',DENS1)
         FACT(ICAL)=DENS1(JSO1)
      ENDIF
      IF(DENS2(ISO).GT.FACT(ICAL)*1.0E-9) THEN
         FACT(ICAL)=FACT(ICAL)/DENS2(ISO)
      ELSE
         FACT(ICAL)=1.0
      ENDIF
  160 CONTINUE
  170 CALL LCMSIX(IPLIB,TEXT12,1)
      CALL NCRISO(IPLIB,LPCPO,HNAME,IBMOLD,NCAL,NGRP,NL,NED2,HVECT2,
     1 NDEL,NDFI,IMPX,FACT,TERP(1,IBM))
      CALL LCMSIX(IPLIB,' ',2)
  180 CONTINUE
  190 CONTINUE
*----
*  MICROLIB FINALIZATION
*----
      IF(.NOT.LRES) THEN
        CALL XDISET(ISTATE,NSTATE,0)
        ISTATE(1)=NMIX
        ISTATE(2)=NBISO2
        ISTATE(3)=NGRP
        ISTATE(4)=NL
        ISTATE(5)=ITRANC
        ISTATE(7)=1
        ISTATE(11)=NDEPL
        ISTATE(12)=NCOMB+NCOMB2
        ISTATE(13)=NED2
        ISTATE(14)=NMIX
        ISTATE(18)=1
        ISTATE(19)=NDEL
        ISTATE(20)=NDFI
        ISTATE(22)=MAXISO/NMIX
        IF(NBISO2.EQ.0) CALL XABORT('NCRLIB: NBISO2=0.')
        CALL LCMPUT(IPLIB,'STATE-VECTOR',NSTATE,1,ISTATE)
        CALL LCMPUT(IPLIB,'MIXTURESVOL',NMIX,2,VOLMI2)
        CALL LCMPUT(IPLIB,'ISOTOPESUSED',3*NBISO2,3,HUSE2)
        CALL LCMPUT(IPLIB,'ISOTOPERNAME',3*NBISO2,3,HNAM2)
        CALL LCMPUT(IPLIB,'ISOTOPESDENS',NBISO2,2,DENS2)
        CALL LCMPUT(IPLIB,'ISOTOPESMIX',NBISO2,1,IMIX2)
        CALL LCMPUT(IPLIB,'ISOTOPESTYPE',NBISO2,1,ITYP2)
        CALL LCMPUT(IPLIB,'ISOTOPESTODO',NBISO2,1,ITOD2)
        CALL LCMPUT(IPLIB,'ISOTOPESVOL',NBISO2,2,VOL2)
        CALL LCMPUT(IPLIB,'ISOTOPESTEMP',NBISO2,2,TEMP2)
        IF(NED2.GT.0) CALL LCMPTC(IPLIB,'ADDXSNAME-P0',8,NED2,HVECT2)
        CALL LCMPUT(IPLIB,'ENERGY',NGRP+1,2,ENER)
        CALL LCMPUT(IPLIB,'DELTAU',NGRP,2,DELT)
      ENDIF
      IF(IMPX.GT.5) CALL LCMLIB(IPLIB)
      IACCS=1
*----
*  BUILD EMBEDDED MACROLIB
*----
      CALL SPHEMB(IPLIB,IPCPO,NGRP,NMIX,MIXC)
*----
*  INCLUDE LEAKAGE IN THE MACROLIB (USED ONLY FOR NON-REGRESSION TESTS)
*----
      IF(B2.NE.0.0) THEN
        CALL LCMSIX(IPLIB,'MACROLIB',1)
        JPLIB=LCMGID(IPLIB,'GROUP')
        ALLOCATE(GAR1(NMIX),GAR2(NMIX))
        DO 210 IGR=1,NGRP
          KPLIB=LCMGIL(JPLIB,IGR)
          CALL LCMGET(KPLIB,'NTOT0',GAR1)
          CALL LCMGET(KPLIB,'DIFF',GAR2)
          DO 200 IBM=1,NMIX
            IF(MIXC(IBM).NE.0) GAR1(IBM)=GAR1(IBM)+B2*GAR2(IBM)
  200     CONTINUE
          CALL LCMPUT(KPLIB,'NTOT0',NMIX,2,GAR1)
  210   CONTINUE
        DEALLOCATE(GAR2,GAR1)
        CALL LCMSIX(IPLIB,' ',2)
      ENDIF
*----
*  SCRATCH STORAGE DEALLOCATION
*----
      DEALLOCATE(VOLMI2,FACT,DELT,ENER,VOL2,TEMP2,DENS2,VOL1,TEMP1,
     1 DENS1)
      DEALLOCATE(MILVO,HNAM2,HUSE2,ITOD2,ITYP2,IMIX2,ITOD1,ITYP1,
     1 HNAM1,HUSE1)
      RETURN
*
  500 FORMAT(8HNCRLIB: ,A,1H(,I4,2H)=,2I5)
      END
