*DECK NCR
      SUBROUTINE NCR(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
*
*-----------------------------------------------------------------------
*
*Purpose:
*  recover and interpolate microlib and macrolib information from one
*  or many multicompo database objects.
*
*Copyright:
* Copyright (C) 2007 Ecole Polytechnique de Montreal
*
*Author(s): A. Hebert and R. Chambon
*
*Parameters: input/output
* NENTRY  number of LCM objects or files used by the operator.
* HENTRY  name of each LCM object or file:
*         HENTRY(1): create or modification type(L_LIBRARY);
*         HENTRY(I): I>1 read-only type(L_MULTICOMPO) multicompo object;
*         HENTRY(NENTRY): read-only type(L_MAP) fuel-map object.
* IENTRY  type of each LCM object or file:
*         =1 LCM memory object; =2 XSM file; =3 sequential binary file;
*         =4 sequential ascii file
* JENTRY  access of each LCM object or file:
*         =0 the LCM object or file is created;
*         =1 the LCM object or file is open for modifications;
*         =2 the LCM object or file is open in read-only mode.
* KENTRY  LCM object address or file unit number.
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
      TYPE(C_PTR)  KENTRY(NENTRY)
      CHARACTER    HENTRY(NENTRY)*12
*----
*  LOCAL VARIABLES
*----
      PARAMETER (NSTATE=40,IOUT=6,MAXISD=400)
      CHARACTER TEXT12*12,HSMG*131,HSIGN*12,NAMDIR*12
      LOGICAL LMACRO,LCUBIC,LXS,LRES
      DOUBLE PRECISION DFLOTT
      INTEGER KCHAR(3),ISTATE(NSTATE)
      TYPE(C_PTR) IPLIB,IPLIB2,IPMAP,IPCPO,JPCPO
      INTEGER, ALLOCATABLE, DIMENSION(:) :: MIXC,NISO
      INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: HISO
      REAL, ALLOCATABLE, DIMENSION(:,:) :: TERP,CONC
      LOGICAL, ALLOCATABLE, DIMENSION(:) :: LISO
*----
*  PARAMETER VALIDATION
*----
      IF(NENTRY.LE.1) CALL XABORT('NCR: MINIMUM OF 2 OBJECTS EXPECTED.')
      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('NCR: MICRO'
     1 //'LIB LCM OBJECT EXPECTED AT LHS.')
      IF((JENTRY(1).NE.0).AND.(JENTRY(1).NE.1)) CALL XABORT('NCR: MICRO'
     1 //'LIB IN CREATE OR MODIFICATION MODE EXPECTED.')
      IACCS=JENTRY(1)
      IPLIB=KENTRY(1)
      IPLIB2=C_NULL_PTR
      IPMAP=C_NULL_PTR
      NGRP=0
      NMIX=0
      IF(IACCS.EQ.1) THEN
        CALL LCMGET(IPLIB,'SIGNATURE',KCHAR)
        WRITE(HSIGN,'(3A4)') (KCHAR(I1),I1=1,3)
        IF(HSIGN.NE.'L_LIBRARY') THEN
          TEXT12=HENTRY(1)
          CALL XABORT('NCR: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
     1    '. L_LIBRARY EXPECTED.')
        ENDIF
        CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
        NGRP=ISTATE(3)
        NMIX=ISTATE(1)
      ENDIF
      DO 10 I=2,NENTRY
        IF((IENTRY(I).NE.1).AND.(IENTRY(I).NE.2)) CALL XABORT('NCR: '
     1 //'LCM OBJECTS EXPECTED AT RHS.')
        IF(JENTRY(I).NE.2) CALL XABORT('NCR: LCM OBJECTS IN READ-ONLY '
     1 //'MODE EXPECTED AT RHS.')
        CALL LCMGET(KENTRY(I),'SIGNATURE',KCHAR)
        WRITE(HSIGN,'(3A4)') (KCHAR(I1),I1=1,3)
        IF(HSIGN.EQ.'L_LIBRARY') THEN
          IF(C_ASSOCIATED(IPLIB2)) CALL XABORT('NCR: ONLY ONE MICROLIB'
     1    //' EXPECTED AT RHS.')
          IPLIB2=KENTRY(I)
          GO TO 10
        ELSE IF(HSIGN.EQ.'L_MAP') THEN
          IF(I.NE.NENTRY)CALL XABORT('NCR: FUEL-MAP EXPECTED TO BE THE '
     1    //'LAST OBJECT.')
          IF(NENTRY.LT.3)CALL XABORT('NCR: MISSING MULTI-COMPO OBJECT.')
          IPMAP=KENTRY(NENTRY)
          CALL LCMLEN(IPMAP,'FLMIX',NMIX,ITYP)
        ELSE IF(HSIGN.NE.'L_MULTICOMPO') THEN
          TEXT12=HENTRY(I)
          CALL XABORT('NCR: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
     1   '. L_MULTICOMPO EXPECTED.')
        ENDIF
   10 CONTINUE
*----
*  READ THE INPUT DATA
*----
      LMACRO=.FALSE.
      LXS=.FALSE.
      LCUBIC=.TRUE.
      LRES=.FALSE.
      B2=0.0
      MAXFEL=0
      ITER=-1
      IPCPO=C_NULL_PTR
      IMPX=1
   20 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
      IF(INDIC.NE.3) CALL XABORT('NCR: CHARACTER DATA EXPECTED(1).')
   30 IF(TEXT12.EQ.'EDIT') THEN
*       READ THE PRINT INDEX.
        CALL REDGET(INDIC,IMPX,FLOTT,TEXT12,DFLOTT)
        IF(INDIC.NE.1) CALL XABORT('NCR: INTEGER DATA EXPECTED(1).')
      ELSE IF(TEXT12.EQ.'NMIX') THEN
*       READ THE MAXIMUM NUMBER OF MATERIAL MIXTURES.
        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
        IF(INDIC.NE.1) CALL XABORT('NCR: INTEGER DATA EXPECTED(2).')
        IF(NITMA.LT.NMIX) THEN
           WRITE(HSMG,'(20HNCR: NMIX MUST BE >=,I8)') NMIX
           CALL XABORT(HSMG)
        ENDIF
        NMIX=NITMA
      ELSE IF(TEXT12.EQ.'MACRO') THEN
        IF(LMACRO) CALL XABORT('NCR: ONLY ONE MACRO KEYWORD EXPECTED.')
        LMACRO=.TRUE.
        IF(IACCS.NE.0) CALL XABORT('NCR: LHS EXPECTED IN CREATION.')
      ELSE IF(TEXT12.EQ.'LINEAR') THEN
        LCUBIC=.FALSE.
      ELSE IF(TEXT12.EQ.'CUBIC') THEN
        LCUBIC=.TRUE.
      ELSE IF(TEXT12.EQ.'ALLX') THEN
        LXS=.TRUE.
        CALL REDGET(INDIC,MAXFEL,FLOTT,TEXT12,DFLOTT)
        IF(INDIC.NE.1) CALL XABORT('NCR: INTEGER DATA EXPECTED(3).')
      ELSE IF(TEXT12.EQ.'RES') THEN
        IF((IACCS.EQ.0).AND.(.NOT.C_ASSOCIATED(IPLIB2))) THEN
          CALL XABORT('NCR: RHS MICROLIB EXPECTED WITH RES OPTION.')
        ENDIF
        LRES=.TRUE.
      ELSE IF(TEXT12.EQ.'COMPO') THEN
        IF(NMIX.EQ.0) CALL XABORT('NCR: ZERO NUMBER OF MIXTURES.')
        IF(C_ASSOCIATED(IPMAP)) THEN
          WRITE(IOUT,'(/43H NCR: ***WARNING*** A FUEL MAP IS SET AT RH,
     1    26HS; KEYWORD TABLE EXPECTED.)')
        ENDIF
        IF((IACCS.EQ.0).AND.(C_ASSOCIATED(IPLIB2))) THEN
          CALL LCMEQU(IPLIB2,IPLIB)
          IACCS=1
        ENDIF
        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
        IF(INDIC.NE.3) CALL XABORT('NCR: CHARACTER DATA EXPECTED(2).')
        CALL REDGET(INDIC,NITMA,FLOTT,NAMDIR,DFLOTT)
        IF(INDIC.NE.3) CALL XABORT('NCR: CHARACTER DATA EXPECTED(3).')
        I0=0
        DO 50 I=2,NENTRY
          IF(C_ASSOCIATED(KENTRY(I),IPLIB2)) GO TO 50
          IF(TEXT12.EQ.HENTRY(I)) THEN
            CALL LCMGTC(KENTRY(I),'SIGNATURE',12,1,TEXT12)
            IF(TEXT12.EQ.'L_MULTICOMPO') THEN
              IPCPO=KENTRY(I)
            ELSE
              CALL XABORT('NCR: WRONG SIGNATURE ('//TEXT12//').')
            ENDIF
            ITH=I
            GO TO 60
          ENDIF
   50   CONTINUE
        CALL XABORT('NCR: COMPO '//TEXT12//' NOT FOUND.')
   60   IF(IMPX.GT.0) WRITE(IOUT,310) TEXT12,NAMDIR
        CALL LCMLEN(IPCPO,NAMDIR,ILENG,ITYLCM)
        IF((ILENG.EQ.0).OR.(ITYLCM.NE.0)) THEN
          CALL LCMLIB(IPCPO)
          CALL XABORT('NCR: NO '//NAMDIR//' DIRECTORY TO STEP.')
        ENDIF
        JPCPO=LCMGID(IPCPO,NAMDIR)
        CALL LCMGET(JPCPO,'STATE-VECTOR',ISTATE)
        IF(NGRP.EQ.0) THEN
          NGRP=ISTATE(2)
        ELSE IF(NGRP.NE.ISTATE(2)) THEN
          WRITE(HSMG,'(9H NCR: THE,I4,29H-TH COMPO HAS AN INVALID NUMB,
     1    20HER OF ENERGY GROUPS.)') ITH
          CALL XABORT(HSMG)
        ENDIF
        IF(ISTATE(12).NE.2006) CALL XABORT('NCR: 2006 COMPO SPECIF EXP'
     1   //'ECTED.')
        NMIL=ISTATE(1)
        NCAL=ISTATE(3)
        ALLOCATE(MIXC(NMIX),TERP(NCAL,NMIX),NISO(NMIX),LISO(NMIX),
     1  HISO(2,NMIX,MAXISD),CONC(NMIX,MAXISD))
*
        CALL NCRDRV(MAXISD,JPCPO,LCUBIC,NMIX,IMPX,NMIL,NCAL,ITER,
     1  MAXNIS,MIXC,TERP,NISO,LISO,HISO,CONC)
        GO TO 100
      ELSE IF(TEXT12.EQ.'TABLE') THEN
        IF(.NOT.C_ASSOCIATED(IPMAP)) CALL XABORT('NCR: MISSING FUEL-MA'
     1  //'P OBJECT.')
        CALL XDISET(ISTATE,NSTATE,0)
        CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
        NB=ISTATE(1)
        NCH=ISTATE(2)
        NCOMB=ISTATE(3)
        NGRP=ISTATE(4)
        NFUEL=ISTATE(7)
        NPARM=ISTATE(8)
        IF(NCOMB.EQ.0)CALL XABORT('NCR: NUMBER OF COMBUSTION ZONES NO'
     1   //'T YET DEFINED IN THE FUEL MAP NCOMB=0.')
        IF((IACCS.EQ.0).AND.(C_ASSOCIATED(IPLIB2))) THEN
          CALL LCMEQU(IPLIB2,IPLIB)
          IACCS=1
        ENDIF
        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
        IF(INDIC.NE.3) CALL XABORT('NCR: CHARACTER DATA EXPECTED(2).')
        CALL REDGET(INDIC,NITMA,FLOTT,NAMDIR,DFLOTT)
        IF(INDIC.NE.3) CALL XABORT('NCR: CHARACTER DATA EXPECTED(3).')
        I0=0
        DO 80 I=2,NENTRY
          IF((C_ASSOCIATED(KENTRY(I),IPLIB2)).OR.
     1       (C_ASSOCIATED(KENTRY(I),IPMAP))) GO TO 80
          IF(TEXT12.EQ.HENTRY(I)) THEN
            CALL LCMGTC(KENTRY(I),'SIGNATURE',12,1,TEXT12)
            IF(TEXT12.EQ.'L_MULTICOMPO') THEN
              IPCPO=KENTRY(I)
            ELSE
              CALL XABORT('NCR: WRONG SIGNATURE ('//TEXT12//').')
            ENDIF
            ITH=I
            GO TO 90
          ENDIF
   80   CONTINUE
        CALL XABORT('NCR: COMPO '//TEXT12//' NOT FOUND.')
   90   IF(IMPX.GT.0) WRITE(IOUT,310) TEXT12,NAMDIR
        CALL LCMLEN(IPCPO,NAMDIR,ILENG,ITYLCM)
        IF((ILENG.EQ.0).OR.(ITYLCM.NE.0)) THEN
          CALL LCMLIB(IPCPO)
          CALL XABORT('NCR: NO '//NAMDIR//' DIRECTORY TO STEP.')
        ENDIF
        JPCPO=LCMGID(IPCPO,NAMDIR)
        CALL XDISET(ISTATE,NSTATE,0)
        CALL LCMGET(JPCPO,'STATE-VECTOR',ISTATE)
        IF(ISTATE(12).NE.2006) CALL XABORT('NCR: 2006 COMPO SPECIF EXP'
     1   //'ECTED.')
        IF(NGRP.NE.ISTATE(2)) THEN
          WRITE(HSMG,'(9H NCR: THE,I4,29H-TH COMPO HAS AN INVALID NUMB,
     1    20HER OF ENERGY GROUPS.)') ITH
          CALL XABORT(HSMG)
        ENDIF
        NMIL=ISTATE(1)
        NCAL=ISTATE(3)
        ALLOCATE(MIXC(NMIX),TERP(NCAL,NMIX),NISO(NMIX),LISO(NMIX),
     1  HISO(2,NMIX,MAXISD),CONC(NMIX,MAXISD))
*
        CALL NCRRGR(MAXISD,JPCPO,IPMAP,LCUBIC,NMIX,IMPX,NMIL,NCAL,NCH,
     1  NB,NFUEL,NPARM,ITER,MAXNIS,MIXC,TERP,NISO,LISO,HISO,CONC)
        GO TO 100
      ELSE IF(TEXT12.EQ.'LEAK') THEN
        CALL REDGET(INDIC,NITMA,B2,TEXT12,DFLOTT)
        IF(INDIC.NE.2) CALL XABORT('NCR: REAL DATA EXPECTED.')
      ELSE
        CALL XABORT('NCR: '//TEXT12//' IS AN INVALID KEYWORD.')
      ENDIF
      GO TO 20
*----
*  BUILD THE INTERPOLATED MACROLIB OR MICROLIB
*----
 100  IF(LMACRO) THEN
*       build a macrolib
        MAX1D=40
        MAX2D=20
        MAXNL=5
        MAXNFI=50
        CALL NCRMAC(MAXNIS,IPLIB,JPCPO,IACCS,NMIL,NMIX,NGRP,IMPX,NCAL,
     1  TERP,NISO,LISO,HISO,CONC,MIXC,LRES,B2)
        IF(IMPX.GT.0) THEN
          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
          WRITE(IOUT,290) IMPX,(ISTATE(I),I=1,7),ISTATE(9)
        ENDIF
      ELSE
*       build a microlib
        IF(IACCS.EQ.0)THEN
          MAXISO=MAXISD*NMIX
        ELSE
          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
          MAXISO=MAX(MAXISD*NMIX,ISTATE(2))
        ENDIF
        CALL NCRLIB(MAXNIS,MAXISO,MAXFEL,IPLIB,JPCPO,IACCS,NMIX,NGRP,
     1  IMPX,NCAL,TERP,NISO,LISO,HISO,CONC,MIXC,LXS,LRES,B2)
        IF(IMPX.GT.0) THEN
          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
          WRITE(IOUT,300) IMPX,(ISTATE(I),I=1,15),(ISTATE(I),I=17,23)
        ENDIF
      ENDIF
*
      DEALLOCATE(CONC,HISO,LISO,NISO,TERP,MIXC)
*----
*  CONTINUE DATA PROCESSING
*----
      IF(ITER.EQ.0) THEN
        GO TO 200
      ELSE IF(ITER.EQ.1) THEN
        TEXT12='COMPO'
        GO TO 30
      ELSE IF(ITER.EQ.2) THEN
        TEXT12='TABLE'
        GO TO 30
      ENDIF
*----
*  LEAVE NCR:
*----
  200 IF(IMPX.GT.2) CALL LCMLIB(IPLIB)
      RETURN
*
  290 FORMAT(/8H OPTIONS/8H -------/
     1 7H IMPX  ,I6,30H   (0=NO PRINT/1=SHORT/2=MORE)/
     2 7H NGROUP,I6,28H   (NUMBER OF ENERGY GROUPS)/
     3 7H NBMIX ,I6,39H   (NUMBER OF MIXTURES IN THE MACROLIB)/
     4 7H NANISO,I6,34H   (MAXIMUM SCATTERING ANISOTROPY)/
     5 7H NIFISS,I6,45H   (MAXIMUM NUMBER OF FISSILE ISOTOPES IN A M,
     6 7HIXTURE)/
     7 7H NEDMAC,I6,34H   (NUMBER OF CROSS SECTION EDITS)/
     8 7H ITRANC,I6,45H   (0=NO TRANSPORT CORRECTION/1=APOLLO TYPE/2,
     9 43H=RECOVER FROM LIBRARY/4=LEAKAGE CORRECTION)/
     1 7H NLG   ,I6,39H   (NUMBER OF DELAYED PRECURSOR GROUPS)/
     2 7H ILEAK ,I6,40H   (1=DIFF AVAILABLE; 2=DIFFX AVAILABLE))
  300 FORMAT(/8H OPTIONS/8H -------/
     1 7H IMPX  ,I6,30H   (0=NO PRINT/1=SHORT/2=MORE)/
     2 7H MAXMIX,I6,31H   (MAXIMUM NUMBER OF MIXTURES)/
     3 7H NBISO ,I6,36H   (NUMBER OF ISOTOPES OR MATERIALS)/
     4 7H NGRP  ,I6,28H   (NUMBER OF ENERGY GROUPS)/
     5 7H NL    ,I6,30H   (NUMBER OF LEGENDRE ORDERS)/
     6 7H ITRANC,I6,45H   (0=NO TRANSPORT CORRECTION/1=APOLLO TYPE/2,
     7 57H=RECOVER FROM LIBRARY/3=WIMS-D TYPE/4=LEAKAGE CORRECTION)/
     8 7H IPROB ,I6,23H   (0=DIRECT/1=ADJOINT)/
     9 7H ITIME ,I6,28H   (1=STEADY-STATE/2=PROMPT)/
     1 7H NLIB  ,I6,32H   (NUMBER OF SETS OF LIBRARIES)/
     2 7H NGF   ,I6,48H   (NUMBER OF FAST GROUP WITHOUT SELF-SHIELDING)/
     3 7H IGRMAX,I6,41H   (LAST GROUP INDEX WITH SELF-SHIELDING)/
     4 7H NDEPL ,I6,33H   (NUMBER OF DEPLETING ISOTOPES)/
     5 7H NCOMB ,I6,33H   (NUMBER OF DEPLETING MIXTURES)/
     6 7H NEDMAC,I6,34H   (NUMBER OF CROSS SECTION EDITS)/
     7 7H NBMIX ,I6,23H   (NUMBER OF MIXTURES)/
     8 7H NRES  ,I6,40H   (NUMBER OF SETS OF RESONANT MIXTURES)/
     9 7H IPROC ,I6,48H   (-1=SKIP LIBRARY PROCESSING/0=DILUTION INTERP,
     1 48HOLATION/1=USE PHYSICAL TABLES/2=BUILD A DRAGLIB/,
     2 55H3=COMPUTE CALENDF TABLES/4=COMPUTE SLOWING-DOWN TABLES)/
     3 7H IMAC  ,I6,45H   (0=DO NOT/1=DO BUILD AN EMBEDDED MACROLIB)/
     4 7H NDEL  ,I6,31H   (NUMBER OF PRECURSOR GROUPS)/
     5 7H NFISS ,I6,31H   (NUMBER OF FISSILE ISOTOPES)/
     6 7H ISOADD,I6,37H   (0=COMPLETE BURNUP CHAIN/1=DO NOT)/
     7 7H MAXISM,I6,40H   (MAX. NUMBER OF ISOTOPES PER MIXTURE)/
     8 7H IPRECI,I6,34H   (CALENDF ACCURACY FLAG:1/2/3/4))
  310 FORMAT(/32H NCR: INTERPOLATING MULTICOMPO ',A12,13H' FROM DIRECT,
     1 5HORY ',A12,2H'.)
      END
