*DECK SPHEMB
      SUBROUTINE SPHEMB(IPLIB,IPCPO,NGRP,NMIX,MIXUPD)
*
*-----------------------------------------------------------------------
*
*Purpose:
*  build embedded macrolib and recover depletion data from the
*  multicompo.
*
*Copyright:
* Copyright (C) 2008 Ecole Polytechnique de Montreal
*
*Author(s): A. Hebert, R. Chambon
*
*Parameters: input/output
* IPLIB   address of the microlib LCM object.
* IPCPO   address of the multicompo object.
* NGRP    number of energy groups.
* NMIX    maximum number of material mixtures in the microlib.
* MIXUPD  tag for mixture which will be updated
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      TYPE(C_PTR) IPLIB,IPCPO
      INTEGER NGRP,NMIX
      INTEGER MIXUPD(NMIX)
*----
*  LOCAL VARIABLES
*----
      PARAMETER (NSTATE=40,IOUT=6)
      CHARACTER HSMG*131,TEXT12*12
      INTEGER ISTATE(NSTATE),IST1(NSTATE),IST2(NSTATE)
      REAL TMPDAY(3)
      LOGICAL LWT0,LWT1
      TYPE(C_PTR) JPLIB,KPLIB
      LOGICAL, ALLOCATABLE, DIMENSION(:) :: MASK,MASKL
      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: FLUX
      INTEGER, POINTER, DIMENSION(:) :: ISONA,ISOMI
      REAL, POINTER, DIMENSION(:) :: DENIS,NWT,VOL
      TYPE(C_PTR) ISONA_PTR,ISOMI_PTR,DENIS_PTR,NWT_PTR,VOL_PTR
*----
*  SCRATCH STORAGE ALLOCATION
*----
      ALLOCATE(FLUX(NMIX,NGRP,2))
*----
*  RECOVER THE DEPLETION CHAIN
*----
      CALL LCMLEN(IPLIB,'DEPL-CHAIN',ILENG1,ITYLCM)
      CALL LCMLEN(IPCPO,'DEPL-CHAIN',ILENG2,ITYLCM)
      IF((ILENG1.NE.0).AND.(ILENG2.NE.0)) THEN
        CALL LCMSIX(IPCPO,'DEPL-CHAIN',1)
        CALL LCMGET(IPCPO,'STATE-VECTOR',IST1)
        CALL LCMSIX(IPCPO,' ',2)
        CALL LCMSIX(IPLIB,'DEPL-CHAIN',1)
        CALL LCMGET(IPLIB,'STATE-VECTOR',IST2)
        CALL LCMSIX(IPLIB,' ',2)
        DO 100 I=1,NSTATE
        IF(IST1(I).NE.IST2(I)) THEN
          WRITE(HSMG,'(40HSPHEMB: INVALID STATE-VECTOR COMPONENT (,I2,
     1    36H) FOR DEPL-CHAIN DATA IN MULTICOMPO ,1H.)') I
          CALL XABORT(HSMG)
        ENDIF
  100   CONTINUE
      ELSE IF((ILENG1.EQ.0).AND.(ILENG2.NE.0)) THEN
        CALL LCMSIX(IPCPO,'DEPL-CHAIN',1)
        CALL LCMSIX(IPLIB,'DEPL-CHAIN',1)
        CALL LCMEQU(IPCPO,IPLIB)
        CALL LCMSIX(IPLIB,' ',2)
        CALL LCMSIX(IPCPO,' ',2)
      ENDIF
*----
*  COMPUTE THE MACROSCOPIC X-SECTIONS
*----
      CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
      MAXMIX=ISTATE(1)
      IF(MAXMIX.NE.NMIX) CALL XABORT('SPHEMB: INVALID NMIX.')
      NBISO=ISTATE(2)
      ALLOCATE(MASK(MAXMIX),MASKL(NGRP))
      CALL LCMGPD(IPLIB,'ISOTOPESUSED',ISONA_PTR)
      CALL LCMGPD(IPLIB,'ISOTOPESMIX',ISOMI_PTR)
      CALL LCMGPD(IPLIB,'ISOTOPESDENS',DENIS_PTR)
      CALL C_F_POINTER(ISONA_PTR,ISONA,(/ NBISO /))
      CALL C_F_POINTER(ISOMI_PTR,ISOMI,(/ NBISO /))
      CALL C_F_POINTER(DENIS_PTR,DENIS,(/ NBISO /))
      CALL XDLSET(MASK,MAXMIX,.FALSE.)
      CALL XDLSET(MASKL,NGRP,.TRUE.)
      DO 110 ISOT=1,NBISO
        IBM=ISOMI(ISOT)
        IF(IBM.GT.0) THEN
          IF(MIXUPD(IBM).NE.0) MASK(IBM)=.TRUE.
        ENDIF
  110 CONTINUE
      ITSTMP=0
      TMPDAY(1)=0.0
      TMPDAY(2)=0.0
      TMPDAY(3)=0.0
      CALL LIBMIX(IPLIB,MAXMIX,NGRP,NBISO,ISONA,ISOMI,DENIS,MASK,MASKL,
     1 ITSTMP,TMPDAY)
      DEALLOCATE(MASKL,MASK)
*----
*  RECOVER THE INTEGRATED FLUX
*----
      CALL LCMGPD(IPLIB,'MIXTURESVOL',VOL_PTR)
      CALL C_F_POINTER(VOL_PTR,VOL,(/ NMIX /))
      LWT0=.FALSE.
      LWT1=.FALSE.
      CALL XDRSET(FLUX,NMIX*NGRP*2,0.0)
      DO 140 ISOT=1,NBISO
      IBM=ISOMI(ISOT)
      IF(IBM.GT.0) THEN
        WRITE(TEXT12,'(3A4)') (ISONA(3*(ISOT-1)+I0),I0=1,3)
        CALL LCMLEN(IPLIB,TEXT12,LENGTH,ITYLCM)
        IF(LENGTH.NE.0) THEN
          CALL LCMSIX(IPLIB,TEXT12,1)
          CALL LCMLEN(IPLIB,'NWT0',LENGTH,ITYLCM)
          IF(LENGTH.EQ.NGRP) THEN
            LWT0=.TRUE.
            CALL LCMGPD(IPLIB,'NWT0',NWT_PTR)
            CALL C_F_POINTER(NWT_PTR,NWT,(/ NGRP /))
            DO 120 IGR=1,NGRP
  120       FLUX(IBM,IGR,1)=NWT(IGR)*VOL(IBM)
          ENDIF
          CALL LCMLEN(IPLIB,'NWT1',LENGTH,ITYLCM)
          IF(LENGTH.EQ.NGRP) THEN
            LWT1=.TRUE.
            CALL LCMGPD(IPLIB,'NWT1',NWT_PTR)
            CALL C_F_POINTER(NWT_PTR,NWT,(/ NGRP /))
            DO 130 IGR=1,NGRP
  130       FLUX(IBM,IGR,2)=NWT(IGR)*VOL(IBM)
          ENDIF
          CALL LCMSIX(IPLIB,' ',2)
        ENDIF
      ENDIF
  140 CONTINUE
      CALL LCMSIX(IPLIB,'MACROLIB',1)
      CALL LCMPUT(IPLIB,'VOLUME',NMIX,2,VOL)
      JPLIB=LCMGID(IPLIB,'GROUP')
      DO 150 IGR=1,NGRP
      KPLIB=LCMGIL(JPLIB,IGR)
      IF(LWT0) CALL LCMPUT(KPLIB,'FLUX-INTG',NMIX,2,FLUX(1,IGR,1))
      IF(LWT1) CALL LCMPUT(KPLIB,'FLUX-INTG-P1',NMIX,2,FLUX(1,IGR,2))
  150 CONTINUE
      CALL LCMSIX(IPLIB,' ',2)
*----
*  SCRATCH STORAGE DEALLOCATION
*----
      DEALLOCATE(FLUX)
      RETURN
      END
