*DECK D2PXS
      SUBROUTINE D2PXS (IPDAT,IPMIC,IPSAP,STAVEC,IPRINT)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Recover cross sections from a microlib object and write cross
* sections for one branch at a fixed burnup point in the INFO data
* block.
*
*Author(s): J. Taforeau
*
*parameters: input
* IPDAT   address of info data block
* IPSAP   address of the saphyb object
* IPMIC   address of the microlib object
* STAVEC  various parameters associated with the IPDAT structure
* IPRINT  control the printing on screen
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      TYPE(C_PTR) IPDAT,IPMIC,IPSAP
      INTEGER STAVEC(40),IPRINT
*----
*  LOCAL VARIABLES
*----
      ! INDEX OF CURRENT VALUE FOR EACH STATE VARIABLES
      PARAMETER(NSTATE=40)
      INTEGER STAIDX (STAVEC(2)),ISTATE(NSTATE)
      INTEGER DIMSAP(50)
      INTEGER ITBRA,NSF
      INTEGER NREA,NISO,NMIL,NBISO,NANI,NFISS,NADD,NBMIX,ITR
      INTEGER NMAC,NVP,NPAR,NDEL,ISPH
      ! INDICATES THE END OF A BRANCH CALCULATION (REW=1), AND A
      ! DEFAULT MESHING (GRID)
      INTEGER REW,GRID
      ! NUMBER OF STATES VARIABLES
      INTEGER NVAR
      ! NUMBER OF BURNUP POINTS
      INTEGER NBU,NGP
      INTEGER :: NADF = 0
      REAL    STATE(STAVEC(2)),BURN(STAVEC(4))
      ! DATSRC BLOCK OF INFO/GENPMAXS DIRECTORY
      REAL DATSRC(5)
      ! STATE VARIABLE NAMES
      CHARACTER(len=4) STAVAR(STAVEC(2)),JOBOPT(14)
      CHARACTER*4 BRANCH
      CHARACTER*3 ADF_T
      LOGICAL LABS(3),SCAT
      LOGICAL :: LADF = .FALSE.
      LOGICAL :: LXES = .FALSE.
      LOGICAL :: LTH  = .FALSE.

      ! INITIALIZATION OF PARAMETERS
      NVAR=STAVEC(2)
      NBU=STAVEC(4)
      GRID=STAVEC(5)
      NGP=STAVEC(1)
      NSF=STAVEC(11)

      ! RECOVER INFORMATION FROM INFO date block

      CALL LCMSIX(IPDAT,' ',0)
      CALL LCMSIX(IPDAT,'GENPMAXS_INP',1)
      CALL LCMGET (IPDAT,'DAT_SRC',DATSRC)
      CALL LCMGTC(IPDAT,'JOB_OPT',4,14,JOBOPT)

      CALL LCMSIX(IPDAT,' ',0)
      CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)

      IF(JOBOPT(1)=='T') THEN
         CALL LCMGTC(IPDAT,'ADF',3,1,ADF_T)
         LADF = .TRUE.
         IF((ADF_T.EQ.'SEL').OR.(ADF_T.EQ.'GET')) STAVEC(13)=NSF
         IF(ADF_T.EQ. 'DRA')THEN
          CALL LCMSIX(IPMIC,' ',0)
          CALL LCMSIX(IPMIC,'MACROLIB',1)
          CALL LCMSIX(IPMIC,'ADF',1)
          CALL LCMGET(IPMIC,'NTYPE',STAVEC(13))
         ENDIF
         NADF=STAVEC(13)
      ENDIF

      IF(JOBOPT(2)=='T') LXES = .TRUE.
      IF((JOBOPT(5)=='T').OR.(JOBOPT(7)=='T').OR.
     >   (JOBOPT(9)=='T').OR.(JOBOPT(13)=='T')) THEN
        LTH =.TRUE.
      ENDIF

      IF(DATSRC(3).NE.0.0) THEN
        CALL LCMGET(IPDAT,'LABS',LABS)
        CALL LCMGET(IPDAT,'SCAT',SCAT)
      ENDIF

      CALL LCMGTC(IPDAT,'STATE_VAR',4,NVAR,STAVAR)
      CALL LCMGET(IPDAT,'BURN',BURN)
      CALL LCMSIX(IPDAT,' ',0)
      CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
      CALL LCMGET(IPDAT,'REWIND',REW)
      CALL LCMGTC(IPDAT,'BRANCH',4,1,BRANCH)
      CALL LCMGET(IPDAT,'BRANCH_IT',ITBRA)

      CALL LCMGET(IPDAT,'STATE_INDEX',STAIDX)
      CALL LCMGET(IPDAT,'STATE',STATE)
      CALL LCMSIX(IPMIC,' ',0)
      CALL LCMGET(IPMIC,'STATE-VECTOR',ISTATE)

      NBISO=ISTATE(2)         ! NUMBER OF ISOTOPES
      NDEL=ISTATE(19)         ! NUMBER OF DELAYED NEUTRON GROUPS

      IF(NDEL.NE.STAVEC(7)) THEN
         WRITE(6,*) "@D2PXS: ERROR IN NUMBER OF DELAYED NEUTRON GROUPS"
         WRITE(6,*) "THE NUMBER OF DELAYED NEUTRON GROUPS IN SAP (",
     1   STAVEC(7),") IF DIFFERENT FROM MICROLIB (",NDEL,")"
         CALL XABORT('@D2PXS: DELAYED NEUTRON DATA ERROR')
      ENDIF

      CALL XDISET(ISTATE,NSTATE,0)
      CALL LCMSIX(IPMIC,' ',0)
      CALL LCMSIX(IPMIC,'MACROLIB',1)
      CALL LCMGET(IPMIC,'STATE-VECTOR',ISTATE)

      NBMIX=ISTATE(2)          ! NUMBER OF MIXTURESS
      NANI=ISTATE(3)           ! SCATTERING ANISOTROPY
      NADD=ISTATE(5)           ! NUMBER OF ADDITIONAL CROSS SECTIONS
      NFISS=ISTATE(4)          ! NUMBER OF FISSILE ISOTOPES
      ITR=ISTATE(6)            ! TRANSPORT CORRECTION OTPION
      ISPH=ISTATE(14)

      IF(IPRINT > 0)  THEN
         WRITE(6,*)
         WRITE(6,*) "******     BRANCH CHARACTERISTICS     ******"
         WRITE(6,*) "BRANCH TYPE         :",BRANCH
         WRITE(6,*) "BRANCH INDEX        :",ITBRA
         WRITE(6,*) "STATE VARIABLE NAME :",STAVAR
         WRITE(6,*) "BRANCH STATE VALUES :",STATE
      ENDIF

      IF(DATSRC(3)==0.0) THEN
        ! CASE FOR REFLECTOR CROSS SECTIONS
        CALL D2PRFL(  IPDAT, IPMIC , IPRINT,    NBU,   NGP,   NBMIX,
     >                NANI,   NVAR,  STAIDX)
      ELSE IF(DATSRC(3) == 1.0) THEN
        ! CASE FOR FUEL CROSS SECTIONS
        CALL LCMSIX(IPSAP,' ',0)
        CALL XDISET(DIMSAP,50,0)
        CALL LCMGET(IPSAP,'DIMSAP',DIMSAP)  ! recover DIMSAP info
        IF(STAVEC(1).NE.ISTATE(1)) THEN
          CALL XABORT("@D2PBRA: INCOHERENT NUMBER OF ENERGY GROUPS ")
        ENDIF
        NREA=DIMSAP(4)       ! NUMBER OF REACTIONS
        NISO=DIMSAP(5)       ! NUMBER OF PARTICULARIZED ISOTOPES
        NMAC=DIMSAP(6)       ! NUMBER OF MACROSCOPIC SETS
        NMIL=DIMSAP(7)       ! NUMBER OF MIXTURES
        NVP=DIMSAP(17)       ! NUMBER OF NODE IN THE TREE OF PARAMETERS
        NPAR=DIMSAP(8)       ! NUMBER OF STATE VARIABLE IN SAPHYB
                             ! (INCLUDING FLUE AND TIME)

        IF(NMIL.NE.NBMIX) THEN
         CALL XABORT("@D2PBRA: DIFFERENT NUMBER OF MIX ")
         ENDIF

        ! RECOVER MACROLIB CROSS SECTIONS FROM SAPHYB
        CALL D2PMAC(     IPDAT, IPMIC , IPRINT,    NBU,   NGP,   NBMIX,
     >                    NADD,   NANI,  NVAR,  STAIDX,  LADF, NADF   )

        IF(LXES) THEN
          ! RECOVER MICROSCOPIC CROSS SECTIONS FROM SPAHYB
          CALL D2PMIC  (  IPDAT, IPMIC , IPRINT,    NGP,  NBMIX, NBISO,
     >                 NVAR, STAIDX                           )
        ENDIF

        IF(GRID<2) THEN
          ! RECOVER THE DIVERS DIRECTORY OF SAPHYB
          CALL D2PDIV(    IPDAT, IPSAP , IPRINT,    NGP,   NBU,    NVAR,
     >                     GRID,    NPAR,   NREA,  NISO,    NMAC,  NMIL,
     >                     NANI, STAIDX,  STATE,STAVAR,     NSF,   LABS,
     >                     SCAT,   LADF                                )
        ENDIF
        IF(LTH) THEN
          ! RECOVER THE T/H INVARIANT BLOCK (OPTIONAL IN PMAXS FILES)
          CALL D2PTH(    IPDAT, IPMIC , IPRINT,    NBU,   NGP,    NBMIX,
     >                    NFISS,  NDEL,   NVAR, STAIDX, JOBOPT         )
        ENDIF
      ENDIF

      IF(REW.EQ.NBU) THEN
        ! REINITIALIZATION OF INDEX
        STAIDX(NVAR)= 1
        REW = 1
        STATE(NVAR)=BURN(1)
      ELSE
        !  UPDATE THE INDEX FOR THE CALCULATION OF THE NEXT BRANCH
        REW=0
        STAIDX(NVAR)= STAIDX(NVAR)+1
        REW = STAIDX(NVAR)
        STATE(NVAR)=BURN(STAIDX(NVAR))
      ENDIF

      ! STORE NEW VALUES OF BRANCH CALCULATION
      CALL LCMSIX(IPDAT,' ',0)
      CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
      CALL LCMPUT(IPDAT,'REWIND',1,1,REW)
      CALL LCMPUT(IPDAT,'STATE',NVAR,2,STATE)
      CALL LCMPUT(IPDAT,'STATE_INDEX',NVAR,1,STAIDX)
      END
