*DECK SCR
      SUBROUTINE SCR(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
*
*-----------------------------------------------------------------------
*
*Purpose:
* recover and interpolate Microlib or Macrolib information from one or
* many Saphyb database objects.
*
*Copyright:
* Copyright (C) 2012 Ecole Polytechnique de Montreal
*
*Author(s): A. Hebert
*
*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_SAPHYB) Saphyb;
*         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,HEQUI*80
      LOGICAL LMACRO,LCUBIC,LRES
      DOUBLE PRECISION DFLOTT
      INTEGER ISTATE(NSTATE),DIMSAP(50)
      TYPE(C_PTR) IPMAP,IPSAP,IPLIB,IPLIB2
*----
*  ALLOCATABLE ARRAYS
*----
      INTEGER, ALLOCATABLE, DIMENSION(:) :: MIXC,NISO,LISO,HISO
      REAL, ALLOCATABLE, DIMENSION(:) :: CONC
      REAL, ALLOCATABLE, DIMENSION(:,:) :: TERP
*----
*  PARAMETER VALIDATION
*----
      IF(NENTRY.LE.1) CALL XABORT('SCR: MINIMUM OF 2 OBJECTS EXPECTED.')
      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('SCR: MACRO'
     1 //'LIB LCM OBJECT EXPECTED AT LHS.')
      IF((JENTRY(1).NE.0).AND.(JENTRY(1).NE.1)) CALL XABORT('SCR: MACRO'
     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 LCMGTC(IPLIB,'SIGNATURE',12,1,HSIGN)
        IF(HSIGN.NE.'L_LIBRARY') THEN
          TEXT12=HENTRY(1)
          CALL XABORT('SCR: 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('SCR: '
     1 //'LCM OBJECTS EXPECTED AT RHS.')
        IF(JENTRY(I).NE.2) CALL XABORT('SCR: LCM OBJECTS IN READ-ONLY '
     1 //'MODE EXPECTED AT RHS.')
        CALL LCMGTC(KENTRY(I),'SIGNATURE',12,1,HSIGN)
        IF(HSIGN.EQ.'L_LIBRARY') THEN
          IF(C_ASSOCIATED(IPLIB2)) CALL XABORT('SCR: 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('SCR: FUEL-MAP EXPECTED TO BE THE '
     1    //'LAST OBJECT.')
          IF(NENTRY.LT.3)CALL XABORT('SCR: MISSING SAPHYB OBJECT.')
          IPMAP=KENTRY(NENTRY)
          CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
          NMIX=ISTATE(9)
        ELSE IF(HSIGN.NE.'L_SAPHYB') THEN
          TEXT12=HENTRY(I)
          CALL XABORT('SCR: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
     1   '. L_SAPHYB EXPECTED.')
        ENDIF
   10 CONTINUE
*----
*  READ THE INPUT DATA
*----
      LMACRO=.TRUE.
      LCUBIC=.TRUE.
      LRES=.FALSE.
      B2=0.0
      ITER=-1
      IPSAP=C_NULL_PTR
      HEQUI=' '
      IMPX=1
   20 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
      IF(INDIC.NE.3) CALL XABORT('SCR: 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('SCR: 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('SCR: INTEGER DATA EXPECTED(2).')
        IF(NITMA.LT.NMIX) THEN
           WRITE(HSMG,'(20HSCR: NMIX MUST BE >=,I8)') NMIX
           CALL XABORT(HSMG)
        ENDIF
        NMIX=NITMA
      ELSE IF(TEXT12.EQ.'MACRO') THEN
        LMACRO=.TRUE.
        IF(IACCS.NE.0) CALL XABORT('SCR: LHS EXPECTED IN CREATION.')
      ELSE IF(TEXT12.EQ.'MICRO') THEN
        LMACRO=.FALSE.
      ELSE IF(TEXT12.EQ.'LINEAR') THEN
        LCUBIC=.FALSE.
      ELSE IF(TEXT12.EQ.'CUBIC') THEN
        LCUBIC=.TRUE.
      ELSE IF(TEXT12.EQ.'RES') THEN
        IF((IACCS.EQ.0).AND.(.NOT.C_ASSOCIATED(IPLIB2))) THEN
          CALL XABORT('SCR: RHS MICROLIB EXPECTED WITH RES OPTION.')
        ENDIF
        LRES=.TRUE.
      ELSE IF(TEXT12.EQ.'SAPHYB') THEN
        IF(NMIX.EQ.0) CALL XABORT('SCR: ZERO NUMBER OF MIXTURES.')
        IF(C_ASSOCIATED(IPMAP)) THEN
          WRITE(IOUT,'(/43H SCR: ***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('SCR: CHARACTER DATA EXPECTED(2).')
        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_SAPHYB') THEN
              IPSAP=KENTRY(I)
            ELSE
              CALL XABORT('SCR: WRONG SIGNATURE ('//TEXT12//').')
            ENDIF
            ITH=I
            GO TO 60
          ENDIF
   50   CONTINUE
        CALL XABORT('SCR: SAPHYB '//TEXT12//' NOT FOUND.')
   60   IF(IMPX.GT.0) THEN
          WRITE(IOUT,320) HENTRY(ITH)
          CALL SCRTOC(IPSAP)
        ENDIF
        CALL LCMGET(IPSAP,'DIMSAP',DIMSAP)
        IF(NGRP.EQ.0) THEN
          NGRP=DIMSAP(20)
        ELSE IF(NGRP.NE.DIMSAP(20)) THEN
          WRITE(HSMG,'(9H SCR: THE,I4,27H-TH SAPHYB HAS AN INVALID N,
     1    24HNMBER OF ENERGY GROUPS (,I4,3H VS,I5,1H.)') ITH,NGRP,
     2    DIMSAP(20)
          CALL XABORT(HSMG)
        ENDIF
        NMIL=DIMSAP(7)
        NCAL=DIMSAP(19)
        ALLOCATE(MIXC(NMIX),NISO(NMIX),LISO(NMIX),HISO(2*NMIX*MAXISD))
        ALLOCATE(TERP(NCAL,NMIX),CONC(NMIX*MAXISD))
*
        CALL SCRDRV(MAXISD,IPSAP,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('SCR: 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('SCR: 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('SCR: CHARACTER DATA EXPECTED(2).')
        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_SAPHYB') THEN
              IPSAP=KENTRY(I)
            ELSE
              CALL XABORT('SCR: WRONG SIGNATURE ('//TEXT12//').')
            ENDIF
            ITH=I
            GO TO 90
          ENDIF
   80   CONTINUE
        CALL XABORT('SCR: SAPHYB '//TEXT12//' NOT FOUND.')
   90   IF(IMPX.GT.0) THEN
          WRITE(IOUT,320) HENTRY(ITH)
          CALL SCRTOC(IPSAP)
        ENDIF
        CALL LCMGET(IPSAP,'DIMSAP',DIMSAP)
        IF(NGRP.NE.DIMSAP(20)) THEN
          WRITE(HSMG,'(9H SCR: THE,I4,27H-TH SAPHYB HAS AN INVALID N,
     1    24HNMBER OF ENERGY GROUPS (,I4,3H VS,I5,2H).)') ITH,NGRP,
     2    DIMSAP(20)
          CALL XABORT(HSMG)
        ENDIF
        NMIL=DIMSAP(7)
        NCAL=DIMSAP(19)
        ALLOCATE(MIXC(NMIX),NISO(NMIX),LISO(NMIX),HISO(2*NMIX*MAXISD))
        ALLOCATE(TERP(NCAL,NMIX),CONC(NMIX*MAXISD))
*
        CALL SCRRGR(MAXISD,IPSAP,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.'EQUI') THEN
         CALL REDGET(INDIC,NITMA,FLOTT,HEQUI,DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('SCR: CHARACTER DATA EXPEC'
     1   //'TED')
      ELSE IF(TEXT12.EQ.'LEAK') THEN
        CALL REDGET(INDIC,NITMA,B2,TEXT12,DFLOTT)
        IF(INDIC.NE.2) CALL XABORT('SCR: REAL DATA EXPECTED.')
      ELSE
        CALL XABORT('SCR: '//TEXT12//' IS AN INVALID KEYWORD.')
      ENDIF
      GO TO 20
*----
*  BUILD THE INTERPOLATED MACROLIB
*----
 100  IF(LMACRO.AND.(MAXNIS.EQ.0)) THEN
*       build a macrolib
        MAX1D=40
        MAX2D=20
        MAXNL=5
        MAXNFI=50
        CALL SCRSAP(IPLIB,IPSAP,IACCS,NMIL,NMIX,NGRP,IMPX,HEQUI,
     1  NCAL,MIXC,TERP,B2)
      ELSE
*       build a microlib
        IF(LMACRO)THEN
          CALL LCMOP(IPLIB,'*TEMPORARY*',0,1,0)
          IACCS=0
        ENDIF
        IF(IACCS.EQ.0)THEN
          MAXISO=MAXISD*NMIX
        ELSE
          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
          MAXISO=MAX(MAXISD*NMIX,ISTATE(2))
        ENDIF
        CALL SCRLIB(MAXNIS,MAXISO,IPLIB,IPSAP,IACCS,NMIX,NGRP,IMPX,
     1  HEQUI,NCAL,TERP,NISO,LISO,HISO,CONC,MIXC,LRES,B2)
        IF(LMACRO) THEN
          CALL LCMVAL(IPLIB,' ')
          CALL LCMSIX(IPLIB,'MACROLIB',1)
          CALL LCMEQU(IPLIB,KENTRY(1))
          CALL LCMSIX(IPLIB,' ',2)
          CALL LCMCL(IPLIB,2)
        ENDIF
      ENDIF
      DEALLOCATE(LISO,NISO,HISO,CONC,TERP,MIXC)
*----
*  PRINT THE STATE VECTOR
*----
      IF(IMPX.GT.0) THEN
        IF(LMACRO) THEN
          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
          WRITE(IOUT,290) IMPX,(ISTATE(I),I=1,7),ISTATE(9)
        ELSE
          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
          WRITE(IOUT,300) IMPX,(ISTATE(I),I=1,15),(ISTATE(I),I=17,23)
        ENDIF
      ENDIF
*----
*  CONTINUE DATA PROCESSING
*----
      IF(ITER.EQ.0) THEN
        GO TO 200
      ELSE IF(ITER.EQ.1) THEN
        TEXT12='SAPHYB'
        GO TO 30
      ELSE IF(ITER.EQ.2) THEN
        TEXT12='TABLE'
        GO TO 30
      ENDIF
*----
*  LEAVE SCR:
*----
  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))
  320 FORMAT(/28H SCR: INTERPOLATING SAPHYB ',A12,2H'.)
      END
