Initial commit from Polytechnique Montreal

1 files changed, 1693 insertions, 0 deletions

diff --git a/Donjon/src/D2PBRA.f b/Donjon/src/D2PBRA.f
new file mode 100644
index 0000000..301d191
--- /dev/null
+++ b/Donjon/src/D2PBRA.f
@@ -0,0 +1,1693 @@
+*DECK D2PBRA
+      SUBROUTINE D2PBRA( IPDAT,IPINP,IPHEL,STAVEC,DEB,SIGNAT,IPRINT    )
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover information from the INFO data block for a complete branch
+* and write it in the IPHEL file . The format of this file is described
+* in the DRAG2PARCS: manual. This routine write sequentially the IPHEL
+* file, branch after branch
+*
+*Author(s): 
+* J. Taforeau
+*
+*Parameters: input
+* IPDAT   address of info data block
+* IPINP   file unit of the input file GENPMAXS.inp
+* IPHEL   file unit of the HELIOS.dra file
+* STAVEC  various parameters associated with the IPDAT structure
+* DEB     flag for D2PGEN
+* SIGNAT  signature of the object containing cross sections
+* IPRINT  control the printing on screen
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPDAT
+      INTEGER IPINP,IPHEL,STAVEC(40),DEB,IPRINT
+
+      CHARACTER*16 SIGNAT
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER GRID,ITBRAN,NVAR,i,j,k
+      INTEGER NSF,NGP,NXS,NBU,FLPRIN,LMER
+      INTEGER STAIDX(STAVEC(2)),PKIDX(STAVEC(2))
+      INTEGER IUPS,FA_K,NADF,NCDF,NPIN,NCOLA,NROWA,XESM
+      REAL XS(STAVEC(1),STAVEC(3),STAVEC(4)) ! TABLE FOR XS
+      REAL ADF(STAVEC(13),STAVEC(1),STAVEC(4))
+      REAL FLXL(STAVEC(1),STAVEC(4))
+      REAL FLXR(STAVEC(1),STAVEC(4))
+      REAL CURL(STAVEC(1),STAVEC(4))
+      REAL CURR(STAVEC(1),STAVEC(4))
+      REAL CDF(STAVEC(15),STAVEC(1),STAVEC(4))
+      REAL GFF(STAVEC(8),STAVEC(9),STAVEC(1),STAVEC(4))
+      REAL SCAT(STAVEC(1)*STAVEC(1),STAVEC(4))
+      REAL BURN(STAVEC(4)),XSC(3),DATSRC(5)
+      REAL DIV(3,STAVEC(4))
+      REAL ND(2,STAVEC(4))
+      CHARACTER(len=4) BRANCH,JOB(4)
+      CHARACTER*12 FILNAM
+      CHARACTER COM
+      CHARACTER*16 JOBTIT
+      CHARACTER JOBOPT(16)
+      CHARACTER*3 ADF_T
+      CHARACTER*1 DER
+      REAL FC1(5)
+      REAL FC2(8)
+      REAL FC3(7)
+      REAL FC4(3)
+      REAL VERS,SFAC,BFAC
+      LOGICAL :: LTH = .FALSE.
+      LOGICAL :: LADF = .FALSE.
+      LOGICAL :: LXES = .FALSE.
+      LOGICAL :: LCDF = .FALSE.
+      LOGICAL :: LGFF = .FALSE.
+      LOGICAL :: LDET = .FALSE.
+
+
+      ! INITIALIZATION OF VARIABLES
+      NGP=STAVEC(1)
+      NVAR=STAVEC(2)
+      NXS=STAVEC(3)
+      NBU=STAVEC(4)
+      GRID=STAVEC(5)
+      NCOLA=STAVEC(8)
+      NROWA=STAVEC(9)
+      NPART=STAVEC(10)
+      NSF=STAVEC(11)
+      NCF=STAVEC(12)
+      NADF=STAVEC(13)
+      NCDF=STAVEC(15)
+      NGFF=STAVEC(16)
+      NPIN=STAVEC(17)
+      LMER=STAVEC(21)
+
+
+      IF(IPRINT > 0)  THEN
+        WRITE(6,*)
+        WRITE(6,*) "**** WRITING CURRENT BRANCH IN HELIOS FILE ****"
+
+      ENDIF
+      ! RECOVER INFORMATION FROM INFO DATA BLOCK
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'HELIOS_HEAD',1)
+      CALL LCMGET(IPDAT,'FILE_CONT_1',FC1)
+      CALL LCMGET(IPDAT,'FILE_CONT_2',FC2)
+      CALL LCMGET(IPDAT,'FILE_CONT_3',FC3)
+      CALL LCMGET(IPDAT,'FILE_CONT_4',FC4)
+      CALL LCMGET(IPDAT,'XS_CONT',XSC)
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'GENPMAXS_INP',1)
+      CALL LCMGET(IPDAT,'DAT_SRC',DATSRC)
+      CALL LCMGTC(IPDAT,'JOB_OPT',4,4,JOB)
+      CALL LCMGET(IPDAT,'VERSION',VERS)
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
+      CALL LCMGET(IPDAT,'PRINT',FLPRIN)
+      CALL LCMGET(IPDAT,'STATE_INDEX',STAIDX)
+      CALL LCMGET(IPDAT,'BRANCH_IT',ITBRAN)
+      CALL LCMGTC(IPDAT,'BRANCH',4,BRANCH)
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
+      CALL LCMGET(IPDAT,'PKIDX',PKIDX)
+      CALL LCMGET(IPDAT,'BURN',BURN)
+
+      i=1
+      DO j=1,4
+       DO k=1,4
+        JOBOPT(i)= JOB(j)(k:k)
+        i=i+1
+       ENDDO
+      ENDDO
+
+      IF(JOBOPT(1)=='T') THEN
+      LADF = .TRUE.
+      CALL LCMGTC(IPDAT,'ADF_TYPE',3,ADF_T)
+      ENDIF
+      IF(JOBOPT(2)=='T') LXES = .TRUE.
+      IF(JOBOPT(8)=='T') LDET = .TRUE.
+      IF((JOBOPT(5)=='T').OR.(JOBOPT(7)=='T').OR.
+     > (JOBOPT(9)=='T').OR.(JOBOPT(13)=='T').OR.(JOBOPT(12)=='T'))THEN
+        LTH =.TRUE.
+      ENDIF
+      IF(JOBOPT(10)=='T') LCDF = .TRUE.
+      IF(JOBOPT(11)=='T') LGFF = .TRUE.
+
+      ! WRITE THE CURRENT BRANCH IN THE HELIOS.DRA FILE
+      IF(FLPRIN==1) THEN
+         ! RECOVER CROSS SECTIONS FROM THE TEMPORARY FILE
+         CALL READXS (IPDAT,     XS,   SCAT,    ND,     DIV,    NGP,
+     >                  NXS,    ADF,    CDF,   GFF,     NBU,   NADF,
+     >               DATSRC,   GRID,   NCDF, NCOLA,   NROWA,   LADF,
+     >                 LCDF,   LGFF,   LXES,  LDET,  SIGNAT,   LMER,
+     >               IPRINT,  ADF_T,   FLXL,  FLXR,    CURL,   CURR)
+         ! WRITE IN HELIOS.DRA THE SET OF BURNUP POINTS
+         CALL SETBU (IPHEL,BRANCH,ITBRAN,XSC,BURN,NBU,          IPRINT)
+
+         ! WRITE IN HELIOS.DRA THE SET OF CROSS SECTIONS
+         CALL SETXS   (  IPHEL, BRANCH, ITBRAN,    XS,     NGP,    NXS,
+     >                     NBU,   BURN, DATSRC,    LXES,   LDET,IPRINT)
+
+         ! WRITE IN HELIOS.DRA THE ELEMENT OF THE SCATTERING MATRIX
+         CALL SETSCT(IPHEL,BRANCH,ITBRAN,SCAT,NGP,NBU,BURN,     IPRINT)
+
+         IF(LADF.AND.(LMER.EQ.0)) THEN
+          CALL SETADF(  IPHEL, BRANCH, ITBRAN,   ADF,    NADF,    NGP,
+     >                    NBU,   BURN, IPRINT, ADF_T,    FLXR,   FLXL,
+     >                   CURL,   CURR)
+         ENDIF
+
+         IF(DATSRC(3)==1.0) THEN
+           IF(LXES) THEN
+            ! WRITE IN HELIOS.DRA THE NUMBRE DENSITIES FOR XENON AND
+            ! SAMARIUM
+            CALL SETND (IPHEL,BRANCH,ITBRAN,  ND,NBU,BURN,       IPRINT)
+           ENDIF
+           IF((GRID<2).AND.(SIGNAT.EQ.'L_SAPHYB'))THEN
+            ! WRITE IN HELIOS.DRA THE DIVERS INFORMATION
+            CALL SETDIV(IPHEL,BRANCH,ITBRAN,DIV,NBU,BURN,IPRINT)
+           ENDIF
+           IF(LTH) THEN
+           ! WRITE IN HELIOS.DRA THE T:H INVARIANT DATA BLOCK
+           CALL SETTH  (  IPHEL, BRANCH, ITBRAN,  BURN,     NBU, JOBOPT,
+     >                      NGP,  IPDAT, IPRINT                        )
+           ENDIF
+
+           IF(LCDF) THEN
+            CALL SETCDF(  IPHEL, BRANCH, ITBRAN,   CDF,    NCDF,    NGP,
+     >                      NBU,   BURN, IPRINT                        )
+           ENDIF
+           IF(LGFF) THEN
+            IF ((NCOLA .NE. NPIN) .OR. (NROWA .NE.NPIN)) THEN
+             WRITE (6,*) "@D2PBRA: NUMBER OF PIN IN MCO (NPIN= ",NPIN,
+     >     ") INCOHERENT WITH ncols AND nrows (",NCOLA,') IN D2P: INPUT'
+            CALL XABORT ('')
+            ENDIF
+            CALL SETGFF(  IPHEL, BRANCH, ITBRAN,   GFF,   NCOLA,  NROWA,
+     >                    NPART,    NGP,    NBU,  BURN,    NGFF, IPRINT,
+     >                     VERS)
+           ENDIF
+         ENDIF
+         ! SIGNATURE OF THE END OF A BRANCH (MANDATORY FOR GENPMAXS
+         ! CODE)
+         WRITE(IPHEL,*)
+         WRITE(IPHEL,30)'*********************************************'
+         WRITE(IPHEL,30)'* Normal End,    No warning messages issued *'
+         WRITE(IPHEL,30)'*                                           *'
+         WRITE(IPHEL,30)'*   Total CPU time used =                   *'
+         WRITE(IPHEL,30)'*********************************************'
+  30     FORMAT(25X,A)
+      ENDIF
+
+      ! UPDATE OF THE INFO DATA BLOCK
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'GENPMAXS_INP',1)
+      CALL LCMPUT(IPDAT,'FLAG',1,1,1)
+
+      IF(IPRINT > 0)  THEN
+        WRITE(6,*) "******** UPDATING the GENPMAXS.INP FILE *********"
+      ENDIF
+      ! UPDATE OF THE GENPMAXS.INP FILE (MANY ARGUMENTS IN THIS CALL
+      ! ARE NOT USED IN D2PGEN)
+      CALL      D2PGEN( IPINP, IPDAT,   STAVEC, JOBTIT, FILNAM,    DER,
+     >                   VERS,   COM,   JOBOPT,   IUPS,   FA_K,   SFAC,
+     >                   BFAC,   DEB,     XESM,  FC1  ,    FC2,    FC3,
+     >                    FC4,   XSC,   IPRINT                        )
+      IF(IPRINT > 0)  THEN
+        WRITE(6,*)"********* SELECTING A NEW BRANCH CALCULATION *****"
+      ENDIF
+
+      CALL D2PSEL   (  IPDAT,  IPINP, STAVEC,BRANCH,  ITBRAN, STAIDX,
+     >                  NVAR, JOBOPT,    DEB,  FC1  ,    FC2,    FC3,
+     >                   FC4,   XSC,   IPRINT                       )
+
+
+      WRITE(6,*) "*********       BRANCH SELECTED              *****"
+
+      END
+
+      SUBROUTINE SETBU(IPHEL,BRANCH,ITBRAN,XSC,BURN,NBU,IPRINT)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Write in the HELIOS.dra file the inforamtion about burnup points and
+* XSC card (sides in assembly (NSIDES),
+* corners in assembly (NCORNERS), VFCM).
+* This routine write sequentially the HELIOS.dra file, branch after
+* branch.
+*
+*parameters: input
+* IPHEL      file unit of the HELIOS.dra file
+* BRANCH     nature of the current branch ( CR, DC, CB, TC, TM etc )
+* ITBRAN     index of the current branch
+* XSC        content of the XS_CONT card
+* BURN       set of burnup points
+* NBU        number of bunup points
+* IPRINT     control the printing on screen
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER NBU,ITBRAN,IPHEL,IPRINT
+      REAL XSC(3),BURN (NBU)
+      CHARACTER BRANCH*4
+*----
+*  LOCAL VARIABLES
+*----
+      ! number of sides and corners in assembly
+      INTEGER NSIDE, NCORNER
+
+
+
+      NSIDE = NINT(XSC(1))
+      NCORNER = NINT(XSC(2))
+
+      ! XS_CONT CARD (Cf DRAG2PARCS Manual for details on HELIOS format)
+      IF (IPRINT>5) WRITE(6,*) 'SETBU: WRITE BURNUP INFO'
+      ! HEADER OF XS_CONT card
+      WRITE(IPHEL,'()')
+      WRITE(IPHEL,*) 'List name       : PMAX_FILE_DATA'
+      WRITE(IPHEL,*) 'Labels Array    : KINF'
+      WRITE(IPHEL,*) 'List Title(s)  1) ==========================='
+      WRITE(IPHEL,*) '               2) %STAT_xxxx'
+      WRITE(IPHEL,*) '               3) ==========================='
+      WRITE(IPHEL,*) '               4)%XS_CONT'
+      WRITE(IPHEL,*) '               5)Meaning : NBN,NSIDE,NCORNER,'
+     1 //'VFCM'
+
+
+      ! RIEGO block of HELIOS.dra file
+      CALL SET_RIEGO(IPHEL)
+
+
+      ! Set the content of XS_CONT in HELIOS.dra
+      WRITE(IPHEL,'(25X,4A14)') '           NBN',
+     1   '         NSIDE','       NCORNER','          VFCM'
+      WRITE(IPHEL,200) 'Label E','.-.-E-.-.','.-.-E-.-.','.-.-E-.-.',
+     1     '1-.-E-.-.'
+      WRITE(IPHEL,'(I4,1X,A,I4,A,A,I4,A,I5,3I12,ES12.5E2)')
+     1 1,BRANCH(1:2),ITBRAN,' ',BRANCH(1:2),ITBRAN,':',
+     2 0,NBU,NSIDE,NCORNER,
+     3 XSC(3)
+
+      WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>'
+
+      ! BURNUP INFORMATION
+
+
+      ! HEADER OF Burnup card
+      WRITE(IPHEL,'()')
+      WRITE(IPHEL,*) 'List name       : PMAX_FILE_DATA'
+      WRITE(IPHEL,*) 'Labels Array    : KINF'
+      WRITE(IPHEL,*) 'List Title(s)  1) ==========================='
+      WRITE(IPHEL,*) '               2) %XS_STAT'
+      WRITE(IPHEL,*) '               3) ==========================='
+      WRITE(IPHEL,*) '               4)Meaning : Bunrup'
+
+
+      ! RIEGO block of HELIOS.dra file
+      CALL SET_RIEGO(IPHEL)
+
+
+      WRITE(IPHEL,'(30X,A6)') 'BURNUP'
+      WRITE(IPHEL,210) 'Label E','.-.-E-.-.'
+      ! LOOP over burnup points
+      DO IT=1, NBU
+
+          WRITE(IPHEL,220) IT,BRANCH(1:2),ITBRAN,' ',
+     1    BRANCH(1:2),ITBRAN,':',NINT(BURN(IT)),BURN(IT)/1000.0
+
+      ENDDO
+
+      WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>'
+
+
+      ! format of HELIOS.dra file
+  200 FORMAT(6X,A,12X,A,3X,A,3X,A,3X,A)
+  210 FORMAT(6X,A,12X,A)
+  220 FORMAT(I4,1X,A,I4,A,A,I4,A,I5,6X,F6.3)
+      END
+
+      SUBROUTINE READXS (IPDAT,     XS,   SCAT,    ND,     DIV,    NGP,
+     >                     NXS,    ADF,    CDF,   GFF,     NBU,   NADF,
+     >                    DATSRC,  GRID,  NCDF, NCOLA,   NROWA,   LADF,
+     >                      LCDF,  LGFF,  LXES,  LDET,  SIGNAT,   LMER,
+     >                    IPRINT, ADF_T,  FLXL,  FLXR,    CURL,   CURR)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover cross section from the INFO data block.
+*
+*parameters: input
+* IPDAT      address of info data block
+* XS         table of cross sections
+* SCAT       scattering matrix
+* ND         number densities for xenon and samarium
+* DIV        divers info directory
+* NGP        number of energy groups
+* NXS        number of cross sections
+* NBU        number of burnup points
+* ADF        assembly dicontinuity factor
+* NADF       number of surfaces in assembly
+* NCDF       number of corners in assembly
+* NCOLA      number of pin in assembly along x-axis
+* NROWA      number of pin in assembly along y-axis
+* GRID       type of gridding for branching calculation
+* LADF       flag for assembly discontinuity factors
+* LCDF       flag for corner discontinuity factors
+* LGFF       flag for group form factors
+* LXES       flag for microscopic cross sections
+* DAT SRC    array containing the DATA source (reflector of fuel)
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPDAT
+      INTEGER NGP,NBU,NXS,NADF,GRID,NCDF,LMER
+      REAL DATSRC(5)
+      REAL XS(NGP,NXS,NBU)
+      REAL SCAT(NGP*NGP,NBU)
+      REAL ND(2,NBU)
+      REAL DIV(3,NBU)
+      REAL ADF(NADF,NGP,NBU)
+      REAL FLXL(NGP,NBU)
+      REAL FLXR(NGP,NBU)
+      REAL CURL(NGP,NBU)
+      REAL CURR(NGP,NBU)
+      REAL CDF(NCDF,NGP,NBU)
+      REAL GFF(NCOLA,NROWA,NGP,NBU)
+      REAL ADFMOY(NGP,NBU)
+      LOGICAL LADF,LXES,LCDF,LGFF,LDET
+      CHARACTER*16 SIGNAT
+*----
+*  LOCAL VARIABLES
+*----
+      TYPE(C_PTR) IPTH,KPTH
+      INTEGER BU
+      CHARACTER*3 ADF_T
+
+      IF(IPRINT>5) WRITE(6,*) 'READXS: RECOVER INFO DATA BLOCK'
+
+      ! LOOP over burnup points
+      DO BU=1, NBU
+         CALL LCMSIX(IPDAT,' ',0)
+         CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
+         IPTH=LCMGID(IPDAT,'CROSS_SECT')
+         KPTH=LCMDIL(IPTH,BU)
+         CALL LCMSIX(KPTH,'MACROLIB_XS',1)
+         CALL LCMGET(KPTH,'XTR',XS(1:NGP,1,BU))
+         CALL LCMGET(KPTH,'ABSORPTION',XS(1:NGP,2,BU))
+         CALL LCMGET(KPTH,'X_NU_FI',XS(1:NGP,3,BU))
+         CALL LCMGET(KPTH,'KAPPA_FI',XS(1:NGP,4,BU))
+         IF(LXES)CALL LCMGET(KPTH,'SFI',XS(1:NGP,7,BU))
+         IF(LADF) THEN
+         IF (ADF_T.EQ.'DRA')THEN
+          CALL LCMGET(KPTH,'ADF',ADF(:,:,BU))
+         ELSE IF(ADF_T.EQ.'GEN')THEN
+          CALL LCMGET(KPTH,'FLXL',FLXL(:,BU))
+          CALL LCMGET(KPTH,'FLXR',FLXR(:,BU))
+          CALL LCMGET(KPTH,'CURR',CURR(:,BU))
+          CALL LCMGET(KPTH,'CURL',CURL(:,BU))
+         ENDIF
+         ENDIF
+         IF(LCDF)CALL LCMGET(KPTH,'CDF',CDF(:,:,BU))
+         IF(LGFF)CALL LCMGET(KPTH,'GFF',GFF(:,:,:,BU))
+
+
+         CALL LCMGET(KPTH,'SCAT',SCAT(1:NGP*NGP,BU))
+         IF(DATSRC(3)==1) THEN
+
+          IF((LXES).OR.(LDET)) THEN
+            CALL LCMSIX(KPTH,' ',2)
+            CALL LCMSIX(KPTH,'MICROLIB_XS',1)
+
+            IF(LDET) CALL LCMGET(KPTH,'DET',XS(1:NGP,8,BU))
+            IF (LXES) THEN
+             CALL LCMGET(KPTH,'XENG',XS(1:NGP,5,BU))
+             CALL LCMGET(KPTH,'SMNG',XS(1:NGP,6,BU))
+             CALL LCMGET(KPTH,'XEND',ND(1,BU))
+             CALL LCMGET(KPTH,'SMND',ND(2,BU))
+            ENDIF
+          ENDIF
+          IF((GRID<2).and. (SIGNAT.EQ.'L_SAPHYB')) THEN
+            CALL LCMSIX(IPDAT,' ',0)
+            CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
+            IPTH=LCMGID(IPDAT,'DIVERS')
+            KPTH=LCMDIL(IPTH,BU)
+            CALL LCMGET(KPTH,'KEFF',DIV(1,BU))
+            CALL LCMGET(KPTH,'KINF',DIV(2,BU))
+            CALL LCMGET(KPTH,'B2',DIV(3,BU))
+          ENDIF
+         ENDIF
+      ENDDO
+      IF (LMER.EQ.1) THEN
+       DO I=1,NGP
+        DO BU=1,NBU
+         ADFMOY(I,BU)=SUM(ADF(1:NADF,I,BU))/NADF
+        ENDDO
+       ENDDO
+
+       DO I=1,NGP
+        DO BU=1,NBU
+         SCAT(I,BU)=SCAT(I,BU)/ADFMOY(NGP-1+1,BU)
+         SCAT(I+NGP,BU)=SCAT(I+NGP,BU)/ADFMOY(NGP-I+1,BU)
+         XS(I,1,BU)=XS(I,1,BU)*ADFMOY(I,BU)
+         XS(I,2:NXS,BU)=XS(I,2:NXS,BU)/ADFMOY(I,BU)
+        ENDDO
+       ENDDO
+      ENDIF
+      CALL LCMSIX(IPDAT,' ',0)
+      END
+
+      SUBROUTINE SETXS(  IPHEL, BRANCH, ITBRAN,    XS,     NGP,    NXS,
+     >                     NBU,   BURN, DATSRC,    LXES,  LDET, IPRINT)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Write in the HELIOS.dra file the cross sections for a banch
+* (including all burnup points).
+* This routine write sequentially the HELIOS.dra file, branch after
+* branch.
+*
+*parameters: input
+* IPHEL      file unit of the HELIOS.dra file
+* BRANCH     nature of the current branch ( CR, DC, CB, TC, TM etc )
+* ITBRAN     index of the current branch
+* XS         table of cross sections
+* NGP        number of energy groups
+* NXS        number of cross sections
+* NBU        number of burnup points
+* BURN       set of burnup points
+* IPRINT     control the printing on screen
+* DATSRC     array containing the DATA source (reflector of fuel)
+* LXES       flag for presence of micoscopic cross sections
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER IPHEL,NBU,NXS,NGP,ITBRAN
+!      REAL XS(NGP,NXS,NBU),BURN (NBU),DATSRC(3)
+      REAL XS(NGP,NXS,NBU),BURN (NBU),DATSRC(5)
+      CHARACTER(len=4) BRANCH,XS_name
+      LOGICAL LXES,LDET
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER XST  ! INDEX OF CROSS SECTIONS
+      REAL FA_KIND
+      LOGICAL :: LXS = .TRUE.
+
+      IF(IPRINT>5) WRITE(6,*) 'SETXS: WRITE INFO FOR A BANCH'
+
+      FA_KIND=DATSRC(3)
+
+      ! LOOP OVER CROSS SECTIONS TYPE
+      DO XST=1, NXS
+         LXS = .TRUE.
+         SELECT CASE (XST)
+         CASE (1)
+            XS_name = 'STR'               ! TRANSPORT XS
+         CASE (2)
+            XS_name = 'SAB'               ! ABSORPTION XS
+         CASE (3)
+            XS_name = 'SNF'               ! NU SIGMA FISSION XS
+         CASE (4)
+            XS_name = 'SKF'               ! KAPPA FISSION XS
+         CASE (5)
+            IF(.NOT. LXES) LXS=.FALSE.
+            XS_name = 'XENG'              ! XE MICROSCOPIC ABSORPTION XS
+         CASE (6)
+            IF(.NOT. LXES) LXS=.FALSE.
+            XS_name = 'SMNG'              ! SM MICROSCOPIC ABSORPTION XS
+         CASE (7)
+            IF(.NOT. LXES) LXS=.FALSE.
+            XS_name = 'SFI'               ! FISSION XS
+         CASE (8)
+            IF(.NOT. LDET) LXS=.FALSE.
+            XS_name = 'DET'               ! DETECTOR XS
+         END SELECT
+         IF(LXS) THEN
+          ! LABEL FOR XS TYPE
+          WRITE(IPHEL,'()')
+          WRITE(IPHEL,*) 'List name       : PMAX_FILE_DATA'
+          WRITE(IPHEL,*) 'Labels Array    : PrintVector'
+          WRITE(IPHEL,110) XS_name
+          WRITE(IPHEL,120) XS_name
+
+  110     FORMAT(29H List Title(s)  1) %XS_PRIN %,A)
+  120     FORMAT(34H Meaning : (.-.-E-G-.) G-th Group ,A,
+     1    15H cross sections)
+
+          CALL SET_RIEGO(IPHEL)
+
+         ! LOOP OVER ENERGY GROUPS
+         ! CREATION OF LABEL FOR CROSS SECTIONS
+          DO IT=1, NGP
+           IF(IT==1) THEN
+            WRITE(IPHEL,'(27X,A4,A2)',advance='no') XS_name,'Xs'
+           ELSE IF(IT==NGP .OR. IT==8 ) THEN
+            WRITE(IPHEL,'(5X,A4,A2)')XS_name,'Xs'
+           ELSE
+            WRITE(IPHEL,'(5X,A4,A2)',advance='no')XS_name,'Xs'
+           ENDIF
+          ENDDO
+          DO IT=1, NGP
+           IF(IT==1) THEN
+            WRITE(IPHEL,'(6X,A,12X,A,I1,A)',advance='no')
+     1      'Label E','.-.-E-',IT,'-.'
+           ELSE IF(IT==NGP .OR. IT==8 ) THEN
+            WRITE(IPHEL,'(3X,A,I1,A)')
+     1      '.-.-E-',IT,'-.'
+           ELSE
+            WRITE(IPHEL,'(3X,A,I1,A)',advance='no')
+     1      '.-.-E-',IT,'-.'
+           ENDIF
+          ENDDO
+
+          ! STORE XS DATA IN HELIOS.DRA FILE
+          ! LOOP OVER BURNUP POINTS
+          DO NB=1, NBU
+            WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2),
+     1      ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB))
+            DO NG=1, NGP
+              IF(NG == 1) THEN
+               WRITE(IPHEL,'(ES12.5E2)',advance='no') XS(NG,XST,NB)
+              ELSE IF(NG.NE.NGP) THEN
+               WRITE(IPHEL,'(ES12.5E2)',advance='no') XS(NG,XST,NB)
+              ELSE
+                WRITE(IPHEL,'(ES12.5E2)') XS(NG,XST,NB)
+              ENDIF
+            ENDDO ! NG
+          ENDDO ! NB
+
+  220 FORMAT(I4,1X,A,I4,A,A,I4,A,I5)
+          WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>'
+         ENDIF
+      ENDDO ! XST
+      END
+
+      SUBROUTINE SETADF(  IPHEL, BRANCH, ITBRAN,   ADF,    NADF,   NGP,
+     >                      NBU,   BURN, IPRINT,ADF_T,    FLXR,   FLXL,
+     >                     CURL,                                 CURR )
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Write in the HELIOS.dra file the cross sections for a banch
+* (including all burnup points).
+* This routine write sequentially the HELIOS.dra file, branch after
+* branch.
+*
+*parameters: input
+* IPHEL      file unit of the HELIOS.dra file
+* BRANCH     nature of the current branch ( CR, DC, CB, TC, TM etc )
+* ITBRAN     index of the current branch
+* ADF        Assembly discontinuity factor
+* NADF       number of Assembly discontinuity factor
+* NGP        number of energy groups
+* NBU        number of burnup points
+* BURN       set of burnup points
+* IPRINT  control the printing on screen
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER IPHEL,NBU,NGP,NADF,ITBRAN,NIT,IPRINT
+      REAL ADF(NADF,NGP,NBU),BURN (NBU)
+      REAL FLXR(NGP,NBU),FLXL(NGP,NBU)
+      REAL CURR(NGP,NBU),CURL(NGP,NBU), BNO(NGP,NBU)
+      CHARACTER*3 ADF_T
+      CHARACTER BRANCH*4
+*----
+*  LOCAL ARGUMENTS
+*----
+      INTEGER IT,ITA
+      REAL ADF_TMP(NADF,NGP,NBU)
+      CHARACTER*4 BOUND
+      CHARACTER*12 LABEL,XSPRIN
+
+      IF(IPRINT>5) WRITE(6,*) 'SETADF: RECOVER ADF INFO'
+      IF (ADF_T.EQ.'DRA') THEN
+      NIT=0
+      IF((NADF.NE.1) .AND. (NADF.NE.4)) THEN
+          WRITE(6,*) "NUMBER OF ADF : ",NADF
+          CALL XABORT (" NUMBER OF ADF MUST BE 4 (SEL/GET/DRA) OR 1 "
+     >  //"(DRA)")
+      ELSE IF(NADF == 4) THEN
+         ! CASE FOR SEL OR GET ADF
+         ! REARRANGEMENT OF ADF ORDER TO MATCH HELIOS iN CASE OD SEL OR
+         ! GET ADF
+         ! SAPHYB SURF => SIDE
+         !        1        N
+         !        2        E
+         !        3        S
+         !        4        W
+         ! HELIOS SURF => SIDE
+         !        1        W
+         !        2        S
+         !        3        E
+         !        4        N
+
+          ADF_TMP(:,:,:)=ADF(:,:,:)
+          ADF(1,:,:)=ADF_TMP(4,:,:)
+          ADF(2,:,:)=ADF_TMP(3,:,:)
+          ADF(3,:,:)=ADF_TMP(2,:,:)
+          ADF(4,:,:)=ADF_TMP(1,:,:)
+      ENDIF
+      NIT =   NGP*NADF
+      ! LABEL FOR XS TYPE : ADF
+      WRITE(IPHEL,'()')
+      WRITE(IPHEL,*) 'List name       : PMAX_FILE_DATA'
+      WRITE(IPHEL,*) 'Labels Array    : PrintVector'
+      WRITE(IPHEL,*) 'List Title(s)  1) %XS_PRIN %SDF 2'
+      WRITE(IPHEL,*)'2) Meaning : (F-.-E-G-.) F-Face, G-Group'
+      IF(NADF==4) THEN
+         WRITE(IPHEL,*)'3)          F=1/2/3/4 denotes W/S/E/N Side'
+      ELSE
+         WRITE(IPHEL,*)'3)          F=1 denotes average ADF'
+      ENDIF
+
+      CALL SET_RIEGO(IPHEL)
+
+      !  LOOP OVER ENERGY GROUPS
+      !  CREATION OF LABEL FOR CROSS SECTIONS
+      ngrp=1
+      nsurf=0
+      DO ITA=1,NIT,7  ! ITA
+       NITTMP=MIN(NIT-ITA+1,7)
+       ngrpb=ngrp
+       nsurfb=nsurf
+       DO IT=1,NITTMP
+          IF((IT==1).AND.(IT.LT.NITTMP)) THEN
+            WRITE(IPHEL,'(30X,A6)',advance='no') 'SideDF'
+          ELSEIF((IT==1).AND.(IT.EQ.NITTMP)) THEN
+            WRITE(IPHEL,'(30X,A6)') 'SideDF'
+          ELSE IF(IT.EQ.NITTMP) THEN
+            WRITE(IPHEL,'(6X,A6)')'SideDF'
+          ELSE
+            WRITE(IPHEL,'(6X,A6)',advance='no')'SideDF'
+          ENDIF
+       ENDDO
+
+       DO IT=1,NITTMP
+         nsurf=nsurf+1
+         IF(nsurf.GT.NADF) THEN
+           nsurf=1
+           ngrp=ngrp+1
+         ENDIF
+         IF((IT==1).AND.(IT.LT.NITTMP)) THEN
+           WRITE(IPHEL,'(6X,A,14X,I1,A,I1,A)',advance='no')
+     >        'Label E',nsurf,'-.-E-',ngrp,'-.'
+         ELSEIF((IT==1).AND.(IT.EQ.NITTMP)) THEN
+           WRITE(IPHEL,'(6X,A,14X,I1,A,I1,A)')
+     >        'Label E',nsurf,'-.-E-',ngrp,'-.'
+         ELSE IF(IT.EQ.NITTMP) THEN
+           WRITE(IPHEL,'(3X,I1,A,I1,A)') nsurf,'-.-E-',ngrp,'-.'
+         ELSE
+           WRITE(IPHEL,'(3X,I1,A,I1,A)',advance='no')
+     >         nsurf,'-.-E-',ngrp,'-.'
+         ENDIF
+       ENDDO
+
+      ! STORE XS DATA IN HELIOS.DRA FILE
+      ! LOOP OVER BURNUP POINTS
+
+       DO NB=1,NBU
+         ngrp=ngrpb
+         nsurf=nsurfb
+         WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2),
+     1   ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB))
+         DO IT=1,NITTMP
+           nsurf=nsurf+1
+           IF(nsurf.GT.NADF) THEN
+             nsurf=1
+             ngrp=ngrp+1
+           ENDIF
+! in xs_helios_read.f90
+! l1015    READ(XS_set_unit,hfnF5) rvector(1:RIEGO%how_many_data)
+! in xs_heliosM.f90
+! l104         hfnF5='(  X,8F13.5)        '
+           IF(IT.EQ.NITTMP) THEN
+             WRITE(IPHEL,'(5X,F7.5)') ADF(nsurf,ngrp,NB)
+           ELSE
+             WRITE(IPHEL,'(5X,F7.5)',advance='no') ADF(nsurf,ngrp,NB)
+           ENDIF
+         ENDDO
+       ENDDO
+
+       WRITE(IPHEL,*)
+      ENDDO
+
+
+      WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>'
+      ELSE IF (ADF_T.EQ.'GEN') THEN
+       DO I=1,4
+       SELECT CASE (I)
+       CASE(1)
+        XSPRIN='%PHW 1'
+        BOUND='West'
+        LABEL='FluxWest'
+        BNO=FLXL
+       CASE(2)
+        XSPRIN='%PHE 1'
+        BOUND='East'
+        LABEL='FluxEast'
+        BNO=FLXR
+       CASE(3)
+        XSPRIN='%JNW 1'
+        BOUND='West'
+        LABEL='JnetWest'
+        BNO=CURL
+       CASE(4)
+        XSPRIN='%JNE 1'
+        BOUND='East'
+        LABEL='JnetEast'
+        BNO=CURR
+       END SELECT
+       WRITE(IPHEL,'()')
+       WRITE(IPHEL,*) 'List name       : PMAX_FILE_DATA'
+       WRITE(IPHEL,*) 'Labels Array    : PrintVector'
+       WRITE(IPHEL,*) 'List Title(s)  1) %XS_PRIN ',XSPRIN
+       WRITE(IPHEL,'(16X,3A)')'2) Meaning : (E-.-E-G-.) ',
+     >  BOUND,'-Face, G-Group'
+
+       CALL SET_RIEGO(IPHEL)
+       WRITE(IPHEL,'(31X,A8,4X,A8)') LABEL,LABEL
+       WRITE(IPHEL,'(18X,A)') 'Label E   1-.-E-1-.   1-.-E-2-.'
+       DO NB=1,NBU
+         WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2),
+     1   ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB))
+        WRITE(IPHEL,'(ES12.5E2,1X,ES11.4E2)') BNO(:,NB)
+        WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>'
+       ENDDO
+       ENDDO
+      ENDIF
+  220 FORMAT(I4,1X,A,I4,A,A,I4,A,I5)
+      END
+
+      SUBROUTINE SETCDF(  IPHEL, BRANCH, ITBRAN,   CDF,    NCDF,   NGP,
+     >                      NBU,   BURN, IPRINT                       )
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Write in the HELIOS.dra file the cross sections for a banch
+* (including all burnup points).
+* This routine write sequentially the HELIOS.dra file, branch after
+* branch.
+*
+*parameters: input
+* IPHEL      file unit of the HELIOS.dra file
+* BRANCH     nature of the current branch ( CR, DC, CB, TC, TM etc )
+* ITBRAN     index of the current branch
+* CDF        Corner discontinuity factor
+* NCDF       number of corner discontinuity factor
+* NGP        number of energy groups
+* NBU        number of burnup points
+* BURN       set of burnup points
+* IPRINT  control the printing on screen
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER IPHEL,NBU,NGP,NCDF,ITBRAN,NIT,IPRINT
+      REAL CDF(NCDF,NGP,NBU),BURN (NBU)
+      CHARACTER BRANCH*4
+*----
+*  LOCAL ARGUMENTS
+*----
+      INTEGER IT,ITA
+
+      IF(IPRINT>5) WRITE(6,*) 'SETCDF: RECOVER CDF INFO'
+      NIT =   NGP*NCDF
+
+      ! LABEL FOR XS TYPE : CDF
+      WRITE(IPHEL,'()')
+      WRITE(IPHEL,*) 'List name       : PMAX_FILE_DATA'
+      WRITE(IPHEL,*) 'Labels Array    : PrintVector'
+      WRITE(IPHEL,*) 'List Title(s)  1) %XS_PRIN %CDF'
+      WRITE(IPHEL,*)'2) Meaning : (F-.-E-G-.) F-Face, G-Group'
+      IF(NCDF==1) THEN
+         WRITE(IPHEL,*)'3)           F=1 denotes average CDF'
+      ELSE
+         WRITE(IPHEL,*)'3)         F= custom'
+      ENDIF
+
+      CALL SET_RIEGO(IPHEL)
+
+      !  LOOP OVER ENERGY GROUPS
+      !  CREATION OF LABEL FOR CROSS SECTIONS
+      ngrp=1
+      nsurf=0
+      DO ITA=1,NIT,7  ! ITA
+       NITTMP=MIN(NIT-ITA+1,7)
+       ngrpb=ngrp
+       nsurfb=nsurf
+       DO IT=1,NITTMP
+          IF((IT==1).AND.(IT.LT.NITTMP)) THEN
+            WRITE(IPHEL,'(30X,A6)',advance='no') 'CornDF'
+          ELSEIF((IT==1).AND.(IT.EQ.NITTMP)) THEN
+            WRITE(IPHEL,'(30X,A6)') 'CornDF'
+          ELSE IF(IT.EQ.NITTMP) THEN
+            WRITE(IPHEL,'(6X,A6)')'CornDF'
+          ELSE
+            WRITE(IPHEL,'(6X,A6)',advance='no')'CornDF'
+          ENDIF
+       ENDDO
+
+       DO IT=1,NITTMP
+         nsurf=nsurf+1
+         IF(nsurf.GT.NCDF) THEN
+           nsurf=1
+           ngrp=ngrp+1
+         ENDIF
+         IF((IT==1).AND.(IT.LT.NITTMP)) THEN
+           WRITE(IPHEL,'(6X,A,15X,I1,A,I1,A)',advance='no')
+     >        'Label E',nsurf,'-.-E-',ngrp,'-.'
+         ELSEIF((IT==1).AND.(IT.EQ.NITTMP)) THEN
+           WRITE(IPHEL,'(6X,A,15X,I1,A,I1,A)')
+     >        'Label E',nsurf,'-.-E-',ngrp,'-.'
+         ELSE IF(IT.EQ.NITTMP) THEN
+           WRITE(IPHEL,'(2X,I1,A,I1,A)') nsurf,'-.-E-',ngrp,'-.'
+         ELSE
+           WRITE(IPHEL,'(2X,I1,A,I1,A)',advance='no')
+     >         nsurf,'-.-E-',ngrp,'-.'
+         ENDIF
+       ENDDO
+
+      ! STORE XS DATA IN HELIOS.DRA FILE
+      ! LOOP OVER BURNUP POINTS
+
+
+       DO NB=1,NBU
+         ngrp=ngrpb
+         nsurf=nsurfb
+         WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2),
+     1   ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB))
+         DO IT=1,NITTMP
+           nsurf=nsurf+1
+           IF(nsurf.GT.NCDF) THEN
+             nsurf=1
+             ngrp=ngrp+1
+           ENDIF
+! in xs_helios_read.f90 l1015    READ(XS_set_unit,hfnF5) rvector(1:RIEGO
+! in xs_heliosM.f90 l104         hfnF5='(  X,8F13.5)        '
+           IF(IT.EQ.NITTMP) THEN
+             WRITE(IPHEL,'(5X,F7.5)') CDF(nsurf,ngrp,NB)
+           ELSE
+             WRITE(IPHEL,'(5X,F7.5)',advance='no') CDF(nsurf,ngrp,NB)
+           ENDIF
+         ENDDO
+       ENDDO
+
+       WRITE(IPHEL,*)
+      ENDDO
+
+
+  220 FORMAT(I4,1X,A,I4,A,A,I4,A,I5)
+      WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>'
+
+      END
+
+      SUBROUTINE SETGFF(  IPHEL, BRANCH, ITBRAN,   GFF,  NCOLA,  NROWA,
+     >                    NPART,    NGP,    NBU,   BURN, NGFF , IPRINT,
+     >                     VERS)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Write in the HELIOS.dra file the cross sections for a banch
+* (including all burnup points).
+* This routine write sequentially the HELIOS.dra file, branch after
+* branch.
+*
+*parameters: input
+* IPHEL      file unit of the HELIOS.dra file
+* BRANCH     nature of the current branch ( CR, DC, CB, TC, TM etc )
+* ITBRAN     index of the current branch
+* GFF        Group form factor
+* NCOLA      number of pin in assembly along x-axis
+* NROWA      number of pin in assembly along y-axis
+* NPART      symmetry level of assembly
+*               0        1        2        3
+*               whole    half     quarter  eight
+* PARCS Version 32.17 and GenPMAXS 6.1
+*               123XXXX  1......  123X...  1......
+*               XXXXXXX  23.....  XXXX...  23.....
+*               XXXXXXX  XXX....  XXXX...  XXX....
+*               XXXXXXX  XXXX...  XXXn...  XXXn...
+*               XXXXXXX  XXXXX..  .......  .......
+*               XXXXXXX  XXXXXX.  .......  .......
+*               XXXXXXn  XXXXXXn  .......  .......
+*              Note: Helios format is different from the documentation
+*              provided in GenPMAXS.
+* Version 32.18 and GenPMAXS 6.2
+*               123XXXX  1......  .......  .......
+*               XXXXXXX  23.....  .......  .......
+*               XXXXXXX  XXX....  .......  .......
+*               XXXXXXX  XXXX...  ...123X  ...1...
+*               XXXXXXX  XXXXX..  ...XXXX  ...23..
+*               XXXXXXX  XXXXXX.  ...XXXX  ...XXX.
+*               XXXXXXn  XXXXXXn  ...XXXn  ...XXXn
+*              Note: Helios format is the same as in the documentation
+*              provided in GenPMAXS.
+* NGP        number of energy groups
+* NBU        number of burnup points
+* BURN       set of burnup points
+* IPRINT  control the printing on screen
+* VERS       version of PARCS to be used
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER IPHEL,NBU,NGP,ITBRAN,NIT,IPRINT,NGFF
+      REAL GFF(NCOLA,NROWA,NGP,NBU),BURN (NBU),VERS
+      CHARACTER BRANCH*4
+*----
+*  LOCAL ARGUMENTS
+*----
+      INTEGER IT,ITA,ipxn,ipyn
+
+      IF(IPRINT>5) WRITE(6,*) 'SETGFF: RECOVER GFF INFO'
+      NIT   = NGP*NCOLA*NROWA
+      NPIN2 = NCOLA*NROWA
+      NCOLA2= 1
+      ipxn=1
+      ipyn=1
+      IF((NPART.GE.1).AND.(NCOLA.NE.NROWA))THEN
+        CALL XABORT('@D2PBRA: NPART > 0 and  NCOLA.NE.NROWA')
+      ENDIF
+      IF(NPART.EQ.1)THEN
+        NIT=NGP*NCOLA*(NCOLA+1)/2
+        NPIN2 = NCOLA*(NCOLA+1)/2
+      ELSEIF(NPART.EQ.2)THEN
+        NCOLA2=CEILING(REAL(NCOLA)/2)
+        NIT=NGP*NCOLA2*NCOLA2
+        NPIN2 = NCOLA2*NCOLA2
+      ELSEIF(NPART.EQ.3)THEN
+        NCOLA2=CEILING(REAL(NCOLA)/2)
+        NIT=NGP*NCOLA2*(NCOLA2+1)/2
+        NPIN2 = NCOLA2*(NCOLA2+1)/2
+      ENDIF
+      IF((VERS.GE.3.2018).AND.(NPART.GE.2))THEN
+        ipxn=CEILING(REAL(NCOLA)/2)
+        ipyn=CEILING(REAL(NCOLA)/2)
+        NCOLA2=NCOLA
+      ENDIF
+      IF (NGFF.NE.NPIN2) THEN
+       WRITE (6,*) '@D2PBRA: INCOHERENT NUMBER OF GFF IN MCO (',
+     > NGFF,') AND COMPUTED PART OF ASSEMBLY (PART =',
+     > NPART,').'
+      CALL XABORT ('')
+      ENDIF
+      ! LABEL FOR XS TYPE: GFF
+      WRITE(IPHEL,'()')
+      WRITE(IPHEL,*) 'List name       : PMAX_FILE_DATA'
+      WRITE(IPHEL,*) 'Labels Array    : PrintVector'
+      WRITE(IPHEL,*) 'List Title(s)  1) %XS_GFF %GFF 1 '
+      WRITE(IPHEL,*)'2) Meaning : (F-.-E-G-.) F-Face, G-Group'
+      WRITE(IPHEL,*)'3)         F=1 to NPIN*NPIN average GFF'
+
+      CALL SET_RIEGO(IPHEL)
+
+      !  LOOP OVER ENERGY GROUPS
+      !  CREATION OF LABEL FOR CROSS SECTIONS
+      ngrp=1
+      nsurf=0
+      ipx=ipxn-1
+      ipy=ipyn
+      DO ITA=1,NIT,7  ! ITA
+       NITTMP=MIN(NIT-ITA+1,7)
+       ngrpb=ngrp
+       nsurfb=nsurf
+       ipxb=ipx
+       ipyb=ipy
+       DO IT=1,NITTMP
+          IF((IT==1).AND.(IT.LT.NITTMP)) THEN
+            WRITE(IPHEL,'(33X,A6)',advance='no') 'GNorRR'
+          ELSEIF((IT==1).AND.(IT.EQ.NITTMP)) THEN
+            WRITE(IPHEL,'(33X,A6)') 'GNorRR'
+          ELSE IF(IT.EQ.NITTMP) THEN
+            WRITE(IPHEL,'(8X,A6)')'GNorRR'
+          ELSE
+            WRITE(IPHEL,'(8X,A6)',advance='no')'GNorRR'
+          ENDIF
+       ENDDO
+       DO IT=1,NITTMP
+         nsurf=nsurf+1
+         IF(nsurf.GT.NPIN2) THEN
+           nsurf=1
+           ngrp=ngrp+1
+         ENDIF
+         IF((IT==1).AND.(IT.LT.NITTMP)) THEN
+           WRITE(IPHEL,'(6X,A,12X,I3,A,I1,A)',advance='no')
+     >        'Label E',nsurf,'-.-E-',ngrp,'-.'
+         ELSEIF((IT==1).AND.(IT.EQ.NITTMP)) THEN
+           WRITE(IPHEL,'(6X,A,12X,I3,A,I1,A)')
+     >        'Label E',nsurf,'-.-E-',ngrp,'-.'
+         ELSE IF(IT.EQ.NITTMP) THEN
+           WRITE(IPHEL,'(1X,I3,A,I1,A)') nsurf,'-.-E-',ngrp,'-.'
+         ELSE
+           WRITE(IPHEL,'(1X,I3,A,I1,A)',advance='no')
+     >         nsurf,'-.-E-',ngrp,'-.'
+         ENDIF
+       ENDDO
+      ! STORE XS DATA IN HELIOS.DRA FILE
+      ! LOOP OVER BURNUP POINTS
+
+
+       DO NB=1,NBU
+         ngrp=ngrpb
+         nsurf=nsurfb
+         ipx=ipxb
+         ipy=ipyb
+         WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2),
+     1   ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB))
+         DO IT=1,NITTMP
+           ipx=ipx+1
+           IF(((NPART.EQ.0).AND.(ipx.GT.NCOLA)).OR.
+     >        ((NPART.EQ.2).AND.(ipx.GT.NCOLA2)).OR.
+     >        (((NPART.EQ.1).OR.(NPART.EQ.3)).AND.(ipx.GT.ipy)))THEN
+             ipx=ipxn
+             ipy=ipy+1
+           ENDIF
+           nsurf=nsurf+1
+           IF(nsurf.GT.NPIN2) THEN
+             nsurf=1
+             ngrp=ngrp+1
+             ipy=ipxn
+             ipx=ipyn
+           ENDIF
+! in xs_helios_read.f90 l1015    READ(XS_set_unit,hfnE4) rvector(1:RIEGO
+! in xs_heliosM.f90 l104         hfnF5='(  X,8F13.5)        '
+!                   l114         hfnE4=hfnE5
+!                   l115         hfnE4(11:11)='4'
+           IF(IT.EQ.NITTMP) THEN
+             WRITE(IPHEL,'(5X,F7.4)') GFF(ipx,ipy,ngrp,NB)
+           ELSE
+             WRITE(IPHEL,'(5X,F7.4)',advance='no') GFF(ipx,ipy,ngrp,NB)
+           ENDIF
+         ENDDO
+       ENDDO
+
+       WRITE(IPHEL,*)
+      ENDDO
+
+
+  220 FORMAT(I4,1X,A,I4,A,A,I4,A,I5)
+      WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>'
+
+
+      END
+
+      SUBROUTINE SETSCT(IPHEL,BRANCH,ITBRAN,SCAT,NGP,NBU,BURN,IPRINT)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Write in the HELIOS.dra file the scattering cross sections for a banch
+* (including all burnup points).
+* This routine write sequentially the HELIOS.dra file, branch after
+* branch.
+*
+*parameters: input
+* IPHEL      file unit of the HELIOS.dra file
+* BRANCH     nature of the current branch ( CR, DC, CB, TC, TM etc )
+* ITBRAN     index of the current branch
+* SCAT       table of elements of scattering matrix
+* NGP        number of energy groups
+* NBU        number of burnup points
+* BURN       set of burnup points
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER IPHEL,NBU,NGP,ITBRAN,IPRINT
+      REAL SCAT(NGP*NGP,NBU),BURN (NBU)
+
+      CHARACTER BRANCH*2
+
+*----
+*  LOCAL ARGUMENTS
+*----
+      INTEGER IT,G,I
+      REAL SCATTMP(8,NBU)
+      CHARACTER*45 LABEL
+      CHARACTER*45 LABELE
+      CHARACTER*210 :: TOTLABELE = ''
+      CHARACTER*210 :: TOTLABEL = ''
+
+      IF(IPRINT>5) WRITE(6,*) 'SETSCT: WRITE SCATTERING INFO'
+
+      ! LABEL FOR SCATTERING XS
+      WRITE(IPHEL,'()')
+      WRITE(IPHEL,*) 'List name       : PMAX_FILE_DATA'
+      WRITE(IPHEL,*) 'Labels Array    : PrintVector'
+      WRITE(IPHEL,110) '%SCT'
+      WRITE(IPHEL,*)'Meaning : (.-.-E-G-O) From O to G-th Group scat'
+
+      CALL SET_RIEGO(IPHEL)
+      IT=1
+      ITT=1
+      I=0
+      ! CREATION OF HEADER FOR SCATTERING BLOCK IN HELIOS.DRA FILE
+
+          DO G=1,NGP
+           DO J=1, NGP
+             IF (IT==1) THEN
+              TOTLABELE = ''
+              TOTLABEL = ''
+              WRITE(LABELE,'(6X,A7,14X)') 'Label E'
+              TOTLABELE=TOTLABELE(1:len( trim(TOTLABELE) ))
+     1        // LABELE
+             ENDIF
+             IF (IT==1) THEN
+              WRITE(LABEL,'(25X,A)')'ScattMatrix'
+              WRITE(LABELE,'(12X,A,I1,A,I1)')
+     1        '1-.-E-',G,'-',J
+             ELSE
+              WRITE(LABEL,'(1X,A)')'ScattMatrix'
+              WRITE(LABELE,'(3X,A,I1,A,I1)')
+     1        '1-.-E-',G,'-',J
+             ENDIF
+             SCATTMP(IT,:)=SCAT(ITT,:)
+             TOTLABEL=TOTLABEL(1:len( trim(TOTLABEL) ))
+     >        //LABEL
+             TOTLABELE=TOTLABELE(1:len( trim(TOTLABELE) ))
+     >        //LABELE
+
+             IF ((IT==8).OR.(ITT==NGP*NGP)) THEN
+              WRITE(IPHEL,'(A)') TOTLABEL
+              WRITE(IPHEL,'(A)') TOTLABELE
+              DO NB=1, NBU
+               WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2),
+     1         ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB))
+               WRITE(IPHEL,'(8(ES12.5E2))')SCATTMP(1:IT,NB)
+              ENDDO
+              WRITE (IPHEL,*)
+              TOTLABELE = ''
+              TOTLABEL = ''
+              IT=1
+             ELSE
+              IT=IT+1
+             ENDIF
+
+             ITT=ITT+1
+            ENDDO
+           ENDDO
+
+  !     DO JT=1, NGP
+  !      IF(IT==1 .and. JT==1) THEN
+  !         WRITE(IPHEL,'(28X,A)',advance='no') 'ScattMatrix'
+  !      ELSE IF((IT==(NGP).and.JT==(NGP)) .OR. JT==7 ) THEN
+  !         WRITE(IPHEL,'(3X,A)')'ScattMatrix'
+  !      ELSE
+  !         WRITE(IPHEL,'(3X,A)',advance='no')'ScattMatrix'
+  !      ENDIF
+  !     ENDDO
+  !   DO IT=1, NGP
+  !     DO JT=1, NGP
+  !       IF(IT==1 .and. JT==1) THEN
+  !         WRITE(IPHEL,'(6X,A,14X,A,I1,A,I1)',advance='no')
+  !  1       'Label E','1-.-E-',JT,'-',IT
+  !       ELSE IF((IT==(NGP).and.JT==(NGP)) .OR. JT==8 ) THEN
+  !         WRITE(IPHEL,'(5X,A,I1,A,I1)')
+  !  1       '1-.-E-',JT,'-',IT
+  !       ELSE
+  !         WRITE(IPHEL,'(5X,A,I1,A,I1)',advance='no')
+  !  1       '1-.-E-',JT,'-',IT
+  !       ENDIF
+  !     ENDDO
+  !   ENDDO
+  !
+  !   DO NB=1, NBU
+  !       WRITE(IPHEL,220,advance='no') NB,'t',BRANCH(1:2),
+  !  1    ITBRAN,'(s',BRANCH(1:2),ITBRAN,'):',NINT(BURN(NB))
+  !       DO IG=1, NGP*NGP
+  !         IF(IG == 1) THEN
+  !          WRITE(IPHEL,'(3X,ES11.5E2)',advance='no') SCAT(IG,NB)
+  !         ELSE IF(IG.EQ.NGP*NGP) THEN
+  !           WRITE(IPHEL,'(3X,ES11.5E2)') SCAT(IG,NB)
+  !         ELSE IF(IG.EQ.8  ) THEN
+  !          WRITE(IPHEL,'(3X,ES11.5E2)') SCAT(IG,NB)
+  !         ELSE
+  !          WRITE(IPHEL,'(3X,ES11.5E2)',advance='no') SCAT(IG,NB)
+  !         ENDIF
+  !       ENDDO
+  !   ENDDO
+
+  110 FORMAT(28H List Title(s)  1) %XS_SCT  ,A)
+  220 FORMAT(I4,1X,A,I4,A,A,I4,A,I5)
+      WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>'
+      END
+
+      SUBROUTINE SETND(IPHEL,BRANCH,ITBRAN,ND,NBU,BURN,IPRINT)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Write in the HELIOS.dra file the scattering cross sections for a banch
+* (including all burnup points).
+* This routine write sequentially the HELIOS.dra file, branch after
+* branch.
+*
+*parameters: input
+* IPHEL      file unit of the HELIOS.dra file
+* BRANCH     nature of the current branch ( CR, DC, CB, TC, TM etc )
+* ITBRAN     index of the current branch
+* NGP        number of energy groups
+* NBU        number of burnup points
+* ND         number densities for Xenon and samarium : KEFF , KINF, B2
+* BURN       set of burnup points
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER IPHEL,NBU,ITBRAN,IPRINT
+      REAL ND(2,NBU),BURN (NBU)
+      CHARACTER BRANCH*2
+*----
+*  LOCAL ARGUMENTS
+*----
+      INTEGER NB
+
+      IF(IPRINT>5) WRITE(6,*) 'SETND: WRITE HEADER FOR XENON DENSITY'
+
+      ! CREATION OF HEADER FOR XENON DENSITY
+      WRITE(IPHEL,'()')
+      WRITE(IPHEL,*) 'List name       : PMAX_FILE_DATA'
+      WRITE(IPHEL,*) 'Labels Array    : PrintVector'
+      WRITE(IPHEL,*) 'List Title(s)  1) %XS_XESM %XEND'
+      WRITE(IPHEL,*)'Meaning : Xe-135 Number Density [/cm.barn]'
+
+      CALL SET_RIEGO(IPHEL)
+
+      WRITE(IPHEL,'(31X,A)') 'nXe'
+      WRITE(IPHEL,'(6X,A,12X,A)') 'Label E','1-1-E-.-.'
+
+      ! LOOP OVER BUNRNUP
+      DO NB=1,NBU
+              WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2),
+     1        ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB))
+        WRITE(IPHEL,'(ES12.5E2)') ND(1,NB)
+      ENDDO
+
+      WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>'
+
+      ! CREATION OF HEADER FOR SAMARIUM DENSITY
+      WRITE(IPHEL,'()')
+      WRITE(IPHEL,*) 'List name       : PMAX_FILE_DATA'
+      WRITE(IPHEL,*) 'Labels Array    : PrintVector'
+      WRITE(IPHEL,*) 'List Title(s)  1) %XS_XESM %SMND'
+      WRITE(IPHEL,*)'Meaning : SM-149 Number Density [/cm.barn]'
+
+      CALL SET_RIEGO(IPHEL)
+
+      WRITE(IPHEL,'(27X,A)')  'nSm'
+      WRITE(IPHEL,'(6X,A,12X,A)') 'Label E','1-1-E-.-.'
+
+      ! LOOP OVER BUNRNUP
+      DO NB=1,NBU
+              WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2),
+     1        ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB))
+         WRITE(IPHEL,'(ES12.5E2)') ND(2,NB)
+      ENDDO
+      WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>'
+
+  220 FORMAT(I4,1X,A,I4,A,A,I4,A,I5)
+      END
+
+      SUBROUTINE SETDIV(IPHEL,BRANCH,ITBRAN,DIV,NBU,BURN,IPRINT)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Write in the HELIOS.dra file the scattering cross sections for a banch
+*  (including all burnup points).
+* This routine write sequentially the HELIOS.dra file, branch after
+* branch.
+*
+*parameters: input
+* IPHEL      file unit of the HELIOS.dra file
+* BRANCH     nature of the current branch ( CR, DC, CB, TC, TM etc )
+* ITBRAN     index of the current branch
+* NGP     number of energy groups
+* NBU        number of burnup points
+* DIV        conttnent of DIV table : KEFF , KINF, B2
+* BURN       set of burnup points
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER IPHEL,NBU,ITBRAN,IPRINT
+      REAL DIV(3,NBU),BURN (NBU)
+      CHARACTER BRANCH*2
+*----
+*  LOCAL ARGUMENTS
+*----
+      INTEGER NB
+      REAL M2
+
+      IF(IPRINT>5) WRITE(6,*) 'SETDIV: WRITE HEADER FOR DIVERS INFO'
+
+      ! CREATION OF HEADER FOR DIVERS INFO (B2, KEFF, KINF)
+      WRITE(IPHEL,'()')
+      WRITE(IPHEL,*) 'List name       : PMAX_FILE_DATA'
+      WRITE(IPHEL,*) 'Labels Array    : KINF'
+      WRITE(IPHEL,*) 'List Title(s)  1) %XS_PRIN %KINF'
+      WRITE(IPHEL,*)' Meaning : K-eff, K-inf, M^2, B^2 [cm^-2]  '
+
+      CALL SET_RIEGO(IPHEL)
+
+      WRITE(IPHEL,'(27X,A,10X,A,6X,A,6X,A)') 'K-EFF','KINF',
+     1  'MigrArea','CritArea'
+      WRITE(IPHEL,'(6X,A,12X,A,5X,A,5X,A,5X,A)')
+     1       'Label E','.-.-E-.-.','.-.-E-.-.','.-.-E-.-.','.-.-E-.-.'
+      ! LOOP OVER BURNUP POINTS
+      DO NB=1,NBU
+         M2=(DIV(2,NB)-1)/(DIV(3,NB))
+              WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2),
+     1        ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB))
+         WRITE(IPHEL,'(5X,F7.5,5X,F7.5,ES12.5E2,ES12.5E2)')
+     1    DIV(1,NB),DIV(2,NB),M2,DIV(3,NB)
+      ENDDO
+      WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>'
+
+  220 FORMAT(I4,1X,A,I4,A,A,I4,A,I5)
+       END
+
+       SUBROUTINE SETTH(  IPHEL, BRANCH, ITBRAN,  BURN,     NBU, JOBOPT,
+     >                      NGP,  IPDAT, IPRINT                        )
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Write in the HELIOS.dra file the invaraint TH DATA for a banch
+* (including all burnup points).
+* This routine write sequentially the HELIOS.dra file, branch after
+* branch.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      TYPE(C_PTR) IPDAT,IPTH,KPTH
+      INTEGER :: DIM_LAMBDA = 6
+      INTEGER NGP,ILONG
+      INTEGER ITYLCM,NBU,ITBRAN
+      CHARACTER (len=4) BRANCH,DLAY
+      CHARACTER JOBOPT(16)
+      INTEGER :: BU = 1
+      REAL BURN(NBU)
+      REAL YLDXe(NBU),YLDPm(NBU),YLDI(NBU)
+      REAL OVERV(NGP,NBU),CHI(NGP,NBU),LAMBDA(6,NBU),BETA(6,NBU)
+      LOGICAL :: LAMB = .FALSE.
+      LOGICAL :: LCHI = .FALSE.
+      LOGICAL :: LYLD = .FALSE.
+      LOGICAL :: LINV = .FALSE.
+      LOGICAL :: LBET = .FALSE.
+
+      IF(IPRINT>5) WRITE(6,*) 'SETTH: WRITE TH DATA'
+
+      ! RECOVER FLAG INFORMATION
+      IF(JOBOPT(5)=='T') LCHI = .TRUE.
+      IF(JOBOPT(7)=='T') LINV = .TRUE.
+      IF(JOBOPT(9)=='T') LYLD = .TRUE.
+      IF(JOBOPT(13)=='T') LAMB = .TRUE.
+      IF(JOBOPT(12)=='T') LBET = .TRUE.
+
+      IF(NGP>2)THEN
+        CALL XABORT('@D2P: NGP > 2 NOT IMPLEMENTED FOR T/H BLOCK')
+      ENDIF
+
+      CALL LCMSIX(IPDAT,' ',0)
+      IPTH=LCMGID(IPDAT,'TH_DATA')
+
+      DO BU=1,NBU
+         KPTH=LCMDIL(IPTH,BU)
+
+         IF(LCHI) THEN
+          IF(BU ==1) THEN
+           CALL LCMLEN(KPTH,'CHI',ILONG,ITYLCM)
+           IF  (ILONG .NE. NGP) THEN
+            CALL XABORT (' MORE THAN 2 (NGP) VALUES FOR CHI RECORD')
+           ENDIF
+          ENDIF
+          CALL LCMGET(KPTH,'CHI',CHI(1:NGP,BU))
+
+         ENDIF
+
+         IF(LINV) THEN
+          CALL LCMGET(KPTH,'OVERV',OVERV(1:NGP,BU))
+
+         ENDIF
+
+         IF(LYLD) THEN
+          CALL LCMGET(KPTH,'YLDPm',YLDPm(BU))
+          CALL LCMGET(KPTH,'YLDXe',YLDXe(BU))
+          CALL LCMGET(KPTH,'YLDI',YLDI(BU))
+
+         ENDIF
+
+         IF(LAMB)THEN
+          IF(BU == 1) THEN
+           CALL LCMLEN(KPTH,'LAMBDA',ILONG,ITYLCM)
+           IF  (ILONG .NE. DIM_LAMBDA) THEN
+            CALL XABORT('MORE THAN 6 (NDLAY) VALUES FOR LAMBDA RECORD')
+           ENDIF
+          ENDIF
+          CALL LCMGET(KPTH,'LAMBDA',LAMBDA(1:DIM_LAMBDA,BU))
+         ENDIF
+
+         IF(LBET)THEN
+          IF(BU == 1) THEN
+           CALL LCMLEN(KPTH,'BETA',ILONG,ITYLCM)
+           IF  (ILONG .NE. DIM_LAMBDA) THEN
+            CALL XABORT('MORE THAN 6 (NDLAY) VALUES FOR BETA RECORD')
+           ENDIF
+          ENDIF
+          CALL LCMGET(KPTH,'BETA',BETA(1:DIM_LAMBDA,BU))
+         ENDIF
+      ENDDO
+
+      IF(LCHI) CALL SET_CHI(IPHEL,BRANCH,ITBRAN,BURN,CHI,NGP,NBU)
+      IF(LINV) CALL SET_OVERV(IPHEL,BRANCH,ITBRAN,BURN,OVERV,NGP,NBU)
+      IF(LYLD) CALL SET_YIELD(IPHEL,BRANCH,ITBRAN,BURN,YLDPm,YLDXe,
+     >  YLDI,NBU)
+      IF(LAMB) THEN
+        DLAY='LAMB'
+        CALL SET_DLAY(IPHEL,BRANCH,ITBRAN,BURN,LAMBDA,DIM_LAMBDA,DLAY,
+     >  NBU)
+      ENDIF
+      IF(LBET) THEN
+        DLAY='BETA'
+        CALL SET_DLAY(IPHEL,BRANCH,ITBRAN,BURN,BETA,DIM_LAMBDA,DLAY,NBU)
+      ENDIF
+      END
+
+      SUBROUTINE SET_CHI(IPHEL,BRANCH,ITBRAN,BURN,CHI,DIM_CHI,NBU)
+      INTEGER DIM_CHI,NBU,ITBRAN,NB
+      REAL CHI(DIM_CHI,NBU),BURN(NBU)
+      CHARACTER (len=4) BRANCH
+
+      WRITE(IPHEL,'()')
+      WRITE(IPHEL,*) 'List name       : PMAX_FILE_DATA'
+      WRITE(IPHEL,*) 'Labels Array    : PrintVector'
+      WRITE(IPHEL,*) 'List Title(s)  1) %XS_PRIN %CHI'
+      WRITE(IPHEL,*) 'Meaning :(.-.-E-G-.) G-th Group Fission Spect'
+
+      CALL SET_RIEGO(IPHEL)
+
+      WRITE(IPHEL,'(31X,A3,11X,A3)') 'chi','chi'
+      WRITE(IPHEL,'(6X,A,12X,A,5X,A)') 'Label E','1-.-E-1-.','1-.-E-2-.'
+      ! LOOP OVER burnup points
+      DO NB=1,NBU
+         WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2),
+     1   ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB))
+         WRITE(IPHEL,'(ES12.5E2,ES12.5E2)')
+     1   CHI(1:DIM_CHI,NB)
+      ENDDO
+      WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>'
+  220 FORMAT(I4,1X,A,I4,A,A,I4,A,I5)
+      END
+
+      SUBROUTINE SET_OVERV(IPHEL,BRANCH,ITBRAN,BURN,OVERV,NG,NBU)
+      INTEGER NG,NBU,ITBRAN,NB
+      REAL OVERV(NG,NBU),BURN(NBU)
+      CHARACTER (len=4) BRANCH
+
+      WRITE(IPHEL,'()')
+      WRITE(IPHEL,*) 'List name       : PMAX_FILE_DATA'
+      WRITE(IPHEL,*) 'Labels Array    : PrintVector'
+      WRITE(IPHEL,*) 'List Title(s)  1) %XS_PRIN %VEL'
+      WRITE(IPHEL,*) 'Meaning         :'
+      WRITE(IPHEL,*) '(.-.-E-G-.) G-th Group Neutron Velocity [m/s]'
+
+      CALL SET_RIEGO(IPHEL)
+
+      WRITE(IPHEL,'(31X,A3,11X,A3)') 'vel','vel'
+      WRITE(IPHEL,'(6X,A,12X,A,5X,A)') 'Label E','.-.-E-1-.','.-.-E-2-.'
+      ! LOOP OVER burnup points
+      DO NB=1,NBU
+
+         WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2),
+     1   ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB))
+         WRITE(IPHEL,'(ES12.5E2,ES12.5E2)')
+     1   (1/(OVERV(1:NG,NB)))
+      ENDDO
+      WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>'
+  220 FORMAT(I4,1X,A,I4,A,A,I4,A,I5)
+      END
+
+      SUBROUTINE SET_YIELD(IPHEL,BRANCH,ITBRAN,BURN,YLDPm,YLDXe,YLDI,
+     1 NBU)
+      INTEGER NBU,ITBRAN,NB,I,iXe,iPm,iI
+      REAL YLDPm(NBU), YLDXe(NBU),YLDI(NBU),BURN(NBU)
+      REAL YLD(NBU)
+      CHARACTER (len=4) BRANCH
+      CHARACTER (len=5) YIELD
+      CHARACTER (len=6) MEANING
+      CHARACTER (len=10 ) LABEL
+
+      DO I=1, 3
+         SELECT CASE (I)
+         CASE(1)
+           YIELD='YLDXE'
+           MEANING='Xe-135'
+           LABEL='YieldXe135'
+           DO iXe=1,NBU
+            YLD(iXe)=YLDXe(iXe)
+           ENDDO
+         CASE(2)
+           YIELD='YLDID'
+           MEANING=' I-135'
+           LABEL=' YieldI135'
+           DO iI=1,NBU
+            YLD(iI)=YLDI(iI)
+           ENDDO
+         CASE(3)
+           YIELD='YLDPM'
+           MEANING='Pr-149'
+           LABEL='YieldPm149'
+           DO iPm=1,NBU
+            YLD(iPm)=YLDPm(iPm)
+           ENDDO
+         END SELECT
+
+         WRITE(IPHEL,'()')
+         WRITE(IPHEL,*) 'List name       : PMAX_FILE_DATA'
+         WRITE(IPHEL,*) 'Labels Array    : PrintVector'
+         WRITE(IPHEL,*) 'List Title(s)  1) %XS_XESM %',YIELD
+         WRITE(IPHEL,*) 'Meaning : Effective ,',MEANING,' Yield'
+
+         CALL SET_RIEGO(IPHEL)
+
+         WRITE(IPHEL,'(29X,A10)') LABEL
+         WRITE(IPHEL,'(6X,A,12X,A)') 'Label E','1-.-E-1-.'
+          ! LOOP OVER burnup points
+         DO NB=1,NBU
+
+           WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2),
+     1     ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB))
+           WRITE(IPHEL,'(ES12.5E2)') YLD(NB)
+         ENDDO
+         WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>'
+  220 FORMAT(I4,1X,A,I4,A,A,I4,A,I5)
+      ENDDO
+      END
+
+      SUBROUTINE SET_DLAY(IPHEL,BRANCH,ITBRAN,BURN,VECT,DIM_LAMBDA,
+     1 DLAY,NBU)
+      INTEGER DIM_LAMBDA,NBU,ITBRAN,NB
+      REAL VECT(DIM_LAMBDA,NBU),BURN(NBU)
+      CHARACTER (len=4) BRANCH,DLAY
+      CHARACTER (len=6) LABEL
+
+      IF(DLAY.EQ.'LAMB') THEN
+         LABEL="lambda"
+      ELSE
+         LABEL="beta  "
+      ENDIF
+      IF(DIM_LAMBDA.GT.8) THEN
+         WRITE (6,*) "@D2PBRA: NB OF DELAY NEUTRON GROUPS:",DIM_LAMBDA
+         CALL XABORT("MAX EIGHT DELAY NEUTRON GROUPS ARE ALLOWED")
+      ENDIF
+      WRITE(IPHEL,'()')
+      WRITE(IPHEL,*) 'List name       : PMAX_FILE_DATA'
+      WRITE(IPHEL,*) 'Labels Array    : PrintVector'
+      IF(LABEL=="lambda")THEN
+         WRITE(IPHEL,*) 'List Title(s)  1) %XS_BETA %DCAYB 1'
+         WRITE(IPHEL,*) 'Meaning : Decay Cst of the Delayed Neutron /s'
+      ELSE
+         WRITE(IPHEL,*) 'List Title(s)  1) %XS_BETA %BETA 1  '
+         WRITE(IPHEL,*) 'Meaning : Delayed Neutron Fraction'
+      ENDIF
+      WRITE(IPHEL,*) '          (.-.-E-G-.) From 0 To 6-th Group'
+
+      CALL SET_RIEGO(IPHEL)
+      IF(DIM_LAMBDA.EQ.6) THEN
+          WRITE(IPHEL,'(31X,A6,6X,A6,6X,A6,6X,A6,6X,A6,6X,A6)')
+     >      LABEL,LABEL,LABEL,LABEL,LABEL,LABEL
+          WRITE(IPHEL,200)
+     >      'Label E','.-.-E-1-.','.-.-E-2-.','.-.-E-3-.','.-.-E-4-.',
+     >      '.-.-E-5-.','.-.-E-6-.'
+         ! LOOP OVER burnup points
+          DO NB=1,NBU
+           WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2),
+     1     ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB))
+           WRITE(IPHEL,'(ES12.5E2,5(ES12.5E2))')
+     >      VECT(1:DIM_LAMBDA,NB)
+          ENDDO
+      ELSE IF(DIM_LAMBDA.EQ.8) THEN
+         WRITE(IPHEL,'(26X,A6,6X,A6,6X,A6,6X,A6,6X,A6,6X,A6,6X,A6)')
+     >   LABEL,LABEL,LABEL,LABEL,LABEL,LABEL,LABEL
+         WRITE(IPHEL,210)
+     >     'Label E','.-.-E-1-.','.-.-E-2-.','.-.-E-3-.','.-.-E-4-.',
+     >     '.-.-E-5-.','.-.-E-6-.','.-.-E-7-.'
+         ! LOOP OVER burnup points
+         DO NB=1,NBU
+           WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2),
+     1     ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB))
+           WRITE(IPHEL,'(ES12.5E2,6(ES12.5E2))') VECT(1:7,NB)
+         ENDDO
+
+         WRITE(IPHEL,*)
+
+         WRITE(IPHEL,'(26X,A6)') 'lambda'
+         WRITE(IPHEL,'(6X,A,12X,A)') 'Label E',LABEL
+         DO NB=1, NBU
+          WRITE(IPHEL,220,advance='no') NB,BRANCH(1:2),
+     1    ITBRAN,' ',BRANCH(1:2),ITBRAN,':',NINT(BURN(NB))
+          WRITE(IPHEL,'(ES12.5E2)') VECT(DIM_LAMBDA,NB)
+         ENDDO
+      ENDIF
+      WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>'
+  200 FORMAT(6X,A,12X,A,3X,A,3X,A,3X,A,3X,A,3X,A)
+  210 FORMAT(6X,A,12X,A,3X,A,3X,A,3X,A,3X,A,3X,A,3X,A)
+  220 FORMAT(I4,1X,A,I4,A,A,I4,A,I5)
+      END