*DECK CREXSI
      SUBROUTINE CREXSI(IPMAP,NENTRY,HENTRY,KENTRY,NMIX,NGRP,NL,ILEAK,
     1 IMPX,TOTAL,ZNUG,SNUGF,CHI,OVERV,DIFFX,DIFFY,DIFFZ,H,IJJ,NJJ,SCAT)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Recover and/or interpolate l_compo data.
*
*Copyright:
* Copyright (C) 2007 Ecole Polytechnique de Montreal.
*
*Author(s): 
* A. Hebert, D. Sekki
*
*Parameters: input
* IPMAP   pointer to the fuel-map information.
* NENTRY  number of lcm or xsm objects used by the module.
* HENTRY  character*12 name of each lcm or xsm objects.
* KENTRY  pointers to the lcm or xsm objects.
* NMIX    maximum number of material mixtures.
* NGRP    number of energy groups.
* NL      number of legendre orders (=1 for isotropic scattering).
* ILEAK   diffusion coefficient flag (=1: isotropic; =2: anisotropic).
* IMPX    printing index (=0 for no print).
*
*Parameters: output
* TOTAL   total macroscopic x-sections.
* ZNUG    nu*fission macroscopic x-sections.
* SNUGF   fission macroscopic x-sections.
* CHI     fission spectrum.
* OVERV   reciprocal neutron velocities.
* DIFFX   x-directed diffusion coefficients.
* DIFFY   y-directed diffusion coefficients.
* DIFFZ   z-directed diffusion coefficients.
* H       h-factors (kappa*fission macroscopic x-sections).
* IJJ     profile storage index.
* NJJ     profile storage width.
* SCAT    scattering macroscopic x-sections.
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      INTEGER NENTRY,NMIX,NGRP,NL,ILEAK,IMPX,IJJ(NMIX,NL,NGRP),
     1 NJJ(NMIX,NL,NGRP)
      TYPE(C_PTR) IPMAP,KENTRY(NENTRY)
      CHARACTER HENTRY(NENTRY)*12
      REAL TOTAL(NMIX,NGRP),ZNUG(NMIX,NGRP),SNUGF(NMIX,NGRP),
     1     CHI(NMIX,NGRP),OVERV(NMIX,NGRP),DIFFX(NMIX,NGRP),
     2     DIFFY(NMIX,NGRP),DIFFZ(NMIX,NGRP),H(NMIX,NGRP),
     3     SCAT(NMIX,NL,NGRP,NGRP)
*----
*  LOCAL VARIABLES
*----
      TYPE(C_PTR) IPCPO,JPCPO,JPMAP,KPMAP
      PARAMETER(NSTATE=40,IOUT=6)
      CHARACTER TEXT*12,NAMDIR*12,HCOMPO*12,HSMG*131
      INTEGER IPAR(NSTATE),IDATA(NSTATE)
      LOGICAL DERIV,UPS,LTAB
      DOUBLE PRECISION DFLOT
      REAL, ALLOCATABLE, DIMENSION(:) :: YTOTAL,YZNUG,YNUGF,YCHI,YOVERV,
     1 YDIFX,YDIFY,YDIFZ,YH,YSCAT,YFLUX
      INTEGER, ALLOCATABLE, DIMENSION(:) :: HISO,ITY,FMIX
      REAL, ALLOCATABLE, DIMENSION(:) :: CONC,BURNU,BRN0,BRN1
*
      IVARTY=0
      UPS=.FALSE.
      LTAB=.FALSE.
      DERIV=.FALSE.
      NFUEL=0
      MAXEN=NENTRY
      IF(C_ASSOCIATED(IPMAP))THEN
        CALL LCMGET(IPMAP,'STATE-VECTOR',IDATA)
        IF(IDATA(4).NE.NGRP)CALL XABORT('@CREXSI: DIFFERENT NUM'
     1   //'BER OF ENERGY GROUPS IN COMPO AND FUEL MAP.')
        NB=IDATA(1)
        NCH=IDATA(2)
        NFUEL=IDATA(7)
        MAXEN=MAXEN-1
        LTAB=.TRUE.
      ENDIF
*----
*  READ INTERPOLATION OPTION
*----
      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
      DO 200 IEN=2,MAXEN
*     KEYWORD COMPO OR TABLE
      IF(TEXT.EQ.'COMPO')THEN
        IF(C_ASSOCIATED(IPMAP))CALL XABORT('@CREXSI: ONLY USE '
     1   //'OF EITHER COMPO OR TABLE OPTION. BOTH OPTIONS ARE '
     2   //'NOT ALLOWED.')
      ELSEIF(TEXT.EQ.'TABLE')THEN
        IF(.NOT.C_ASSOCIATED(IPMAP))CALL XABORT('@CREXSI: MISS'
     1   //'ING FUEL MAP.')
      ELSE
        CALL XABORT('@CREXSI: KEYWORD COMPO OR TABLE EXPECTED.')
      ENDIF
*     COMPO NAME
      CALL REDGET(ITYP,NITMA,FLOT,HCOMPO,DFLOT)
      IF(ITYP.NE.3)CALL XABORT('@CREXSI: COMPO NAME EXPECTED.')
      DO JEN=2,MAXEN
        IF(HCOMPO.EQ.HENTRY(JEN))THEN
          IPCPO=KENTRY(JEN)
          IF(IMPX.GT.1)CALL LCMLIB(IPCPO)
          GOTO 10
        ENDIF
      ENDDO
      WRITE(HSMG,'(44HCREXSI: UNABLE TO FIND THE COMPO WITH NAME '',
     1      A12,2H''.)') TEXT
      CALL XABORT(HSMG)
*----
*  READ MIX INFO
*----
   10 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
      IF(TEXT.NE.'MIX')CALL XABORT('@CREXSI: KEYWORD MIX EXPECTED.')
      CALL LCMGET(IPCPO,'STATE-VECTOR',IPAR)
      NGRP1=IPAR(2)
      NL1=IPAR(4)
      NISO=IPAR(3)
      IF(NGRP1.NE.NGRP)THEN
        WRITE(HSMG,'(43HCREXSI: INCONSISTENT NB OF GROUPS. IN MACRO,
     1        5HLIB =,I5,11H IN COMPO =,I5)') NGRP,NGRP1
        CALL XABORT(HSMG)
      ENDIF
      IF(NL1.LT.NL)THEN
        WRITE(HSMG,'(43HCREXSI: INCONSISTENT NB OF LEGENDRE ORDERS.,
     1        14H IN MACROLIB =,I5,11H IN COMPO =,I5)') NL,NL1
        CALL XABORT(HSMG)
      ENDIF
   20 ALLOCATE(HISO(3*NISO),ITY(NISO),CONC(NISO))
      CALL CREXSR(IPCPO,LTAB,HCOMPO,NMIX,IMPX,NISO,IBM,DERIV,UPS,
     1            NAMDIR,NISO1,HISO,ITY,CONC,NBURN,KBURN,IVARTY,
     2            IBTYP,BURN0,BURN1)
      JPCPO=LCMGID(IPCPO,NAMDIR)
*----
*  TABLE-OPTION INTERPOLATION
*----
      IF(LTAB)THEN
*       CHECK FUEL MIXTURE
        JPMAP=LCMGID(IPMAP,'FUEL')
        DO 30 IFUEL=1,NFUEL
        KPMAP=LCMGIL(JPMAP,IFUEL)
        CALL LCMGET(KPMAP,'MIX',IMIX)
        IF(IMIX.EQ.IBM)GOTO 40
        CALL LCMLEN(KPMAP,'MIX-VOID',LENGT,ITYP)
        IF(LENGT.EQ.0)GOTO 30
        CALL LCMGET(KPMAP,'MIX-VOID',IMIX)
        IF(IMIX.EQ.IBM)GOTO 40
   30   CONTINUE
        WRITE(IOUT,*)'@CREXSI: UNABLE TO FIND FUEL MIXTURE ',IBM
        CALL XABORT('@CREXSI: WRONG MIXTURE NUMBER.')
*
   40   ALLOCATE(BURNU(NBURN),BRN0(NCH*NB),BRN1(NCH*NB),FMIX(NCH*NB))
        CALL CRERGR(JPCPO,IPMAP,NISO1,NGRP,NMIX,NL,IBM,IMPX,IBTYP,DERIV,
     1  UPS,NBURN,BURNU,ILEAK,TOTAL,ZNUG,SNUGF,CHI,OVERV,DIFFX,DIFFY,
     2  DIFFZ,H,SCAT,IJJ,NJJ,HISO,ITY,CONC,FMIX,BRN0,BRN1,NCH,NB,IVARTY)
        DEALLOCATE(FMIX,BRN1,BRN0,BURNU)
        DEALLOCATE(CONC,ITY,HISO)
*----
*  COMPO-OPTION INTERPOLATION
*----
      ELSE
        ALLOCATE(YTOTAL(NGRP),YZNUG(NGRP),YNUGF(NGRP),YCHI(NGRP),
     1  YOVERV(NGRP),YDIFX(NGRP),YDIFY(NGRP),YDIFZ(NGRP),YH(NGRP),
     2  YSCAT(NL*NGRP*NGRP),YFLUX(NGRP))
        CALL CREINT(JPCPO,NISO1,DERIV,NBURN,KBURN,BURN0,BURN1,NGRP,
     1  NL,IMPX,HISO,ITY,CONC,ILEAK,YTOTAL,YZNUG,YNUGF,YCHI,YOVERV,
     2  YDIFX,YDIFY,YDIFZ,YH,YSCAT,YFLUX,UPS)
*       DATA STORAGE.
        DO 112 JGR=1,NGRP
          TOTAL(IBM,JGR)=YTOTAL(JGR)
          ZNUG(IBM,JGR)=YZNUG(JGR)
          SNUGF(IBM,JGR)=YNUGF(JGR)
          CHI(IBM,JGR)=YCHI(JGR)
          OVERV(IBM,JGR)=YOVERV(JGR)
          DIFFX(IBM,JGR)=YDIFX(JGR)
          DIFFY(IBM,JGR)=YDIFY(JGR)
          DIFFZ(IBM,JGR)=YDIFZ(JGR)
          H(IBM,JGR)=YH(JGR)
          DO 111 IGR=1,NGRP
          DO 110 IL=1,NL
            SCAT(IBM,IL,IGR,JGR)=YSCAT(NL*((JGR-1)*NGRP+IGR-1)+IL)
  110     CONTINUE
  111     CONTINUE
  112   CONTINUE
        DEALLOCATE(YFLUX,YSCAT,YH,YDIFZ,YDIFY,YDIFX,YOVERV,YCHI,YNUGF,
     1  YZNUG,YTOTAL)
        DEALLOCATE(CONC,ITY,HISO)
*       JGR IS THE SECONDARY GROUP.
        DO 135 JGR=1,NGRP
        DO 130 IL=1,NL
        IGMIN=JGR
        IGMAX=JGR
        DO IGR=NGRP,1,-1
          IF(SCAT(IBM,IL,IGR,JGR).NE.0.)THEN
            IGMIN=MIN(IGMIN,IGR)
            IGMAX=MAX(IGMAX,IGR)
          ENDIF
        ENDDO
        IJJ(IBM,IL,JGR)=IGMAX
        NJJ(IBM,IL,JGR)=IGMAX-IGMIN+1
  130   CONTINUE
  135   CONTINUE
      ENDIF
      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
      IF(TEXT.EQ.'MIX')GOTO 20
  200 CONTINUE
      IF(TEXT.NE.';') CALL XABORT('@CREXSI: FINAL ; EXPECTED.')
      RETURN
      END
