*DECK D2PSAP
      SUBROUTINE D2PSAP(  IPSAP,  IPDAT, STAVEC, CRDINF,   NCRD,  PKNAM,
     >                    ISOT ,   MESH, USRPAR, USRVAL, USRSTA,USRVAPK,
     >                    SAP  ,    MIC,    EXC,   SCAT,    ADF,  LADD ,
     >                    LNEW ,   LADF, IPRINT                        )
*
*-----------------------------------------------------------------------
*
*Purpose:
* recover the global stated variable data contained in the SAPHYB object
*
*Author(s): J. Taforeau
*
*parameters: input/output
* IPDAT   address of the INFO data block
* IPSAP   address of the saphyb object
* 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)
* USRSTA  state variable names recovered from GLOBAL record in D2P:
* USRVAL  number of value for state variables  recovered from GLOBAL
*         record in D2P:
* IPRINT  control the printing on screen
* STAVEC  various parameters associated with the IPDAT structure
* CRDINF  meaning of control rods in the IPSAP object
* 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
* 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
* PKNAM   name of state variable (refnam) recovered from PKEY card in
*         D2P:
* ISOT    name of isotopes in IPSAP for xenon samarium and spomethium
* 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
* LADF    Assembly Discontinuity Factors must be recovered
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      TYPE(C_PTR) IPSAP,IPDAT
      INTEGER NCRD,USRSTA
      INTEGER IPRINT
      INTEGER STAVEC(40),CRDINF(20),USRVAL(12)
      REAL USRVAPK(12,10)
      CHARACTER*3 ADF
      CHARACTER*4 USRPAR(12)*4
      CHARACTER*5 MESH
      CHARACTER*8 PKNAM(6)
      CHARACTER*12 ISOT(3)
      LOGICAL SAP, MIC, EXC,SCAT,LADD,LNEW,LADF
*----
*  LOCAL VARIABLES
*----
      TYPE(C_PTR)  IPROOT,IPTH,KPTH

      PARAMETER(NSTATE=40)
      INTEGER :: N_XS = 8
      INTEGER,DIMENSION(6)  :: ORDER_VAL = 0
      INTEGER DIMSAP(NSTATE)
      INTEGER NPAR,NCALS,NSVAR,NBREA,ITYLCM,VALTOT
      INTEGER NCRD_SAP
      INTEGER i, j, k, l , n, UV
      REAL FIRST_VAL,LAST_VAL,PITCH
      LOGICAL LABS(3)
      LOGICAL :: LBARR = .FALSE.
      LOGICAL :: LDMOD = .FALSE.
      LOGICAL :: LCBOR = .FALSE.
      LOGICAL :: LTCOM = .FALSE.
      LOGICAL :: LTMOD = .FALSE.
      LOGICAL :: LBURN = .FALSE.
      CHARACTER(LEN=4)   PKEY_BARR(6)

      INTEGER, ALLOCATABLE, DIMENSION(:) :: NVAL,RANK,RANK_INDEX
      CHARACTER(LEN=4), ALLOCATABLE, DIMENSION(:) :: PKEY,PKEY_TMP
      CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: PVALDIR, NOMREA
      REAL, ALLOCATABLE, DIMENSION(:) :: SV_VAL
      REAL, ALLOCATABLE, DIMENSION(:,:) :: VALPAR

      IPROOT=IPSAP
      LABS(1)=MIC
      LABS(2)=SAP
      LABS(3)=EXC
      CALL LCMSIX(IPDAT,' ',0)
      CALL LCMPUT(IPDAT,'BARR_INFO',NCRD,1,CRDINF)
      ! RECOVER DIMSAP INFORMATION FROM SAPHYB
      CALL XDISET(DIMSAP,NSTATE,0)
      CALL LCMGET(IPSAP,'DIMSAP',DIMSAP)

      NPAR =DIMSAP(8)
      NMIL =DIMSAP(7)
      NREA =DIMSAP(4)
      NISO =DIMSAP(5)
      NMAC =DIMSAP(6)
      ! INITIALIZATION OF PARAMETERS
      VALTOT = 0
      NSVAR = 0
      k = 1

      ! MEMORY ALLOCATION
      ALLOCATE (PKEY(NPAR))
      ALLOCATE (NVAL(NPAR))
      ALLOCATE (PVALDIR(NPAR))
      ALLOCATE (PKEY_TMP(NPAR))
      ALLOCATE (RANK(NPAR))
      ALLOCATE (RANK_INDEX(NPAR+1))
      CALL LCMSIX (IPSAP,' ',0)
      CALL LCMSIX (IPSAP,'paramarbre',1)
      CALL LCMGET (IPSAP,'NCALS',NCALS)
      CALL LCMSIX (IPSAP,' ',0)
      CALL LCMSIX (IPSAP,'contenu',1)
      CALL LCMLEN(IPSAP,'NOMREA',NBREA,ITYLCM)
      ALLOCATE (NOMREA(NBREA))
      CALL LCMGTC(IPSAP,'NOMREA',12,NBREA,NOMREA)
      CALL LCMSIX(IPSAP,' ',0)
      CALL LCMSIX(IPSAP,'paramdescrip',1)
      CALL LCMGET(IPSAP,'PARKEY',PKEY)
      CALL LCMGET(IPSAP,'NVALUE',NVAL)
      ALLOCATE(VALPAR(NPAR,100))
      CALL LCMSIX(IPSAP,' ',0)
      CALL LCMSIX(IPSAP,'paramvaleurs',1)
      ! LOOP OVER STATE VARIABLES OF SAPHYB
      ! CHECK OF EXISTENCE OF STATE PARAMETER

      DO i=1, NPAR
        IF(PKEY(i)==PKNAM(1)) THEN      ! BARR
          LBARR=.TRUE.
        ELSE IF(PKEY(i)==PKNAM(2)) THEN ! DMOD
          LDMOD=.TRUE.
        ELSE IF(PKEY(i)==PKNAM(4)) THEN ! TCOM
          LTCOM=.TRUE.
        ELSE IF(PKEY(i)==PKNAM(5)) THEN ! TMOD
          LTMOD=.TRUE.
        ELSE IF(PKEY(i)==PKNAM(3)) THEN ! CBOR
          LCBOR=.TRUE.
        ELSE IF(PKEY(i)==PKNAM(6)) THEN ! BURN
          LBURN =.TRUE.
        ENDIF
          RANK_INDEX(i)=0
      ENDDO
      RANK_INDEX(NPAR+1)=0

      ! DETERMINE ODER_VAL ARRAY
      IF(LBARR) THEN
        ORDER_VAL(1)=1
      ELSE
        NCRD_SAP=1
        IF(NCRD>1) THEN
          WRITE(6,*) "@D2PSAP:",
     1     " CONTROL ROD STATE VARIABLE IS MISSING IN SAPHYB"
          CALL XABORT("=> NUMBER OF CTRL ROD VALUE MUST BE SET TO 1")
        ELSE IF(CRDINF(1).NE. 1) THEN
          WRITE(6,*) "@D2PSAP:",
     1     " CONTROL ROD STATE VARIABLE IS MISSING IN SAPHYB"
          CALL XABORT("=> CTRL ROD UNRODDED INDEX MUST BE SET TO 1")
        ENDIF
      ENDIF
      IF(LDMOD) THEN
         ORDER_VAL(2)=1
         IF(LBARR) ORDER_VAL(2)=2
      ENDIF
      IF(LCBOR) THEN
         IF(LDMOD) THEN
          ORDER_VAL(3)=ORDER_VAL(2)+1
         ELSE IF(LBARR) THEN
          ORDER_VAL(3)=2
         ELSE
          ORDER_VAL(3)=1
         ENDIF
      ENDIF
      IF(LTCOM) THEN
         IF(LCBOR) THEN
          ORDER_VAL(4)=ORDER_VAL(3)+1
         ELSE IF(LDMOD) THEN
          ORDER_VAL(4)=ORDER_VAL(2)+1
         ELSE IF(LBARR) THEN
          ORDER_VAL(4)=2
         ELSE
          ORDER_VAL(4)=1
         ENDIF
      ENDIF
      IF(LTMOD) THEN
         IF(LTCOM) THEN
          ORDER_VAL(5)=ORDER_VAL(4)+1
         ELSE IF(LCBOR) THEN
          ORDER_VAL(5)=ORDER_VAL(3)+1
         ELSE IF(LDMOD) THEN
          ORDER_VAL(5)=ORDER_VAL(2)+1
         ELSE IF(LBARR) THEN
          ORDER_VAL(5)=2
         ELSE
          ORDER_VAL(5)=1
         ENDIF
      ENDIF
      IF(LBURN) THEN
         IF(LTMOD) THEN
          ORDER_VAL(6)=ORDER_VAL(5)+1
         ELSE IF(LTCOM) THEN
          ORDER_VAL(6)=ORDER_VAL(4)+1
         ELSE IF(LCBOR) THEN
          ORDER_VAL(6)=ORDER_VAL(3)+1
         ELSE IF(LDMOD) THEN
          ORDER_VAL(6)=ORDER_VAL(2)+1
         ELSE IF(LBARR) THEN
          ORDER_VAL(6)=2
         ELSE
          ORDER_VAL(6)=1
         ENDIF
      ELSE
         CALL XABORT ("@D2PSAP: BURN VARIABLE IS MISSING IN SAPHYB")
      ENDIF

      DO i=1, NPAR
        ! STORE THE NAME OF CURENT PKEY IN PKEY_TMP
        PKEY_TMP(i)=PKEY(i)
        ! NAME OF DIRECTORY IN SAPHYB CONTAINING VALUES OF STATE
        ! VARIABLES : PKEY(I)
        WRITE(PVALDIR(i),'("pval", I8)') i
        ! STORE VALUES IN VALPAR
        CALL LCMGET(IPSAP,PVALDIR(i),VALPAR(i,1:NVAL(i)))
        ! CASE OF CONTROL ROD
        IF(PKEY(i)==PKNAM(1)) THEN
           RANK(i)=ORDER_VAL(1);
           RANK_INDEX(ORDER_VAL(1))=i
           VALTOT=VALTOT+NVAL(i);
           IF(LADD) THEN
            DO UV=1,USRSTA
             IF(USRPAR(UV)==PKNAM(1)) THEN
              WRITE(6,*)('@D2PSAP: IMPOSSIBLE TO ADD A CONTROL ')
              CALL XABORT ('ROD VALUE IN THE PMAXS TREE')
             ENDIF
            ENDDO
           ENDIF
        ! CASE OF MODERATOR DENSITY
        ELSE IF(PKEY(i)==PKNAM(2)) THEN
           RANK(i)=ORDER_VAL(2)
           RANK_INDEX(ORDER_VAL(2))=i
           VALTOT=VALTOT+NVAL(i);
           IF(LADD) THEN
            DO UV=1,USRSTA
             IF(USRPAR(UV)==PKNAM(2)) THEN
              IF(LNEW) THEN
              VALPAR(i,1:NVAL(i))=0.0
              VALTOT=VALTOT-NVAL(i);
              NVAL(i)=0
              ENDIF
              VALTOT=VALTOT+USRVAL(UV)
              VALPAR(i,NVAL(i)+1:NVAL(i)+1+USRVAL(UV))=
     >         USRVAPK(UV,1:USRVAL(UV))
              NVAL(i)=NVAL(i)+USRVAL(UV)
              CALL D2PSOR(VALPAR(i,1:NVAL(i)),NVAL(i))
             ENDIF
            ENDDO
           ENDIF
        ! CASE OF BORON CONCENTRATION
        ELSE IF(PKEY(i)==PKNAM(3)) THEN
           RANK(i)=ORDER_VAL(3)
           RANK_INDEX(ORDER_VAL(3))=i
           VALTOT=VALTOT+NVAL(i);
           IF(LADD) THEN
            DO UV=1,USRSTA
             IF(USRPAR(UV)==PKNAM(3)) THEN
              IF(LNEW) THEN
              VALPAR(i,1:NVAL(i))=0.0
              VALTOT=VALTOT-NVAL(i);
              NVAL(i)=0
              ENDIF
              VALTOT=VALTOT+USRVAL(UV)
              VALPAR(i,NVAL(i)+1:NVAL(i)+1+USRVAL(UV))=
     >         USRVAPK(UV,1:USRVAL(UV))
              NVAL(i)=NVAL(i)+USRVAL(UV)
              CALL D2PSOR(VALPAR(i,1:NVAL(i)),NVAL(i))
             ENDIF
            ENDDO
           ENDIF
        ! CASE OF FUEL TEMPERATURE
        ELSE IF(PKEY(i)==PKNAM(4)) THEN
           RANK(i)=ORDER_VAL(4)
           RANK_INDEX(ORDER_VAL(4))=i
           VALTOT=VALTOT+NVAL(i);
           IF(LADD) THEN
            DO UV=1,USRSTA
             IF(USRPAR(UV)==PKNAM(4)) THEN
              IF(LNEW) THEN
              VALPAR(i,1:NVAL(i))=0.0
              VALTOT=VALTOT-NVAL(i);
              NVAL(i)=0
              ENDIF
              VALTOT=VALTOT+USRVAL(UV)
              VALPAR(i,NVAL(i)+1:NVAL(i)+1+USRVAL(UV))=
     >         USRVAPK(UV,1:USRVAL(UV))
              NVAL(i)=NVAL(i)+USRVAL(UV)
              CALL D2PSOR(VALPAR(i,1:NVAL(i)),NVAL(i))
             ENDIF
            ENDDO
           ENDIF
        ! CASE OF MODERATOR DENSITY
        ELSE IF(PKEY(i)==PKNAM(5)) THEN
           RANK(i)=ORDER_VAL(5)
           RANK_INDEX(ORDER_VAL(5))=i
           VALTOT=VALTOT+NVAL(i);
           IF(LADD) THEN
            DO UV=1,USRSTA
             IF(USRPAR(UV)==PKNAM(5)) THEN
              IF(LNEW) THEN
              VALPAR(i,1:NVAL(i))=0.0
              VALTOT=VALTOT-NVAL(i);
              NVAL(i)=0
              ENDIF
              VALTOT=VALTOT+USRVAL(UV)
              VALPAR(i,NVAL(i)+1:NVAL(i)+1+USRVAL(UV))=
     >         USRVAPK(UV,1:USRVAL(UV))
              NVAL(i)=NVAL(i)+USRVAL(UV)
              CALL D2PSOR(VALPAR(i,1:NVAL(i)),NVAL(i))
             ENDIF
            ENDDO
           ENDIF
        ! CASE OF BURN UP
        ELSE IF(PKEY(i)==PKNAM(6))  THEN
           RANK(i)=NPAR
           RANK_INDEX(NPAR)=i
           VALTOT=VALTOT+NVAL(i)
           STAVEC(4)=NVAL(i)
           IF(LADD) THEN
            DO UV=1,USRSTA
             IF(USRPAR(UV)==PKNAM(6)) THEN
              IF(LNEW) THEN
              VALPAR(i,1:NVAL(i))=0.0
              VALTOT=VALTOT-NVAL(i);
              NVAL(i)=0
              ENDIF
              VALTOT=VALTOT+USRVAL(UV)
              VALPAR(i,NVAL(i)+1:NVAL(i)+1+USRVAL(UV))=
     >         USRVAPK(UV,1:USRVAL(UV))
              NVAL(i)=NVAL(i)+USRVAL(UV)
              STAVEC(4)=NVAL(i)
              CALL D2PSOR(VALPAR(i,1:NVAL(i)),NVAL(i))
             ENDIF
            ENDDO
           ENDIF
        ! OTHER CASE (FLUE, TIME ETC. )
        ELSE
           RANK(i) = NPAR+i
           RANK_INDEX(NPAR+1)=NPAR+1
        END IF
      ENDDO ! i
      ALLOCATE (SV_VAL(VALTOT))
      ! D2PSOR STATE VARIABLE INPUT TO MATCH GENPMAXS ORDER
      CALL D2PSOI(RANK,NPAR)

      ! LOOP OVER STATES VARIABLES IN SAPHYB
      DO i=1, NPAR
        ! WE KEEP ONLY "REAL" STATES VARIABLE (IE EXEPT FLUE, TIME ETC.
        IF(RANK(i)<=NPAR) THEN
          ! RESTORE THE NAME OK PKEY AFTER THE CALL TO D2PSOR SUBROUTINE
          PKEY(i)=PKEY_TMP(RANK_INDEX(RANK(i)))
          NSVAR = NSVAR + 1
          DO j=1, NVAL(RANK_INDEX(RANK(i)))
           SV_VAL(k)=VALPAR(RANK_INDEX(RANK(i)),j)
           k=k+1
          ENDDO
        ENDIF
      ENDDO

      ! CREATION OF THE SAPHYB_INFO DIRECTORY INTO THE INFO DATA BLOCK
      STAVEC(2) = NSVAR  ! NVAR
      CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
      ! CREATION OF : INFO/SAPHYB_INFO/STATE_VAR
      CALL LCMPUT(IPDAT,'STATE_VAR',NSVAR,3,PKEY(1:NSVAR))
      IF(LBARR) THEN
        ! INFO/SAPHYB_INFO/BARR_FLAG
        CALL LCMPUT(IPDAT,'BARR_FLAG',1,1,1)
      ELSE
        PKEY_BARR(1)="BARR"
        DO j=1, NSVAR
          PKEY_BARR(j+1)=PKEY(j)
        ENDDO
        ! CREATION OF : INFO/SAPHYB_INFO/BARR_FLAG
        CALL LCMPUT(IPDAT,'BARR_FLAG',1,1,0)
        ! CREATION OF : INFO/SAPHYB_INFO/STATE_VAR
        CALL LCMPUT(IPDAT,'STATE_VAR',NSVAR+1,3,PKEY_BARR(1:NSVAR+1))
        ! CREATION OF : INFO/SAPHYB_INFO/BARR
        CALL LCMPUT(IPDAT,'BARR',1,2,1.0)
        STAVEC(2) = NSVAR + 1 ! NVAR
      ENDIF
      DO i=1, NSVAR
        IF(PKEY(i)==PKNAM(1)) THEN
           NCRD_SAP=NVAL(RANK_INDEX(RANK(i)))
           ! REORGANIZATION OF BARR PARAMETERS TO MATCH GENPMAXS
           ! FORMALISM. SPECIAL TREATMENT FOR BARR PARAMETERS TO TAKE
           ! INTO ACCOUNT THE MEANING OF BARR VALUES
           IF(NCRD.NE.NCRD_SAP) THEN
            WRITE(6,*) "@D2PSAP: ERROR IN CONTROL ROD COMPOSITION "
            WRITE(6,*) "THE NUMBER OF CONTROL ROD COMPOSITIONS IN ",
     1      "SAP (",NCRD_SAP,") IS DIFFERENT FROM D2P INPUT (",NCRD,")"
            WRITE(6,*) "SAP :",VALPAR(RANK_INDEX(RANK(i)),1:NCRD_SAP)
            WRITE(6,*) "D2P INPUT   :",CRDINF(1:5)
            CALL XABORT('D2PSAP: INPUT ERROR')
           ENDIF
           CALL D2PREO(IPDAT,VALPAR,RANK_INDEX(RANK(i)),NPAR,
     1     NVAL(RANK_INDEX(RANK(i))),IPRINT)
        ENDIF

        IF(MESH.EQ.'GLOB') THEN
            CALL  LCMPUT(IPDAT,PKEY(i),NVAL(RANK_INDEX(RANK(i))),2,
     1      VALPAR(RANK_INDEX(RANK(i)),1:NVAL(RANK_INDEX(RANK(i)))))
          DO l=1,USRSTA
           IF(USRPAR(l)==PKEY(i)) THEN
            IF(PKEY(i) =='BARR') THEN
             CALL XABORT('@D2PSAP: THE CR STATE CANNOT BE SET IN USER')
            ENDIF
            IF((USRVAL(l)>1).and.NVAL(RANK_INDEX(RANK(i)))==1) THEN
             WRITE(6,*)"@D2PSAP: IMPOSSIBLE TO DEFINE USER MESHING",
     1        " FOR ",PKEY(i)
             CALL XABORT ('ONLY ONE VALUE IS CONTAINED IN THE SAPHYB')
            ENDIF

            FIRST_VAL=VALPAR(RANK_INDEX(RANK(i)),1)
            LAST_VAL=NVAL(RANK_INDEX(RANK(i)))
            LAST_VAL=VALPAR(RANK_INDEX(RANK(i)),INT(LAST_VAL))
            NVAL(RANK_INDEX(RANK(i))) = USRVAL(l)
            IF(USRVAL(l)>1) THEN
             PITCH = (LAST_VAL-FIRST_VAL)/(USRVAL(l)-1)

             DO n=1,USRVAL(l)
              VALPAR(RANK_INDEX(RANK(i)),n)=FIRST_VAL+PITCH*(n-1)
             ENDDO
            ELSE
             VALPAR(RANK_INDEX(RANK(i)),1)=(FIRST_VAL+LAST_VAL)/2.0
            ENDIF

            CALL  LCMPUT(IPDAT,PKEY(i),USRVAL(l),2,
     1      VALPAR(RANK_INDEX(RANK(i)),1:USRVAL(l)))
           ENDIF
          ENDDO
        ELSE
          ! CREATION OF: INFO/SAPHYB_INFO/SVNAME
          CALL  LCMPUT(IPDAT,PKEY(i),NVAL(RANK_INDEX(RANK(i))),2,
     1    VALPAR(RANK_INDEX(RANK(i)),1:NVAL(RANK_INDEX(RANK(i)))) )
        ENDIF
      ENDDO

      IF(MESH=='DEF') THEN
        STAVEC(5) = 0
      ELSE IF(MESH=='SAP') THEN
        STAVEC(5) = 1
      ELSE IF(MESH=='GLOB') THEN
        STAVEC(5) = 2
      ELSE IF(MESH=='ADD') THEN
        STAVEC(5) = 3
        IF(LNEW) STAVEC(5) = 4
      ENDIF
      CALL LCMPUT(IPDAT,"ADF",1,3,ADF)
      CALL LCMPUT(IPDAT,"LABS", 3,5,LABS)
      CALL LCMPUT(IPDAT,"SCAT", 1,5,SCAT)
      CALL LCMSIX(IPDAT,'ISOTOPES',1)
      CALL LCMPUT(IPDAT,'XE135',3,3,ISOT(1))
      CALL LCMPUT(IPDAT,'SM149',3,3,ISOT(2))
      CALL LCMPUT(IPDAT,'I135',3,3,ISOT(3))

      ! SET THE IPDAT/STAVEC
      STAVEC(1) = DIMSAP(20)                     ! NGROUP
      STAVEC(3) = N_XS                           ! N_XS
      STAVEC(6) = NCRD                           ! NCOMPO
      STAVEC(7) = DIMSAP(31)                     ! NDLAY

      CALL LCMSIX(IPDAT,' ',0)
      CALL LCMPUT(IPDAT,'STATE-VECTOR',40,1,STAVEC)
      CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
      IPTH=LCMLID(IPDAT,'PKEY_INFO',6)
      DO J=1, 6
         KPTH=LCMDIL(IPTH,J)
         IF(J==1) THEN
           CALL LCMPUT(KPTH,"NAME",2,3,PKNAM(1))
           CALL LCMPUT(KPTH,"LFLAG",1,5,LBARR)
         ELSE IF(J==2)THEN
           CALL LCMPUT(KPTH,"NAME",2,3,PKNAM(2))
           CALL LCMPUT(KPTH,"LFLAG",1,5,LDMOD)
         ELSE IF(J==3) THEN
           CALL LCMPUT(KPTH,"NAME",2,3,PKNAM(3))
           CALL LCMPUT(KPTH,"LFLAG",1,5,LCBOR)
         ELSE IF(J==4)THEN
           CALL LCMPUT(KPTH,"NAME",2,3,PKNAM(4))
           CALL LCMPUT(KPTH,"LFLAG",1,5,LTCOM)
         ELSE IF(J==5)THEN
           CALL LCMPUT(KPTH,"NAME",2,3,PKNAM(5))
           CALL LCMPUT(KPTH,"LFLAG",1,5,LTMOD)
         ELSE IF(J==6) THEN
           CALL LCMPUT(KPTH,"NAME",2,3,PKNAM(6))
           CALL LCMPUT(KPTH,"LFLAG",1,5,LBURN)
         ENDIF
      ENDDO

      CALL LCMSIX(IPDAT,' ',0)
      CALL LCMSIX(IPDAT,'HELIOS_HEAD',1)
      CALL LCMSIX(IPDAT,' ',0)
      CALL LCMSIX(IPDAT,'GENPMAXS_INP',1)
      CALL LCMSIX(IPDAT,' ',0)

      ! EDIT THE LISTING FILE
      IF(IPRINT > 0)  THEN
         WRITE(6,*) "********** CONTENT OF SAPHYB RECOVERED ***********"
         WRITE(6,*)
         WRITE(6,*) "NUMBER OF STATE VARIBALE IN PARAMDESCRIP : ", NPAR
         WRITE(6,*) "NUMBER OF STATE VARIABLES :", NSVAR
         WRITE(6,*) "NAME OF STATE VARIABLES IN SAPHYB:", PKEY
         WRITE(6,*) "STATE VARIABLES RECOGNIZED:",PKEY(1:NSVAR)
         IF(NSVAR<NPAR-1) THEN
         WRITE(6,*) "WARNING:"
         WRITE(6,*) "STATE VARIABLES UNRECOGNIZED:",PKEY(NSVAR+1:NPAR-1)
         WRITE(6,*) "==>PLEASE USE THE PKEY CARD OF D2P: MODULE"
         ENDIF
         WRITE(6,*) "PRESENCE OF STATE VARIABLES :"
         WRITE(6,*) "   CONTROL ROD           :", LBARR
         WRITE(6,*) "   MODERATOR DENSITY     :", LDMOD
         WRITE(6,*) "   BORON CONCENTRATION   :", LCBOR
         WRITE(6,*) "   FUEL TEMPERATURE      :", LTCOM
         WRITE(6,*) "   MODERATOR TEMPERATURE :", LTMOD
         WRITE(6,*) "   BURNUP                :", LBURN
         WRITE(6,*) "ASSEMBLY DISCONTINUITY FACTORS           : ", LADF
         IF(LADF) THEN
          IF(ADF .EQ. 'DRA')  WRITE(6,*) "TYPE OF ADF : DRAGON"
          IF(ADF .EQ. 'GET')  WRITE(6,*) "TYPE OF ADF : GET"
          IF(ADF .EQ. 'SEL')  WRITE(6,*) "TYPE OF ADF : SELENGUT"
         ENDIF
         WRITE(6,*) "ABSORPTION TYPE          :"
         WRITE(6,*) "   SAP                   :", SAP
         WRITE(6,*) "   MIC                   :", MIC
         WRITE(6,*) "   EXC                   :", EXC

         WRITE(6,*)
         DO i=1, NSVAR
          WRITE(6,*) "NUMBER OF VALUES FOR ",PKEY(i)," PARAMETERS :",
     1    NVAL(RANK_INDEX(RANK(i)))
          WRITE(6,*) "VALUES FOR ",PKEY(i)," PARAMETERS :",
     1    VALPAR(RANK_INDEX(RANK(i)),1:NVAL(RANK_INDEX(RANK(i))))
          WRITE(6,*)
         ENDDO
        WRITE(6,*)
        WRITE(6,*) "NAME OF FISSION PRODUCT FOR FISSION YIELD :"
        WRITE(6,*) "XE135 : ",ISOT(1)
        WRITE(6,*) "SM149 : ",ISOT(2)
        WRITE(6,*) "I135  : ",ISOT(3)
        WRITE(6,*)
      ENDIF

      ! free memory
      DEALLOCATE (PKEY)
      DEALLOCATE (NVAL)
      DEALLOCATE (PVALDIR)
      DEALLOCATE (PKEY_TMP)
      DEALLOCATE (RANK)
      DEALLOCATE (RANK_INDEX)
      DEALLOCATE (SV_VAL)
      DEALLOCATE (VALPAR)
      DEALLOCATE (NOMREA)
      END
