*DECK D2PDRV
      SUBROUTINE D2PDRV( NENTRY, HENTRY, IENTRY, JENTRY, KENTRY,    NGP,
     >                     NCRD,    MIX,   FA_K,   IUPS, USRSTA,  PHASE,
     >                   IPRINT, STAVEC, CRDINF, USRVAL,   VERS,   SFAC,
     >                     BFAC,   FC1,    FC2,    FC3,     FC4,    XSC,
     >                  USRVAPK,    ADF,    DER, CRDMOD, JOBOPT, USRPAR,
     >                     MESH,   PKEY, FILNAM,   ISOT, JOBTIT,    COM,
     >                      SAP,    MIC,    EXC,   SCAT,   LADD,   LNEW)
*
*-----------------------------------------------------------------------
*
*Purpose:
* store an isotopic data recovered from a Saphyb into a Microlib.
*
*Copyright:
* Copyright (C) 2015 IRSN
*
*Author(s): J. Taforeau
*
*parameters: input/output
* NENTRY  number of LCM objects or files used by the operator.
* HENTRY  name of each LCM object or file:
*         HENTRY(1): modification type(L_MAP);
*         HENTRY(2): read-only type(L_POWER).
* 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.
*
* NGP     number of energy groups recovered from D2P input user
* NCRD    number of control rod composition recovered from D2P input
*         user
* MIX     index of mixture on which XS are to be extracted (only for
*         reflector cases)
* FA_K    assembly type
*         =0 reflector
*         =1 assembly
* IUPS    treatment for upscattering
*         =0 keep up scatter XS
*         =1 remove up scatter XS, modify  down scatter with DRAGON
*         spectrum (not available in this version)
*         =2 remove up scatter XS, modify  down scatter with infinite
*         medium spectrum
* USRSTA  state variable names recovered from GLOBAL record in D2P:
* USRVAL  number of value for state variables  recovered from GLOBAL
*         record in D2P:
* PHASE   the current phase of D2P:
* IPRINT  control the printing on screen
* STAVEC  various parameters associated with the IPDAT structure
* CRDINF  meaning of control rods in the IPSAP object
* VERS    version of PARCS to be used
* SFAC    the scattering cross section factor
* BFAC    the multiplier for betas
* FC1     FILE_CONT_1 recovered from D2P: input
* FC2     FILE_CONT_2 recovered from D2P: input
* FC3     FILE_CONT_3 recovered from D2P: input
* FC4     FILE_CONT_4 recovered from D2P: input
* XSC     XS_CONT     recovered from D2P: input
* USRVAPK value of state prameter set by the user and recoverd from
*         USER ADD option in D2P:
* ADF     type of ADF to be selected
* DER     partials derivative (T) or row cross section (F) to be stored
*         in PMAXS
* CRDMOD  definition of control rods (user defined or default)
* JOBOPT  flag for JOB_OPT record in IPINP object
* USRPAR  name of state variables (sapnam) in IPSAP associated to
*         DMOD TCOM etc. recovered from PKEY card in D2P:
* MESH    type of meshing to be applied for the branching calculation
* PKEY    name of state variable (refnam) recovered from PKEY card in
*         D2P:
* FILNAM  name of IPINP
* ISOT    name of isotopes in IPSAP for xenon samarium and spomethium
* JOBTIT  title of in header of PMAXS file
* COM     comment to be printed in PMAXS file
* SAP     flag to indicate that absorption cross section must be
*         directly recovered from IPSAP
* MIC     flag to indicate that absorption cross section must be
*         directly recovered from IPMIC
* EXC     flag to indicate that excess cross section is to be extracted
*         from absoption xs (only if SAP)
* SCAT    flag to indicate that scattering cross section must be
*         directly reconstructed from IPSAP
* LADD    flag to indicate that new points must be added to the IPSAP
*         original meshing
* LNEW    flag to indicate that only new points must be used during the
*         branching calculation
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
      TYPE(C_PTR)  KENTRY(NENTRY)
      CHARACTER    HENTRY(NENTRY)*12
      INTEGER NGP,NCRD,MIX,FA_K,IUPS,USRSTA
      INTEGER PHASE,IPRINT
      INTEGER STAVEC(40),CRDINF(20),USRVAL(12)
      REAL VERS,SFAC,BFAC
      REAL FC1(5),FC2(8),FC3(7),FC4(3),XSC(3)
      REAL USRVAPK(12,10)
      CHARACTER*3 ADF
      CHARACTER*4 DER,CRDMOD,JOBOPT(14),USRPAR(12)*4
      CHARACTER*5 MESH
      CHARACTER*8 PKEY(6)
      CHARACTER*12 FILNAM,ISOT(3)
      CHARACTER*16 JOBTIT
      CHARACTER*40 COM
      LOGICAL SAP, MIC, EXC,SCAT,LADD,LNEW
*----
*  LOCAL VARIABLES
*----
      TYPE(C_PTR) IPSAP,IPDAT,IPMIC
      INTEGER IPHEL,IPINP
      INTEGER DEB
      CHARACTER TEXT12*12,HSIGN*12,HSMG*131
*
      IF (IPRINT.EQ.-1) IPRINT = 0
*----
*  PHASE 1 : SET HEADER OF GENPMAXS INPUT FILE (.inp) AND HELIOS LIKE FI
*----
      IF (PHASE.EQ.1) THEN
       IF(NENTRY.GT.4) CALL XABORT('@D2PDRV: 4 PARAMETERS EXPECTED.')
       IF((IENTRY(1).NE.4)) THEN
        WRITE(HSMG,'(12H@D2P: ENTRY ,A12,24H IS NOT OF SEQUENTIAL AS,
     >  9HNCII TYPE)') HENTRY(1)
        CALL XABORT(HSMG)
       ELSE IF(JENTRY(1).EQ.2) THEN
        WRITE(HSMG,'(12H@D2P: ENTRY ,A12,24H IS NOT IN CREATION OR I,
     >  19HN MODIFICATION MODE)')
     >  HENTRY(1)
        CALL XABORT(HSMG)
       ENDIF
       IF(IENTRY(3).NE.1) THEN
        WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,19H IS NOT OF LCM TYPE)')
     >  HENTRY(3)
        CALL XABORT(HSMG)
       ELSE IF(JENTRY(3).EQ.2) THEN
        WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,24H IS NOT IN CREATION OR I,
     >  19HN MODIFICATION MODE)')
     >  HENTRY(3)
        CALL XABORT(HSMG)
       ENDIF
       CALL LCMGTC(KENTRY(3),'SIGNATURE',12,1,HSIGN)
       IF(HSIGN.NE.'L_INFO') THEN
        TEXT12=HENTRY(3)
        CALL XABORT('@D2P: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
     1  '. L_INFO EXPECTED.')
       ENDIF
       IF(IENTRY(4).GT.2) THEN
        WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,19H IS NOT OF LCM TYPE)')
     >  HENTRY(2)
        CALL XABORT(HSMG)
       ELSE IF(JENTRY(2).NE.0) THEN
        WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,24H IS NOT IN CREATION OR I,
     >  19HN MODIFICATION MODE)')
     >  HENTRY(2)
        CALL XABORT(HSMG)
       ENDIF
       CALL LCMGTC(KENTRY(4),'SIGNATURE',12,1,HSIGN)
       IF((HSIGN.NE.'L_SAPHYB')) THEN
        IF(HSIGN.NE.'L_MULTICOMPO') THEN
         TEXT12=HENTRY(4)
         CALL XABORT('@D2PDRV: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
     1   '. L_SAPHYB OR L_MULTICOMPO EXPECTED.')
        ENDIF
       ENDIF
       IPHEL=FILUNIT(KENTRY(1))
       IPINP=FILUNIT(KENTRY(2)) ! input GENPMAXS file unit
       IPDAT=KENTRY(3) ! output INFO address
       IPSAP=KENTRY(4) ! input saphyb address
*
       STAVEC(8)=INT(FC1(1))
       STAVEC(9)=INT(FC1(2))
       STAVEC(10)=INT(FC1(3))
       STAVEC(11)=INT(XSC(1))
       STAVEC(12)=INT(XSC(2))
       IF (MESH.EQ.'GLOB'.OR.MESH.EQ.'ADD') THEN
        IF ((JOBOPT(1).EQ.'T').AND. (ADF .NE. 'DRA')) THEN
         CALL XABORT('@D2PDRV: ADF OF TYPE (SEL/GET) CANNOT BE EXTRACT'
     1   //'ED WITH USER DEFINED BRANCHING CALCULATION"')
        ENDIF
       ENDIF
       WRITE(6,*) "****************************************************"
       WRITE(6,*) "*        DRAG2PARCS INPUT DATA RECOVERED           *"
       WRITE(6,*) "****************************************************"
      IF(IPRINT > 0)  THEN
       WRITE(6,*) "****************************************************"
       WRITE(6,*) "* PHASE 1 : RECOVER DATA AND CREATE INPUT FILES    *"
       WRITE(6,*) "****************************************************"
       WRITE(6,*)
      ENDIF
*----
      CALL       D2PINP(  IPSAP, IPDAT ,  IPHEL, IPINP,  FILNAM, IPRINT,
     >                   STAVEC, CRDINF,   NCRD,   PKEY,  SFAC,    BFAC,
     >                     ISOT,   MESH, USRPAR, USRVAL, USRSTA,USRVAPK,
     >                      SAP,    MIC, EXC   ,   SCAT, ADF   ,    DEB,
     >                      COM,   FA_K,   IUPS,   LADD,   LNEW,    MIX,
     >                      FC1,    FC2,    FC3,    FC4,    XSC,    NGP,
     >                   JOBTIT, JOBOPT,    DER,   VERS                )
      IF(IPRINT > 0)  THEN
       WRITE(6,*) "****************************************************"
       WRITE(6,*) "*                END OF PHASE 1                    *"
       WRITE(6,*) "****************************************************"
       WRITE(6,*) "CRDMOD=",CRDMOD
      ENDIF
*----
*  PHASE 2 : BRANCHING CALCULATION
*----
      ELSE IF (PHASE.EQ.2) THEN
       IF(NENTRY.GT.5) CALL XABORT('@D2PDRV: 4 PARAMETERS EXPECTED.')
       IF(IENTRY(1).NE.4) THEN
        WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,24H IS NOT OF SEQUENTIAL AS,
     >  9HNCII TYPE)') HENTRY(1)
        CALL XABORT(HSMG)
       ELSE IF(JENTRY(1).EQ.2) THEN
        WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,24H IS NOT IN CREATION OR I,
     >  19HN MODIFICATION MODE)')
     >  HENTRY(1)
        CALL XABORT(HSMG)
       ENDIF
       IF((IENTRY(4).GT.2)) THEN
        WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,19H IS NOT OF XSM TYPE)')
     >  HENTRY(4)
        CALL XABORT(HSMG)
       ELSE IF(JENTRY(4).NE.2) THEN
        WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,24H IS NOT IN READ-ONLY MOD,
     >  1HE)')
     >  HENTRY(4)
        CALL XABORT(HSMG)
       ENDIF
       CALL LCMGTC(KENTRY(2),'SIGNATURE',12,1,HSIGN)
       IF(HSIGN.NE.'L_INFO') THEN
        TEXT12=HENTRY(2)
        CALL XABORT('@D2PDRV: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
     1  '. L_INFO EXPECTED.')
       ENDIF
       CALL LCMGTC(KENTRY(4),'SIGNATURE',12,1,HSIGN)
       IF((HSIGN.NE.'L_SAPHYB')) THEN
        IF(HSIGN.NE.'L_MULTICOMPO') THEN
         TEXT12=HENTRY(4)
         CALL XABORT('@D2PDRV: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
     1   '. L_SAPHYB OR L_MULTICOMPO EXPECTED.')
        ENDIF
       ENDIF

      IPINP=FILUNIT(KENTRY(1)) ! input GENPMAXS file unit
      IPDAT=KENTRY(2) ! input DATA vector address
      IPMIC=KENTRY(3) ! input Microlib vector address
      IPSAP=KENTRY(4) ! input SAPHYB OBJECT
      IF(IPRINT > 0)  THEN
       WRITE(6,*) "****************************************************"
       WRITE(6,*) "*     PHASE 2 : RECOVER cross sections OF BRANCH   *"
       WRITE(6,*) "****************************************************"
      ENDIF

      CALL LCMSIX(IPDAT,' ',0)
      CALL LCMGET(IPDAT,'STATE-VECTOR',STAVEC)

      CALL D2PXS(IPDAT,IPMIC,IPSAP,STAVEC,IPRINT)

      CALL LCMSIX(IPDAT,' ',0)
      CALL LCMPUT(IPDAT,'STATE-VECTOR',40,1,STAVEC)

      IF(IPRINT > 0)  THEN
       WRITE(6,*) "****************************************************"
       WRITE(6,*) "*                END OF PHASE 2                    *"
       WRITE(6,*) "****************************************************"
      ENDIF
*----
*  PHASE 3 : STORE BRANCHES IN HELIOS FILE
*----
      ELSE IF (PHASE.EQ.3) THEN
       IF(NENTRY.GT.4) CALL XABORT('@D2PDRV: 3 PARAMETERS EXPECTED.')
       IF((IENTRY(1).NE.4)) THEN
        WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,24H IS NOT OF SEQUENTIAL AS,
     >  9HNCII TYPE)') HENTRY(1)
        CALL XABORT(HSMG)
       ELSE IF(JENTRY(1).EQ.2) THEN
        WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,24H IS NOT IN CREATION OR I,
     >  19HN MODIFICATION MODE)')
     >  HENTRY(1)
        CALL XABORT(HSMG)
       ENDIF
       IF(IENTRY(2).NE.4) THEN
        WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,24H IS NOT OF SEQUENTIAL AS,
     >  9HNCII TYPE)') HENTRY(2)
        CALL XABORT(HSMG)
       ELSE IF(JENTRY(2).EQ.2) THEN
        WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,24H IS NOT IN CREATION OR I,
     >  19HN MODIFICATION MODE)')
     >  HENTRY(2)
        CALL XABORT(HSMG)
       ENDIF
       CALL LCMGTC(KENTRY(3),'SIGNATURE',12,1,HSIGN)
       IF(HSIGN.NE.'L_INFO') THEN
        TEXT12=HENTRY(2)
        CALL XABORT('@D2PDRV: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
     >  '. L_INFO EXPECTED.')
       ENDIF
       IPHEL=FILUNIT(KENTRY(1)) !  dragon file unit
       IPINP=FILUNIT(KENTRY(2)) !  GENPMAXS file unit
       IPDAT=KENTRY(3) !  DATA vector address
      IF(IPRINT > 0)  THEN
       WRITE(6,*) "****************************************************"
       WRITE(6,*) "*     PHASE 3 : STORE BRANCHES IN HELIOS FILE      *"
       WRITE(6,*) "****************************************************"
      ENDIF
       WRITE(6,*) "***** STORE CURRENT BRANCH IN HELIOS LIKE FILE *****"
       DEB=1
       CALL LCMSIX(IPDAT,' ',0)
       CALL LCMGET(IPDAT,"STATE-VECTOR",STAVEC)
       CALL D2PBRA( IPDAT,IPINP,IPHEL,STAVEC,JOBOPT,DEB,IPRINT)
      IF(IPRINT > 0)  THEN
       WRITE(6,*) "****************************************************"
       WRITE(6,*) "*                END OF PHASE 3                    *"
       WRITE(6,*) "****************************************************"
      ENDIF
      ENDIF
      END
