*DECK D2PDEF
      SUBROUTINE D2PDEF( IPDAT,  PKEY, VALPAR,   NVALPA,  STAIDX,REFIDX,
     >                  REFSTA,HSTSTA,  STATE,   CRDINF,    NCRD,  NVAR,
     >                  IPRINT                                         )
*
*-----------------------------------------------------------------------
*
*Purpose:
* Select the reference state. This routine determine the reference
* state in both cases: default meshing and initial meshing from Saphyb
* the default meshing is the folllowing :
* For other parameters than BARR and BURN, the subroutine keep three
* values from the list: the first, middle and last of Saphyb. For
* parameters BARR and BURN, all values are kept
*
*Author(s): J. Taforeau
*
*parameters: input
* IPDAT      address of info data block
* NVAR       number of state variables
* NCRD       number of control rod composotion
* CRDINF     control rod compositions array
* VALPAR     array of values taken for each state variables
* STATE      state values for current branch calculation
* STAIDX     index of state values for current branch calculation
* REFSTA     values for each state variables of reference branch
* HSTSTA     values for each state variables of history branch
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      TYPE(C_PTR) IPDAT

      INTEGER NVAR,NCRD
      INTEGER NVALPA(NVAR),CRDINF(NCRD)
      INTEGER STAIDX(NVAR),REFIDX(NVAR)
      REAL STATE(NVAR),VALPAR(NVAR,100)
      REAL REFSTA(NVAR-1), HSTSTA(NVAR-1)
      CHARACTER*4 PKEY(NVAR)
*----
*  LOCAL VARIABLES
*----
      TYPE(C_PTR) IPTH,KPTH
      INTEGER ITYLCM,i,PK
      INTEGER :: NBR = 1
      ! number of values for each default state variable ( 1 if the
      ! initial number of values is less than 3, 3 otherwise)
      INTEGER DMOD_DIM, CBOR_DIM, TCOM_DIM, TMOD_DIM
      ! middle value for reference DMOD,CBOR and TCOM
      REAL TCOM_REF,DMOD_REF,CBOR_REF,TMOD_REF
      ! middle value for default DMOD,CBOR and TCOM
      REAL TCOM_ST,DMOD_ST,CBOR_ST,TMOD_ST
      ! middle value for history DMOD,CBOR and TCOM
      REAL TCOM_HST,DMOD_HST,CBOR_HST ,TMOD_HST
      ! if TMOD_FALG = 0: RIA case, else RTV case
      REAL :: TMOD_FLAG = 0
      CHARACTER*8 PKNAM(6)
      LOGICAL LFLAG(6)
      REAL, ALLOCATABLE, DIMENSION(:) :: DMOD_def, CBOR_def
      REAL, ALLOCATABLE, DIMENSION(:) :: TCOM_def, TMOD_def

      ! RECOVER INFORMATION FROM INFO DATA BLOCK
      CALL LCMSIX(IPDAT,' ',0)
      CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
      DO PK=1, 6
        IPTH=LCMGID(IPDAT,'PKEY_INFO')
        KPTH=LCMDIL(IPTH,PK)
        CALL LCMGTC(KPTH,'NAME',8,1,PKNAM(PK))
        CALL LCMGET(KPTH,'LFLAG',LFLAG(PK))
      ENDDO

      ! LOOP OVER STATES VARIABLES OF CONTAINED IN INFO
      TMOD_ST=-999.9 ! set to undefined value
      TMOD_REF=-999.9 ! set to undefined value
      TMOD_HST=-999.9 ! set to undefined value
      TCOM_ST=-999.9 ! set to undefined value
      TCOM_REF=-999.9 ! set to undefined value
      TCOM_HST=-999.9 ! set to undefined value
      DMOD_ST=-999.9 ! set to undefined value
      DMOD_REF=-999.9 ! set to undefined value
      DMOD_HST=-999.9 ! set to undefined value
      CBOR_ST=-999.9 ! set to undefined value
      CBOR_REF=-999.9 ! set to undefined value
      CBOR_HST=-999.9 ! set to undefined value
      DO is=1, NVAR
         CALL LCMLEN(IPDAT,PKEY(is),NVALPA(is),ITYLCM)
         CALL LCMGET(IPDAT,PKEY(is),VALPAR(is,1:NVALPA(is)))

         IF(PKEY(is).EQ.PKNAM(1)) THEN
          NBR=NBR*NVALPA(is)
         ENDIF
         ! DETERMINES DEFAULT VALUES FOR PARAMETERS
         IF((PKEY(is).EQ.PKNAM(2))) THEN

          IF(NVALPA(is)>2) THEN
           ALLOCATE (DMOD_def(3))
           DMOD_DIM=3
           DMOD_def(2)=VALPAR(is,NINT(NVALPA(is)/2.0))
           DMOD_def(3)=VALPAR(is,NVALPA(is))
           STAIDX(2)=2   ! DMOD INDEX OF INITIAL DEFAULT VALUE
           REFIDX(2)=2   ! DMOD INDEX OF REFERENCE DEFAULT VALUE
           NBR=NBR*3
          ELSE
           ALLOCATE (DMOD_def(1))
           DMOD_DIM=1
           STAIDX(2)=1   ! DMOD INDEX OF INITIAL DEFAULT VALUE
           REFIDX(2)=1   ! DMOD INDEX OF REFERENCE DEFAULT VALUE
          ENDIF
          DMOD_def(1)=VALPAR(is,1)
          DMOD_REF=VALPAR(is,NINT(NVALPA(is)/2.0))
          DMOD_ST=VALPAR(is,NINT(NVALPA(is)/2.0))
          DMOD_HST=VALPAR(is,NINT(NVALPA(is)/2.0))
         ENDIF

         IF((PKEY(is).EQ.PKNAM(3))) THEN

          IF(NVALPA(is)>2) THEN
           ALLOCATE (CBOR_def(3))
           CBOR_DIM=3
           CBOR_def(2)=VALPAR(is,NINT(NVALPA(is)/2.0))
           CBOR_def(3)=VALPAR(is,NVALPA(is))
           STAIDX(3)=2   ! CBOR INDEX OF INITIAL DEFAULT VALUE
           REFIDX(3)=2   ! CBOR INDEX OF REFERENCE DEFAULT VALUE
           NBR=NBR*3
          ELSE
           ALLOCATE (CBOR_def(1))
           CBOR_DIM=1
           STAIDX(3)=1   ! CBOR INDEX OF INITIAL DEFAULT VALUE
           REFIDX(3)=1   ! CBOR INDEX OF REFERENCE DEFAULT VALUE
          ENDIF
          CBOR_def(1)=VALPAR(is,1)
          CBOR_REF=VALPAR(is,NINT(NVALPA(is)/2.0))
          CBOR_ST=VALPAR(is,NINT(NVALPA(is)/2.0))
          CBOR_HST=VALPAR(is,NINT(NVALPA(is)/2.0))
         ENDIF

         IF((PKEY(is).EQ.PKNAM(4))) THEN
          IF(NVALPA(is)>2) THEN
           ALLOCATE (TCOM_def(3))
           TCOM_DIM=3
           TCOM_def(2)=VALPAR(is,NINT(NVALPA(is)/2.0))
           TCOM_def(3)=VALPAR(is,NVALPA(is))
           STAIDX(4)=2   ! TCOM INDEX OF INITIAL DEFAULT VALUE
           REFIDX(4)=2   ! TCOM INDEX OF REFERENCE DEFAULT VALUE
           NBR=NBR*3
          ELSE
           ALLOCATE (TCOM_def(1))
           TCOM_DIM=1
           STAIDX(4)=1   ! TCOM INDEX OF INITIAL DEFAULT VALUE
           REFIDX(4)=1   ! TCOM INDEX OF REFERENCE DEFAULT VALUE
          ENDIF
          TCOM_def(1)=VALPAR(is,1)
          TCOM_REF=VALPAR(is,NINT(NVALPA(is)/2.0))
          TCOM_ST=VALPAR(is,NINT(NVALPA(is)/2.0))
          TCOM_HST=VALPAR(is,NINT(NVALPA(is)/2.0))
         ENDIF

         IF((PKEY(is).EQ.PKNAM(5))) THEN
          IF(NVALPA(is)>2) THEN
           ALLOCATE (TMOD_def(3))
           TMOD_DIM=3
           TMOD_def(2)=VALPAR(is,NINT(NVALPA(is)/2.0))
           TMOD_def(3)=VALPAR(is,NVALPA(is))
           STAIDX(5)=2   ! TMOD INDEX OF INITIAL DEFAULT VALUE
           REFIDX(5)=2   ! TMOD INDEX OF REFERENCE DEFAULT VALUE
           NBR=NBR*3
          ELSE
           ALLOCATE (TMOD_def(1))
           TMOD_DIM=1
           STAIDX(5)=1   ! TMOD INDEX OF INITIAL DEFAULT VALUE
           REFIDX(5)=1   ! TMOD INDEX OF REFERENCE DEFAULT VALUE
          ENDIF
          TMOD_def(1)=VALPAR(is,1)
          TMOD_REF=VALPAR(is,NINT(NVALPA(is)/2.0))
          TMOD_ST=VALPAR(is,NINT(NVALPA(is)/2.0))
          TMOD_HST=VALPAR(is,NINT(NVALPA(is)/2.0))
          TMOD_FLAG=1
         ENDIF
      ENDDO ! is

      DO i=1, NVAR
         IF((PKEY(i).EQ.PKNAM(6))) THEN

          PKEY(1)=PKNAM(1)(:4)
          REFSTA(1)=CRDINF(1)
          HSTSTA(1)= CRDINF(1)
          STATE(1)= CRDINF(1)
          STAIDX(1)=1
          REFIDX(1)=1
          IF(LFLAG(2)) THEN
           PKEY(2)=PKNAM(2)(:4)
           REFSTA(2)=DMOD_REF
           HSTSTA(2)= DMOD_HST
           STATE(2)= DMOD_ST
          ENDIF
          IF(LFLAG(3)) THEN
           IF(LFLAG(2)) THEN
            PKEY(3)=PKNAM(3)(:4)
            REFSTA(3)=CBOR_REF
            HSTSTA(3)= CBOR_HST
            STATE(3)= CBOR_ST
           ELSE
            PKEY(2)= PKNAM(3)(:4)
            REFSTA(2)=CBOR_REF
            HSTSTA(2)= CBOR_HST
            STATE(2)= CBOR_ST
           ENDIF
          ENDIF
          IF(LFLAG(4)) THEN
           IF(LFLAG(3)) THEN
            REFSTA(4)=TCOM_REF
            PKEY(4)=PKNAM(4)(:4)
            HSTSTA(4)= TCOM_HST
            STATE(4)= TCOM_ST
           ELSE IF(LFLAG(2)) THEN
            REFSTA(3)=TCOM_REF
            PKEY(3)=PKNAM(4)(:4)
            HSTSTA(3)= TCOM_HST
            STATE(3)= TCOM_ST
           ELSE
            REFSTA(2)=TCOM_REF
            PKEY(2)=PKNAM(4)(:4)
            HSTSTA(2)= TCOM_HST
            STATE(2)= TCOM_ST
           ENDIF
          ENDIF
          IF(LFLAG(5)) THEN
           IF(LFLAG(4)) THEN
            REFSTA(5)=TMOD_REF
            PKEY(5)=PKNAM(5)(:4)
            HSTSTA(5)= TMOD_HST
            STATE(5)= TMOD_ST
           ELSE IF(LFLAG(3)) THEN
            REFSTA(4)=TMOD_REF
            PKEY(4)=PKNAM(5)(:4)
            HSTSTA(4)= TMOD_HST
            STATE(4)= TMOD_ST
           ELSE IF(LFLAG(2)) THEN
            REFSTA(3)=TMOD_REF
            PKEY(3)=PKNAM(5)(:4)
            HSTSTA(3)= TMOD_HST
            STATE(3)= TMOD_ST
           ELSE
            REFSTA(2)=TMOD_REF
            PKEY(2)=PKNAM(5)(:4)
            HSTSTA(2)= TMOD_HST
            STATE(2)= TMOD_ST
           ENDIF
          ENDIF
          IF(LFLAG(6)) THEN
           IF(LFLAG(5)) THEN
            PKEY(6)=PKNAM(6)(:4)
            STATE(6)= VALPAR(NVAR,1)
            STAIDX(6)=1
            REFIDX(6)=1
           ELSE IF(LFLAG(4)) THEN
            PKEY(5)=PKNAM(6)(:4)
            STATE(5)= VALPAR(NVAR,1)
            STAIDX(5)=1
            REFIDX(5)=1
           ELSE IF(LFLAG(3)) THEN
            PKEY(4)=PKNAM(6)(:4)
            STATE(4)= VALPAR(NVAR,1)
            STAIDX(4)=1
            REFIDX(4)=1
           ELSE IF(LFLAG(2)) THEN
            PKEY(3)=PKNAM(6)(:4)
            STATE(3)= VALPAR(NVAR,1)
            STAIDX(3)=1
            REFIDX(3)=1
           ELSE
            PKEY(2)=PKNAM(6)(:4)
            STATE(2)= VALPAR(NVAR,1)
            STAIDX(2)=1
            REFIDX(2)=1
           ENDIF
          ELSE
           CALL XABORT ("@D2PDEF: BURN VARIABLE MISSING IN SAPHYB")
          ENDIF

         IF(LFLAG(2))CALL LCMPUT(IPDAT,PKNAM(2),DMOD_DIM,2,DMOD_def)
         IF(LFLAG(3))CALL LCMPUT(IPDAT,PKNAM(3),CBOR_DIM,2,CBOR_def)
         IF(LFLAG(4))CALL LCMPUT(IPDAT,PKNAM(4),TCOM_DIM,2,TCOM_def)
         IF(LFLAG(5))CALL LCMPUT(IPDAT,PKNAM(5),TMOD_DIM,2,TMOD_def)

         CALL LCMDEL(IPDAT,PKNAM(6))
         CALL  LCMPUT(IPDAT,PKNAM(6),NVALPA(NVAR),2,
     1   VALPAR(NVAR,1:NVALPA(NVAR)) )
         ENDIF
      ENDDO ! i

      ! SET THE DEFAULTS VALUES IN INFO
      CALL LCMSIX(IPDAT,' ',0)
      CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
      CALL LCMPUT(IPDAT,'STATE_VAR',NVAR,3,PKEY)
      CALL LCMSIX(IPDAT,' ',0)
      CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
      CALL LCMPUT(IPDAT,'BRANCH',1,3,PKNAM(1))
      CALL LCMPUT(IPDAT,'BRANCH_IT',1,1,1)
      CALL LCMPUT(IPDAT,'REF_STATE',NVAR-1,2,REFSTA)
      CALL LCMPUT(IPDAT,'HST_STATE',NVAR-1,2,REFSTA)
      CALL LCMPUT(IPDAT,'BRANCH_NB',1,1,NBR)
      CALL LCMPUT(IPDAT,'STATE_INDEX',NVAR,1,STAIDX)
      CALL LCMPUT(IPDAT,'REF_INDEX',NVAR,1,REFIDX)
      CALL LCMPUT(IPDAT,'BRANCH_INDEX',1,1,1)
      CALL LCMPUT(IPDAT,'REWIND',1,1,1)
      CALL LCMPUT(IPDAT,'STATE',NVAR,2,STATE)
      CALL LCMPUT(IPDAT,'STOP',1,1,0)

      IF(IPRINT > 1)  THEN
          WRITE(6,*)
          WRITE(6,*) "*** INFORMATION ABOUT BRANCHING CALCULATION  ***"
          WRITE(6,*)
          WRITE(6,*) "DEFAULT MESHING (Y/N) : Y"
          WRITE(6,*) "==> NEW VALUES FOR PARAMTERS",
     1    " OTHER THAN BARR AND BURN :"
          WRITE(6,*) "  DMOD : ", DMOD_def
          WRITE(6,*) "  CBOR : ", CBOR_def
          WRITE(6,*) "  TCOM : ", TCOM_def
          IF(LFLAG(5)) THEN
          WRITE(6,*) "  TMOD : ", TMOD_def
          ENDIF
          WRITE(6,*)
          WRITE(6,*) "STATE parameters : ",PKEY(1:NVAR-1)
          WRITE(6,*) "REFERENCE STATES VALUES :", REFSTA
          WRITE(6,*)
          WRITE(6,*) "STATE parameters : ",PKEY
          WRITE(6,*) "INITIAL STATES VALUES :", STATE
          WRITE(6,*) "INITIAL STATES INDEX VALUES :", STAIDX
          WRITE(6,*)
      ENDIF
      DEALLOCATE (DMOD_def,CBOR_def,TCOM_def)
      IF(LFLAG(5)) DEALLOCATE (TMOD_def)
      END
