Initial commit from Polytechnique Montreal

285 files changed, 78529 insertions, 0 deletions

diff --git a/Donjon/src/ACR.f b/Donjon/src/ACR.f
new file mode 100644
index 0000000..5ca076e
--- /dev/null
+++ b/Donjon/src/ACR.f
@@ -0,0 +1,594 @@
+*DECK ACR
+      SUBROUTINE ACR(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover and interpolate Microlib or Macrolib information from one or
+* many Apex database files.
+*
+*Copyright:
+* Copyright (C) 2021 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file;
+*         IENTRY=6 for HDF5 file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The ACR: calling specifications are:
+* MLIB := ACR: [ { MLIB | MLIB2 } ] APXNAM1 [[ APXNAM2 ]] [ MAPFL ] 
+*   :: (acr\_data) ; \\
+* where
+*   MLIB : name of a \emph{microlib} (type L\_LIBRARY) or \emph{macrolib} 
+*     (type L\_MACROLIB) containing the interpolated data. If this object also 
+*     appears on the RHS of structure (ACR:, it is open in modification mode 
+*     and updated.
+*   MLIB2 : name of an optional \emph{microlib} object whose content is copied 
+*     on MLIB.
+*   APXNAM1 : name of the \emph{Apex file} data structure.
+*   APXNAM2 : name of an additional \emph{Apex file} data structure. This
+*     object is optional.
+*   MAPFL : name of the \emph{map} object containing fuel regions description, 
+*     global parameter information (burnup, fuel/coolant temperatures, coolant 
+*     density, etc). Keyword TABLE is expected in (acr\_data).
+*   acr\_data : input data structure containing interpolation information.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      USE hdf5_wrap
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXR=12
+      INTEGER, PARAMETER::NSTATE=40
+      REAL B2, FLOTT
+      INTEGER ITYLCM, MAXISO, MAXNIS, MD1, MD2, MY1, MY2, NB, NCAL,
+     > NCH, NCOMB, NDEPL, NDFI, NDFP, NFUEL, NGRP, NHEAVY, NISOF, NISOP,
+     > NISOS, NITMA, NLIGHT, NBMAC, NMIL, NMIX, NOTHER, NPARM, NPAR,
+     > NVP, NREAC, NSTABL, NSURFD, NVTOT, NBISO, NLAM, NREA, NISOTS,
+     > NPRC, IMPX, ILONG, IMPY, INDIC, ITER, ITEXT4, I, IACCS, ITH, J,
+     > NBESP, ILUPS
+      CHARACTER TEXT4*4,TEXT12*12,HSMG*131,HSIGN*12,HEQUI*80,
+     > NMDEPL(MAXR)*8
+      LOGICAL LMACRO,LCUBIC,LRES,LPURE,LTOTAL,LFROM
+      DOUBLE PRECISION DFLOTT
+      INTEGER ISTATE(NSTATE)
+      TYPE(C_PTR) IPMAP,IPAPX,IPLIB,IPLIB2
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: MIXC,NISO,LISO,IADRY,ITNAM,
+     1 ITZEA,MATNO,KPAX,INAM,IZAE,HREAC,IDR,KPAR,ITODO
+      REAL, ALLOCATABLE, DIMENSION(:) :: CONC,BPAX,RER,RRD,BPAR,YIELD
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: TERP
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: VTOT
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:) :: YLDS,DECAY
+      CHARACTER(LEN=4), ALLOCATABLE, DIMENSION(:) :: TYPISO
+      CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: NOMISO,NOMMAC,NOMIS
+      CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:,:) :: HISO
+*
+      SAVE      NMDEPL
+      DATA      NMDEPL/'DECAY   ','NFTOT   ','NG      ','N2N     ',
+     >                 'N3N     ','N4N     ','NA      ','NP      ',
+     >                 'N2A     ','NNP     ','ND      ','NT      '/
+*----
+*  PARAMETER VALIDATION
+*----
+      IF(NENTRY.LE.1) CALL XABORT('ACR: MINIMUM OF 2 OBJECTS EXPECTED.')
+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('ACR: MACRO'
+     1 //'LIB LCM OBJECT EXPECTED AT LHS.')
+      IF((JENTRY(1).NE.0).AND.(JENTRY(1).NE.1)) CALL XABORT('ACR: MACRO'
+     1 //'LIB IN CREATE OR MODIFICATION MODE EXPECTED.')
+      IACCS=JENTRY(1)
+      IPLIB=KENTRY(1)
+      IPLIB2=C_NULL_PTR
+      IPMAP=C_NULL_PTR
+      NGRP=0
+      NMIX=0
+      IF(IACCS.EQ.1) THEN
+        CALL LCMGTC(IPLIB,'SIGNATURE',12,HSIGN)
+        IF(HSIGN.EQ.'L_LIBRARY') THEN
+          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+          NGRP=ISTATE(3)
+          NMIX=ISTATE(1)
+        ELSE IF(HSIGN.EQ.'L_MACROLIB') THEN
+          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+          NGRP=ISTATE(1)
+          NMIX=ISTATE(2)
+        ELSE
+          TEXT12=HENTRY(1)
+          CALL XABORT('ACR: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     1    '. L_LIBRARY OR L_MACROLIB EXPECTED.')
+        ENDIF
+      ENDIF
+      DO 10 I=2,NENTRY
+        IF((IENTRY(I).NE.1).AND.(IENTRY(I).NE.2).AND.(IENTRY(I).NE.6))
+     1  THEN
+          CALL XABORT('ACR: LCM OR HDF5 OBJECTS EXPECTED AT RHS.')
+        ENDIF
+        IF(JENTRY(I).NE.2) CALL XABORT('ACR:OBJECTS IN READ-ONLY MODE '
+     1 //'EXPECTED AT RHS.')
+        IF((IENTRY(I).EQ.1).OR.(IENTRY(I).EQ.2)) THEN
+          CALL LCMGTC(KENTRY(I),'SIGNATURE',12,HSIGN)
+          IF(HSIGN.EQ.'L_LIBRARY') THEN
+            IF(C_ASSOCIATED(IPLIB2)) CALL XABORT('ACR: ONLY ONE MICROL'
+     1      //'IB EXPECTED AT RHS.')
+            IPLIB2=KENTRY(I)
+            GO TO 10
+          ELSE IF(HSIGN.EQ.'L_MACROLIB') THEN
+            CALL XABORT('ACR: ANOTHER MACROLIB NOT EXPECTED AT RHS.')
+          ELSE IF(HSIGN.EQ.'L_MAP') THEN
+            IF(I.NE.NENTRY)CALL XABORT('ACR: FUEL-MAP EXPECTED TO BE T'
+     1      //'HE LAST OBJECT.')
+            IF(NENTRY.LT.3)CALL XABORT('ACR: MISSING APEX FILE.')
+            IPMAP=KENTRY(NENTRY)
+            CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+            NMIX=ISTATE(9)
+          ENDIF
+        ENDIF
+   10 CONTINUE
+*----
+*  READ THE INPUT DATA
+*----
+      NVTOT=0
+      LMACRO=.TRUE.
+      LTOTAL=.FALSE.
+      LCUBIC=.FALSE.
+      LRES=.FALSE.
+      LPURE=.FALSE.
+      B2=0.0
+      ITER=-1
+      IPAPX=C_NULL_PTR
+      HEQUI=' '
+      ILUPS=0
+      IMPX=1
+   20 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+      IF(INDIC.NE.3) CALL XABORT('ACR: CHARACTER DATA EXPECTED(1).')
+   30 IF(TEXT12.EQ.'EDIT') THEN
+*       READ THE PRINT INDEX.
+        CALL REDGET(INDIC,IMPX,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1) CALL XABORT('ACR: INTEGER DATA EXPECTED(1).')
+      ELSE IF(TEXT12.EQ.'NMIX') THEN
+*       READ THE MAXIMUM NUMBER OF MATERIAL MIXTURES.
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1) CALL XABORT('ACR: INTEGER DATA EXPECTED(2).')
+        IF(NITMA.LT.NMIX) THEN
+           WRITE(HSMG,'(20HACR: NMIX MUST BE >=,I8)') NMIX
+           CALL XABORT(HSMG)
+        ENDIF
+        NMIX=NITMA
+      ELSE IF(TEXT12.EQ.'MACRO') THEN
+        LMACRO=.TRUE.
+      ELSE IF(TEXT12.EQ.'MICRO') THEN
+        LMACRO=.FALSE.
+      ELSE IF(TEXT12.EQ.'TOTAL') THEN
+        IF(LMACRO) CALL XABORT('ACR: TOTAL LIMITED TO MICRO OPTION.')
+        LTOTAL=.TRUE.
+      ELSE IF(TEXT12.EQ.'LINEAR') THEN
+        LCUBIC=.FALSE.
+      ELSE IF(TEXT12.EQ.'CUBIC') THEN
+        LCUBIC=.TRUE.
+      ELSE IF(TEXT12.EQ.'RES') THEN
+        IF((IACCS.EQ.0).AND.(.NOT.C_ASSOCIATED(IPLIB2))) THEN
+          CALL XABORT('ACR: RHS MICROLIB EXPECTED WITH RES OPTION.')
+        ENDIF
+        LRES=.TRUE.
+      ELSE IF(TEXT12.EQ.'PURE') THEN
+        LPURE=.TRUE.
+      ELSE IF(TEXT12.EQ.'UPS') THEN
+        ILUPS=1
+      ELSE IF(TEXT12.EQ.'APEX') THEN
+        IF(NMIX.EQ.0) CALL XABORT('ACR: ZERO NUMBER OF MIXTURES.')
+        IF(C_ASSOCIATED(IPMAP)) THEN
+          WRITE(IOUT,'(/43H ACR: ***WARNING*** A FUEL MAP IS SET AT RH,
+     1    26HS; KEYWORD TABLE EXPECTED.)')
+        ENDIF
+        IF((IACCS.EQ.0).AND.(C_ASSOCIATED(IPLIB2))) THEN
+          CALL LCMEQU(IPLIB2,IPLIB)
+          IACCS=1
+        ENDIF
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3) CALL XABORT('ACR: CHARACTER DATA EXPECTED(2).')
+        ITH=0
+        DO 50 I=2,NENTRY
+          IF(C_ASSOCIATED(KENTRY(I),IPLIB2)) GO TO 50
+          IF(TEXT12.EQ.HENTRY(I)) THEN
+            IPAPX=KENTRY(I)
+            ITH=I
+            GO TO 60
+          ENDIF
+   50   CONTINUE
+        CALL XABORT('ACR: APEX '//TEXT12//' NOT FOUND.')
+   60   WRITE(IOUT,320) HENTRY(ITH)
+        CALL APXTOC(IPAPX,IMPX,NLAM,NREA,NBISO,NBMAC,NMIL,NPAR,NVP,
+     1  NISOF,NISOP,NISOS,NCAL,NGRP,NISOTS,NSURFD,NPRC)
+        MY1=NBMAC+NISOF
+        MY2=NISOP
+        MD1=NLAM
+        MD2=NBISO+NBMAC
+        ALLOCATE(MIXC(NMIX),NISO(NMIX),LISO(NMIX),HISO(NMIX,MD2),
+     1  ITODO(NMIX*MD2))
+        ALLOCATE(TERP(NCAL,NMIX),CONC(NMIX*MD2))
+*
+        CALL ACRDRV(IPAPX,LCUBIC,NMIX,IMPX,NMIL,NCAL,MD2,NPAR,ITER,
+     1  MAXNIS,MIXC,TERP,NISO,LISO,HISO,CONC,ITODO,LFROM)
+        GO TO 130
+      ELSE IF(TEXT12.EQ.'TABLE') THEN
+        IF(.NOT.C_ASSOCIATED(IPMAP)) CALL XABORT('ACR: MISSING FUEL-MA'
+     1  //'P OBJECT.')
+        ISTATE(:NSTATE)=0
+        CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+        NB=ISTATE(1)
+        NCH=ISTATE(2)
+        NCOMB=ISTATE(3)
+        NGRP=ISTATE(4)
+        NFUEL=ISTATE(7)
+        NPARM=ISTATE(8)
+        IF(NCOMB.EQ.0) CALL XABORT('ACR: NUMBER OF COMBUSTION ZONES NO'
+     1   //'T YET DEFINED IN THE FUEL MAP NCOMB=0.')
+        IF((IACCS.EQ.0).AND.(C_ASSOCIATED(IPLIB2))) THEN
+          CALL LCMEQU(IPLIB2,IPLIB)
+          IACCS=1
+        ENDIF
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3) CALL XABORT('ACR: CHARACTER DATA EXPECTED(3).')
+        ITH=0
+        DO 80 I=2,NENTRY
+          IF((C_ASSOCIATED(KENTRY(I),IPLIB2)).OR.
+     1       (C_ASSOCIATED(KENTRY(I),IPMAP))) GO TO 80
+          IF(TEXT12.EQ.HENTRY(I)) THEN
+            IPAPX=KENTRY(I)
+            ITH=I
+            GO TO 90
+          ENDIF
+   80   CONTINUE
+        CALL XABORT('ACR: APEX FILE '//TEXT12//' NOT FOUND.')
+   90   WRITE(IOUT,320) HENTRY(ITH)
+        CALL APXTOC(IPAPX,IMPX,NLAM,NREA,NBISO,NBMAC,NMIL,NPAR,NVP,
+     1  NISOF,NISOP,NISOS,NCAL,NGRP,NISOTS,NSURFD,NPRC)
+        MY1=NBMAC+NISOF
+        MY2=NISOP
+        MD1=NLAM
+        MD2=NBISO+NBMAC
+        ALLOCATE(MIXC(NMIX),NISO(NMIX),LISO(NMIX),HISO(NMIX,MD2),
+     1  ITODO(NMIX*MD2))
+        ALLOCATE(TERP(NCAL,NMIX),CONC(NMIX*MD2))
+*
+        CALL ACRRGR(IPAPX,IPMAP,LCUBIC,NMIX,IMPX,NMIL,NCAL,MD2,NCH,NB,
+     1  NFUEL,NPARM,NPAR,ITER,MAXNIS,MIXC,TERP,NISO,LISO,HISO,CONC,
+     2  ITODO,LFROM)
+        GO TO 130
+      ELSE IF(TEXT12.EQ.'EQUI') THEN
+         CALL REDGET(INDIC,NITMA,FLOTT,HEQUI,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('ACR: CHARACTER DATA EXPECTED(4).')
+      ELSE IF(TEXT12.EQ.'LEAK') THEN
+        CALL REDGET(INDIC,NITMA,B2,TEXT12,DFLOTT)
+        IF(INDIC.NE.2) CALL XABORT('ACR: REAL DATA EXPECTED.')
+      ELSE IF(TEXT12.EQ.'CHAIN') THEN
+        IF(LMACRO) CALL XABORT('ACR: MICRO KEYWORD EXPECTED.')
+        IF(LTOTAL) CALL XABORT('ACR: TOTAL AND CHAIN KEYWORDS ARE EXCL'
+     1  //'USIVE.')
+        CALL APXTOC(IPAPX,0,NLAM,NREA,NBISO,NBMAC,NMIL,NPAR,NVP,NISOF,
+     1  NISOP,NISOS,NCAL,NGRP,NISOTS,NSURFD,NPRC)
+        IF(NBISO.EQ.0) CALL XABORT('ACR: NO PARTICULARIZED ISOTOPES.')
+        IF(NBMAC.EQ.0) CALL XABORT('ACR: NO MACROSCOPIC SETS.')
+        MY1=NBMAC+NISOF
+        MY2=NISOP
+        MD1=NLAM
+        MD2=NBISO+NBMAC
+        CALL LCMLEN(IPLIB,'VTOT_',ILONG,ITYLCM)
+        IF(ILONG.NE.NVTOT) CALL XABORT('ACR: INVALID LENGTH: VTOT(1).')
+        CALL LCMLEN(IPLIB,'YLDS_',ILONG,ITYLCM)
+        IF(ILONG.NE.MY1*MY2*NVTOT) CALL XABORT('ACR: INVALID LENGTH: Y'
+     1  //'LDS(1).')
+        CALL LCMLEN(IPLIB,'DECAYC_',ILONG,ITYLCM)
+        IF(ILONG.NE.MD1*MD2*NVTOT) CALL XABORT('ACR: INVALID LENGTH: D'
+     1  //'ECAYC(1)')
+        ALLOCATE(VTOT(NVTOT),YLDS(MY1,MY2,NVTOT),DECAY(MD1,MD2,NVTOT),
+     1  NOMIS(NBISO+NBMAC))
+        CALL LCMGET(IPLIB,'VTOT_',VTOT)
+        CALL LCMGET(IPLIB,'YLDS_',YLDS)
+        CALL LCMGET(IPLIB,'DECAYC_',DECAY)
+        IF(hdf5_group_exists(IPAPX,"/explicit/")) THEN
+          CALL hdf5_read_data(IPAPX,"/explicit/ISONAME",NOMISO)
+        ELSE IF(hdf5_group_exists(IPAPX,"/expli001/")) THEN
+          CALL hdf5_read_data(IPAPX,"/expli001/ISONAME",NOMISO)
+        ELSE
+          CALL XABORT('ACR: GROUP explicit NOT FOUND IN HDF5 FILE.')
+        ENDIF
+        NOMIS(:NBISO)=NOMISO(:NBISO)
+        DEALLOCATE(NOMISO)
+        IF(hdf5_group_exists(IPAPX,"/physconst/")) THEN
+          CALL hdf5_read_data(IPAPX,"/physconst/ISOTYP",TYPISO)
+        ELSE IF(hdf5_group_exists(IPAPX,"/physco001/")) THEN
+          CALL hdf5_read_data(IPAPX,"/physc001/ISOTYP",TYPISO)
+        ELSE
+          CALL XABORT('ACR: GROUP physconst NOT FOUND IN HDF5 FILE.')
+        ENDIF
+        ALLOCATE(IADRY(MD2))
+        NISOF=0
+        NISOP=0
+        NISOS=0
+        DO I=1,NBISO
+          IF(TYPISO(I).EQ.'FISS') THEN
+            NISOF=NISOF+1
+            IADRY(I)=NISOF
+          ELSE IF(TYPISO(I).EQ.'F.P.') THEN
+            NISOP=NISOP+1
+            IADRY(I)=-NISOP
+          ELSE
+            NISOS=NISOS+1
+            IADRY(I)=0
+          ENDIF
+        ENDDO
+        IF(NBMAC.GT.0) THEN
+          IF(hdf5_group_exists(IPAPX,"/explicit/")) THEN
+            CALL hdf5_read_data(IPAPX,"/explicit/MACNAME",NOMMAC)
+          ELSE IF(hdf5_group_exists(IPAPX,"/expli001/")) THEN
+            CALL hdf5_read_data(IPAPX,"/expli001/MACNAME",NOMMAC)
+          ELSE
+            CALL XABORT('ACR: GROUP explicit NOT FOUND IN HDF5 FILE.')
+          ENDIF
+          DO I=1,NBMAC
+            IF(NOMMAC(I).EQ.'TOTAL') THEN
+              NOMIS(NBISO+I)=' '
+              IADRY(NBISO+I)=0
+            ELSE IF(NOMMAC(I).EQ.'RESIDUAL') THEN
+              NOMIS(NBISO+I)='*MAC*RES'
+              IADRY(NBISO+I)=0
+            ENDIF
+          ENDDO
+          DEALLOCATE(NOMMAC)
+        ENDIF
+*
+        NBESP=1
+        ALLOCATE(ITNAM(3*MD2),ITZEA(MD2),MATNO(MD2),
+     1  KPAX((MD2+MAXR)*MD2),BPAX((MD2+MAXR)*MD2*NBESP))
+        TEXT4='    '
+        READ(TEXT4,'(A4)') ITEXT4
+        ITNAM(:3*MD2)=ITEXT4
+        ITZEA(:MD2)=0
+        MATNO(:MD2)=0
+        KPAX(:(MD2+MAXR)*MD2)=0
+        BPAX(:(MD2+MAXR)*MD2*NBESP)=0.0
+        CALL SCREIR(NMDEPL,MY1,MY2,MD1,MD2,NOMIS,IADRY,NVTOT,VTOT,
+     1              YLDS,DECAY,ITNAM,ITZEA,KPAX,BPAX)
+        DEALLOCATE(IADRY,NOMIS,DECAY,YLDS,VTOT)
+        CALL LIBWET(MAXR,MD2,NBESP,NSTATE,NMDEPL,ITNAM,ISTATE,MATNO,
+     1  KPAX,BPAX)
+        NDEPL=ISTATE(1)
+        NDFI=ISTATE(2)
+        NDFP=ISTATE(3)
+        NHEAVY=ISTATE(4)
+        NLIGHT=ISTATE(5)
+        NOTHER=ISTATE(6)
+        NSTABL=ISTATE(7)
+        NREAC=ISTATE(8)
+        NPAR=ISTATE(9)
+        NBESP=MAX(1,ISTATE(10))
+*----
+*  ALLOCATE DECAY CHAIN
+*----
+        NDEPL=MAX(NDEPL,1)
+        NDFI=MAX(NDFI,1)
+        NDFP=MAX(NDFP,1)
+        ALLOCATE(INAM(3*NDEPL),IZAE(NDEPL),IDR(NREAC*NDEPL),
+     1  RER(NREAC*NDEPL),RRD(NDEPL),KPAR(NPAR*NDEPL),BPAR(NPAR*NDEPL),
+     2  YIELD(NDFI*NDFP*NBESP))
+*----
+*  SET DECAY CHAIN
+*----
+        CALL LIBWED(MAXR,MD2,NBESP,NDEPL,NDFI,NDFP,NHEAVY,NLIGHT,NOTHER,
+     >              NREAC,NPAR,ITNAM,ITZEA,MATNO,KPAX,BPAX,INAM,IZAE,
+     >              IDR,RER,RRD,KPAR,BPAR,YIELD)
+*----
+*  RELEASE WORK VECTORS FOR WIMS-AECL, WIMS-NEA, DRAGLIB
+*  AND INPUT FILE
+*----
+        DEALLOCATE(BPAX,KPAX,MATNO,ITZEA,ITNAM)
+*----
+*  SELECT USED DEPLETION REACTION NAMES
+*----
+        ALLOCATE(HREAC(2*NREAC))
+        DO 100 I=1,NREAC
+          READ(NMDEPL(I),'(2A4)') (HREAC(2*(I-1)+J),J=1,2)
+  100   CONTINUE
+*----
+*  PRINT DECAY CHAIN IF REQUIRED
+*----
+        IMPY=IMPX+2
+        CALL LIBEPR(IMPY,NBESP,NDEPL,NSTABL,NDFI,NDFP,NREAC,NPAR,INAM,
+     >              HREAC,IDR,RER,RRD,KPAR,BPAR,YIELD,IZAE)
+*----
+*  SAVE CHAIN
+*----
+        CALL LCMSIX(IPLIB,'DEPL-CHAIN',1)
+        CALL LCMPUT(IPLIB,'STATE-VECTOR',NSTATE,1,ISTATE)
+        NDEPL=ISTATE(1)
+        CALL LCMPUT(IPLIB,'ISOTOPESDEPL',3*NDEPL,3,INAM)
+        CALL LCMPUT(IPLIB,'CHARGEWEIGHT',NDEPL,1,IZAE)
+        CALL LCMPUT(IPLIB,'DEPLETE-IDEN',2*NREAC,3,HREAC)
+        CALL LCMPUT(IPLIB,'DEPLETE-REAC',NREAC*NDEPL,1,IDR)
+        CALL LCMPUT(IPLIB,'DEPLETE-ENER',NREAC*NDEPL,2,RER)
+        CALL LCMPUT(IPLIB,'DEPLETE-DECA',NDEPL,2,RRD)
+        CALL LCMPUT(IPLIB,'PRODUCE-REAC',NPAR*NDEPL,1,KPAR)
+        CALL LCMPUT(IPLIB,'PRODUCE-RATE',NPAR*NDEPL,2,BPAR)
+        IF(NDFP.GT.0) CALL LCMPUT(IPLIB,'FISSIONYIELD',NDFI*NDFP*NBESP,
+     >  2,YIELD)
+        CALL LCMSIX(IPLIB,' ',2)
+        CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+        ISTATE(11)=NDEPL
+        CALL LCMPUT(IPLIB,'STATE-VECTOR',NSTATE,1,ISTATE)
+*----
+*  DEALLOCATE DECAY CHAIN ARRAYS
+*----
+        DEALLOCATE(YIELD,BPAR,KPAR,RRD,RER,IDR,IZAE,INAM)
+      ELSE IF(TEXT12.EQ.';') THEN
+        GO TO 200
+      ELSE
+        CALL XABORT('ACR: '//TEXT12//' IS AN INVALID KEYWORD.')
+      ENDIF
+      GO TO 20
+*----
+*  PERFORM MULTIPARAMETER INTERPOLATION
+*----
+  130 CALL APXTOC(IPAPX,0,NLAM,NREA,NBISO,NBMAC,NMIL,NPAR,NVP,NISOF,
+     1 NISOP,NISOS,NCAL,NGRP,NISOTS,NSURFD,NPRC)
+      MD2=NBISO+NBMAC
+      IF(.NOT.LFROM) NMIL=1
+*----
+*  BUILD THE INTERPOLATED MACROLIB
+*----
+      IF(LMACRO.AND.(MAXNIS.EQ.0)) THEN
+*       build a macrolib
+        CALL ACRMAC(IPLIB,IPAPX,IACCS,NMIL,NMIX,NGRP,IMPX,HEQUI,NCAL,
+     1  NSURFD,ILUPS,MIXC,TERP,LPURE,B2,LFROM)
+      ELSE
+*       build a microlib
+        IF(LMACRO)THEN
+          CALL LCMOP(IPLIB,'*TEMPORARY*',0,1,0)
+          IACCS=0
+        ENDIF
+        IF(IACCS.EQ.0)THEN
+          MAXISO=MD2*NMIX
+        ELSE
+          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+          MAXISO=MAX(MD2*NMIX,ISTATE(2))
+        ENDIF
+        NVTOT=NVTOT+1
+        ALLOCATE(VTOT(NVTOT),YLDS(MY1,MY2,NVTOT),DECAY(MD1,MD2,NVTOT))
+        IF(NVTOT.GT.1) THEN
+          CALL LCMLEN(IPLIB,'VTOT_',ILONG,ITYLCM)
+          IF(ILONG.NE.NVTOT-1) CALL XABORT('ACR: INVALID LENGTH: VTOT('
+     1    //'2).')
+          CALL LCMLEN(IPLIB,'YLDS_',ILONG,ITYLCM)
+          IF(ILONG.NE.MY1*MY2*(NVTOT-1)) CALL XABORT('ACR: INVALID LEN'
+     1    //'GTH: YLDS(2).')
+          CALL LCMGET(IPLIB,'VTOT_',VTOT)
+          IF(MY1*MY2.GT.0) CALL LCMGET(IPLIB,'YLDS_',YLDS)
+          IF(MD1*MD2.GT.0) CALL LCMGET(IPLIB,'DECAYC_',DECAY)
+        ENDIF
+        CALL ACRLIB(MAXNIS,MAXISO,IPLIB,IPAPX,IACCS,NMIX,NGRP,IMPX,
+     1  HEQUI,NCAL,ITER,MY1,MY2,MD1,MD2,TERP,NISO,LISO,HISO,CONC,ITODO,
+     2  MIXC,LRES,LPURE,LTOTAL,ILUPS,B2,LFROM,VTOT(NVTOT),
+     3  YLDS(1,1,NVTOT),DECAY(1,1,NVTOT))
+        CALL LCMPUT(IPLIB,'VTOT_',NVTOT,4,VTOT)
+        IF(MY1*MY2.GT.0) THEN
+          CALL LCMPUT(IPLIB,'YLDS_',MY1*MY2*NVTOT,4,YLDS)
+        ENDIF
+        IF(MD1*MD2.GT.0) THEN
+          CALL LCMPUT(IPLIB,'DECAYC_',MD1*MD2*NVTOT,4,DECAY)
+        ENDIF
+        DEALLOCATE(VTOT,DECAY,YLDS)
+        IF(LMACRO) THEN
+          CALL LCMVAL(IPLIB,' ')
+          CALL LCMSIX(IPLIB,'MACROLIB',1)
+          CALL LCMEQU(IPLIB,KENTRY(1))
+          CALL LCMSIX(IPLIB,' ',2)
+          CALL LCMCL(IPLIB,2)
+        ENDIF
+      ENDIF
+      DEALLOCATE(LISO,NISO,HISO,ITODO,CONC,TERP,MIXC)
+*----
+*  PRINT THE STATE VECTOR
+*----
+      IF(IMPX.GT.0) THEN
+        IF(LMACRO) THEN
+          CALL LCMGET(KENTRY(1),'STATE-VECTOR',ISTATE)
+          WRITE(IOUT,290) IMPX,(ISTATE(I),I=1,7),ISTATE(9),ISTATE(12)
+          IF(IMPX.GT.3) CALL LCMLIB(KENTRY(1))
+        ELSE
+          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+          WRITE(IOUT,300) IMPX,(ISTATE(I),I=1,12)
+          WRITE(IOUT,310) (ISTATE(I),I=13,15),(ISTATE(I),I=17,24)
+          IF(IMPX.GT.3) CALL LCMLIB(IPLIB)
+        ENDIF
+      ENDIF
+*----
+*  CONTINUE DATA PROCESSING
+*----
+      IF(ITER.EQ.0) THEN
+        GO TO 200
+      ELSE IF(ITER.EQ.1) THEN
+        TEXT12='APEX'
+        GO TO 30
+      ELSE IF(ITER.EQ.2) THEN
+        TEXT12='TABLE'
+        GO TO 30
+      ELSE IF(ITER.EQ.3) THEN
+        TEXT12='CHAIN'
+        GO TO 30
+      ENDIF
+*----
+*  LEAVE ACR:
+*----
+  200 RETURN
+*
+  290 FORMAT(/8H OPTIONS/8H -------/
+     1 7H IMPX  ,I6,30H   (0=NO PRINT/1=SHORT/2=MORE)/
+     2 7H NGROUP,I6,28H   (NUMBER OF ENERGY GROUPS)/
+     3 7H NBMIX ,I6,39H   (NUMBER OF MIXTURES IN THE MACROLIB)/
+     4 7H NANISO,I6,34H   (MAXIMUM SCATTERING ANISOTROPY)/
+     5 7H NIFISS,I6,45H   (MAXIMUM NUMBER OF FISSILE ISOTOPES IN A M,
+     6 7HIXTURE)/
+     7 7H NEDMAC,I6,34H   (NUMBER OF CROSS SECTION EDITS)/
+     8 7H ITRANC,I6,45H   (0=NO TRANSPORT CORRECTION/1=APOLLO TYPE/2,
+     9 43H=RECOVER FROM LIBRARY/4=LEAKAGE CORRECTION)/
+     1 7H NLG   ,I6,39H   (NUMBER OF DELAYED PRECURSOR GROUPS)/
+     2 7H ILEAK ,I6,40H   (1=DIFF AVAILABLE; 2=DIFFX AVAILABLE)/
+     3 7H IDF   ,I6,47H   (0=NO INFO/1=ALBS INFO/2=FLUX GAP INFO/3=ADF,
+     4 10H GAP INFO))
+  300 FORMAT(/8H OPTIONS/8H -------/
+     1 7H IMPX  ,I6,30H   (0=NO PRINT/1=SHORT/2=MORE)/
+     2 7H MAXMIX,I6,31H   (MAXIMUM NUMBER OF MIXTURES)/
+     3 7H NBISO ,I6,36H   (NUMBER OF ISOTOPES OR MATERIALS)/
+     4 7H NGRP  ,I6,28H   (NUMBER OF ENERGY GROUPS)/
+     5 7H NL    ,I6,30H   (NUMBER OF LEGENDRE ORDERS)/
+     6 7H ITRANC,I6,45H   (0=NO TRANSPORT CORRECTION/1=APOLLO TYPE/2,
+     7 57H=RECOVER FROM LIBRARY/3=WIMS-D TYPE/4=LEAKAGE CORRECTION)/
+     8 7H IPROB ,I6,23H   (0=DIRECT/1=ADJOINT)/
+     9 7H ITIME ,I6,28H   (1=STEADY-STATE/2=PROMPT)/
+     1 7H NLIB  ,I6,32H   (NUMBER OF SETS OF LIBRARIES)/
+     2 7H NGF   ,I6,48H   (NUMBER OF FAST GROUP WITHOUT SELF-SHIELDING)/
+     3 7H IGRMAX,I6,41H   (LAST GROUP INDEX WITH SELF-SHIELDING)/
+     4 7H NDEPL ,I6,33H   (NUMBER OF DEPLETING ISOTOPES)/
+     5 7H NCOMB ,I6,33H   (NUMBER OF DEPLETING MIXTURES))
+  310 FORMAT(7H NEDMAC,I6,34H   (NUMBER OF CROSS SECTION EDITS)/
+     1 7H NBMIX ,I6,23H   (NUMBER OF MIXTURES)/
+     2 7H NRES  ,I6,40H   (NUMBER OF SETS OF RESONANT MIXTURES)/
+     3 7H IPROC ,I6,48H   (-1=SKIP LIBRARY PROCESSING/0=DILUTION INTERP,
+     4 48HOLATION/1=USE PHYSICAL TABLES/2=BUILD A DRAGLIB/,
+     5 55H3=COMPUTE CALENDF TABLES/4=COMPUTE SLOWING-DOWN TABLES)/
+     6 7H IMAC  ,I6,45H   (0=DO NOT/1=DO BUILD AN EMBEDDED MACROLIB)/
+     7 7H NDEL  ,I6,31H   (NUMBER OF PRECURSOR GROUPS)/
+     8 7H NFISS ,I6,31H   (NUMBER OF FISSILE ISOTOPES)/
+     9 7H ISOADD,I6,37H   (0=COMPLETE BURNUP CHAIN/1=DO NOT)/
+     1 7H MAXISM,I6,40H   (MAX. NUMBER OF ISOTOPES PER MIXTURE)/
+     2 7H IPRECI,I6,34H   (CALENDF ACCURACY FLAG:1/2/3/4)/
+     3 7H IDF   ,I6,47H   (0=NO INFO/1=ALBS INFO/2=FLUX GAP INFO/3=ADF,
+     4 10H GAP INFO))
+  320 FORMAT(/31H ACR: INTERPOLATING APEX FILE ',A12,2H'.)
+      END
diff --git a/Donjon/src/ACRDRV.f b/Donjon/src/ACRDRV.f
new file mode 100644
index 0000000..f306c2a
--- /dev/null
+++ b/Donjon/src/ACRDRV.f
@@ -0,0 +1,404 @@
+*DECK ACRDRV
+      SUBROUTINE ACRDRV(IPAPX,LCUBIC,NMIX,IMPX,NMIL,NCAL,MD2,NPAR,
+     1 ITER,MAXNIS,MIXC,TERP,NISO,LISO,HISO,CONC,ITODO,LFROM)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute TERP factors for Apex file interpolation. Use user-defined
+* global parameters.
+*
+*Copyright:
+* Copyright (C) 2021 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPAPX   address of the Apex file.
+* LCUBIC  =.TRUE.: cubic Ceschino interpolation; =.FALSE: linear
+*         Lagrange interpolation.
+* NMIX    maximum number of material mixtures in the microlib.
+* IMPX    print parameter (equal to zero for no print).
+* NMIL    number of material mixtures in the Apex file.
+* NCAL    number of elementary calculations in the Apex file.
+* MD2     number of particularized and macro isotopes in the Apex file.
+* NPAR    number of parameters
+*
+*Parameters: output
+* ITER    completion flag (=0: all over; =1: use another Apex file;
+*         =2 use another L_MAP + Apex file).
+* MAXNIS  maximum value of NISO(I) in user data.
+* MIXC    mixture index in the Apex file corresponding to each microlib
+*         mixture.
+* TERP    interpolation factors.
+* NISO    number of user-selected isotopes.
+* LISO    type of treatment (=.true.: ALL; =.false.: ONLY).
+* HISO    name of the user-selected isotopes.
+* CONC    user-defined number density of the user-selected isotopes. A
+*         value of -99.99 is set to indicate that the compo value is
+*         used.
+* ITODO   non-depletion mask (=1 to force a user-selected isotope to be
+*         non-depleting)
+* LFROM   macroregion flag (=.true. if 'xs       n' groups are set).
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      USE hdf5_wrap
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPAPX
+      INTEGER NMIX,IMPX,NMIL,NCAL,MD2,NPAR,ITER,MAXNIS,MIXC(NMIX),
+     1 NISO(NMIX),ITODO(NMIX,MD2)
+      REAL TERP(NCAL,NMIX),CONC(NMIX,MD2)
+      LOGICAL LCUBIC,LISO(NMIX),LFROM
+      CHARACTER(LEN=8) HISO(NMIX,MD2)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXLIN=132
+      INTEGER, PARAMETER::MAXPAR=50
+      INTEGER, PARAMETER::MAXVAL=200
+      REAL, PARAMETER::REPS=1.0E-4
+      INTEGER I, J, IBM, IBMOLD, ICAL, INDIC, IPAR, ITYPE, JBM, NITMA
+      REAL SUM, FLOTT
+      CHARACTER TEXT24*24,TEXT72*72,HSMG*131,TEXT132*132,
+     1 VALH(MAXPAR)*12,RECNAM*80,HCUBIC*12
+      INTEGER VALI(MAXPAR),MUPLET(2*MAXPAR),MUTYPE(2*MAXPAR)
+      INTEGER RANK,TYPE,NBYTE,DIMSR(5)
+      DOUBLE PRECISION DFLOTT
+      REAL VALR(2*MAXPAR,2)
+      LOGICAL LCUB2(MAXPAR)
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      LOGICAL, ALLOCATABLE, DIMENSION(:) :: LDELTA
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: NVALUE,VINTE
+      REAL, ALLOCATABLE, DIMENSION(:) :: VREAL
+      CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: PARFMT
+      CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: VCHAR
+      CHARACTER(LEN=24), ALLOCATABLE, DIMENSION(:) :: PARKEY
+      CHARACTER(LEN=132), ALLOCATABLE, DIMENSION(:) :: TEXT132V1
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(LDELTA(NMIX))
+*----
+*  RECOVER INFORMATION FOR THE APEX FILE.
+*----
+      CALL hdf5_info(IPAPX,"/Calculation_Content",RANK,TYPE,NBYTE,DIMSR)
+      IF(RANK.GT.MAXLIN) CALL XABORT('ACRDRV: MAXLIN OVERFLOW.')
+      IF(NPAR.GT.MAXPAR) CALL XABORT('ACRDRV: MAXPAR OVERFLOW.')
+      IF((RANK.EQ.1).AND.(DIMSR(1).EQ.1)) THEN
+        CALL hdf5_read_data(IPAPX,"/Calculation_Content",TEXT132)
+        IF(IMPX.GT.0) WRITE(IOUT,'(1X,A)') TEXT132
+      ELSE IF(RANK.EQ.1) THEN
+        CALL hdf5_read_data(IPAPX,"/Calculation_Content",TEXT132V1)
+        IF(IMPX.GT.0) THEN
+          DO I=1,DIMSR(1)
+            WRITE(IOUT,'(1X,A)') TEXT132V1(I)
+          ENDDO
+        ENDIF
+        DEALLOCATE(TEXT132V1)
+      ENDIF
+      IF(NPAR.GT.0) THEN
+         CALL hdf5_read_data(IPAPX,"/paramdescrip/PARNAM",PARKEY)
+         CALL hdf5_read_data(IPAPX,"/paramdescrip/PARFMT",PARFMT)
+      ENDIF
+      TERP(:NCAL,:NMIX)=0.0
+      MIXC(:NMIX)=0
+      IF(IMPX.GT.1) THEN
+        WRITE(IOUT,*) 'NPAR=',NPAR,SIZE(PARKEY,1)
+        DO I=1,NPAR
+          WRITE(IOUT,*)'PARKEY(',I,')=',PARKEY(I),' PARFMT=',PARFMT(I)
+        ENDDO
+      ENDIF
+*----
+*  READ (INTERP_DATA) AND SET VALI, VALR AND VALH PARAMETERS
+*  CORRESPONDING TO THE INTERPOLATION POINT. FILL MUPLET FOR
+*  PARAMETERS SET WITHOUT INTERPOLATION.
+*----
+      IBM=0
+      MAXNIS=0
+      NISO(:NMIX)=0
+      LISO(:NMIX)=.TRUE.
+      LDELTA(:NMIX)=.FALSE.
+      ITODO(:NMIX,:MD2)=0
+      LFROM=.FALSE.
+   10 CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT)
+      IF(INDIC.NE.3) CALL XABORT('ACRDRV: CHARACTER DATA EXPECTED.')
+   20 IF(TEXT72.EQ.'MIX') THEN
+         MUPLET(:NPAR)=0
+         MUTYPE(:NPAR)=0
+         VALI(:NPAR)=0
+         VALR(:NPAR,1)=0.0
+         VALR(:NPAR,2)=0.0
+         DO 30 I=1,NPAR
+         VALH(I)=' '
+   30    CONTINUE
+         LCUB2(:NPAR)=LCUBIC
+         CALL REDGET(INDIC,IBM,FLOTT,TEXT72,DFLOTT)
+         IF(INDIC.NE.1) CALL XABORT('ACRDRV: INTEGER DATA EXPECTED.')
+         IF(IBM.GT.NMIX) THEN
+            WRITE(HSMG,'(27HACRDRV: NMIX OVERFLOW (IBM=,I8,6H NMIX=,I8,
+     1      2H).)') IBM,NMIX
+            CALL XABORT(HSMG)
+         ENDIF
+         IBMOLD=1
+         CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('ACRDRV: CHARACTER DATA EXPECTED.')
+         IF(TEXT72.EQ.'FROM') THEN
+            CALL REDGET(INDIC,IBMOLD,FLOTT,TEXT72,DFLOTT)
+            IF(INDIC.NE.1) CALL XABORT('ACRDRV: INTEGER DATA EXPECTED.')
+            IF(IBMOLD.GT.NMIL) CALL XABORT('ACRDRV: APEX MIX OVERFLOW'
+     1      //'(1).')
+            MIXC(IBM)=IBMOLD
+            LFROM=.TRUE.
+            GO TO 10
+         ELSE IF(TEXT72.EQ.'USE') THEN
+            IF(IBM.GT.NMIL) CALL XABORT('SCRDRV: APEX MIX OVERFLOW(2).')
+            MIXC(IBM)=IBM
+            LFROM=.TRUE.
+            GO TO 10
+         ENDIF
+         MIXC(IBM)=IBMOLD
+         GO TO 20
+      ELSE IF(TEXT72.EQ.'MICRO') THEN
+         IF(IBM.EQ.0) CALL XABORT('ACRDRV: MIX NOT SET (1).')
+         CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('ACRDRV: CHARACTER DATA EXPECTED.')
+         IF(TEXT72.EQ.'ALL') THEN
+            LISO(IBM)=.TRUE.
+         ELSE IF(TEXT72.EQ.'ONLY') THEN
+            LISO(IBM)=.FALSE.
+         ENDIF
+         CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('ACRDRV: CHARACTER DATA EXPECTED.')
+   40    IF(TEXT72.EQ.'ENDMIX') THEN
+            GO TO 20
+         ELSE IF(TEXT72.EQ.'NOEV') THEN
+            IF(NISO(IBM).EQ.0) CALL XABORT('ACRDRV: MISPLACED NOEV.')
+            ITODO(IBM,NISO(IBM))=1
+         ELSE
+            NISO(IBM)=NISO(IBM)+1
+            IF(NISO(IBM).GT.MD2) CALL XABORT('ACRDRV: MD2 OVERFLOW.')
+            MAXNIS=MAX(MAXNIS,NISO(IBM))
+            HISO(IBM,NISO(IBM))=TEXT72(:8)
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT)
+            IF(INDIC.EQ.2) THEN
+               CONC(IBM,NISO(IBM))=FLOTT
+            ELSE IF((INDIC.EQ.3).AND.(TEXT72.EQ.'*')) THEN
+               CONC(IBM,NISO(IBM))=-99.99
+            ELSE
+               CALL XABORT('ACRDRV: INVALID HISO DATA.')
+            ENDIF
+         ENDIF
+         CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('ACRDRV: CHARACTER DATA EXPECTED.')
+         GO TO 40
+      ELSE IF((TEXT72.EQ.'SET').OR.(TEXT72.EQ.'DELTA')) THEN
+         IF(IBM.EQ.0) CALL XABORT('ACRDRV: MIX NOT SET (2).')
+         ITYPE=0
+         IF(TEXT72.EQ.'SET') THEN
+            ITYPE=1
+         ELSE IF(TEXT72.EQ.'DELTA') THEN
+            ITYPE=2
+            LDELTA(IBM)=.TRUE.
+         ENDIF
+         CALL REDGET(INDIC,NITMA,FLOTT,TEXT24,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('ACRDRV: CHARACTER DATA EXPECTED.')
+         IF((TEXT72.EQ.'LINEAR').OR.(TEXT72.EQ.'CUBIC')) THEN
+            HCUBIC=TEXT24(:12)
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT24,DFLOTT)
+         ELSE
+            HCUBIC=' '
+         ENDIF
+         IF(INDIC.NE.3) CALL XABORT('ACRDRV: CHARACTER DATA EXPECTED.')
+         DO 50 I=1,NPAR
+         IF(TEXT24.EQ.PARKEY(I)) THEN
+            IPAR=I
+            GO TO 60
+         ENDIF
+   50    CONTINUE
+         CALL XABORT('ACRDRV: PARAMETER '//TRIM(TEXT24)//' NOT FOUND.')
+   60    IF(HCUBIC.EQ.'LINEAR') THEN
+            LCUB2(IPAR)=.FALSE.
+         ELSE IF(HCUBIC.EQ.'CUBIC') THEN
+            LCUB2(IPAR)=.TRUE.
+         ENDIF
+         CALL hdf5_read_data(IPAPX,"/paramdescrip/NVALUE",NVALUE)
+         IF(NVALUE(IPAR).GT.MAXVAL) CALL XABORT('ACRDRV: MAXVAL OVERFL'
+     1   //'OW.')
+         WRITE(RECNAM,'(''/paramvalues/PVAL'',I8)') IPAR
+         CALL hdf5_info(IPAPX,RECNAM,RANK,TYPE,NBYTE,DIMSR)
+         IF(TYPE.EQ.99) THEN
+            CALL hdf5_list(IPAPX,RECNAM)
+            FLUSH(6)
+            WRITE(HSMG,'(25HACRDRV: GLOBAL PARAMETER ,A,9H NOT SET.)')
+     1      TRIM(PARKEY(IPAR))
+            CALL XABORT(HSMG)
+         ENDIF
+         IF(PARFMT(IPAR).EQ.'ENTIER') THEN
+            IF(ITYPE.NE.1) CALL XABORT('ACRDRV: SET MANDATORY WITH INT'
+     1      //'EGER PARAMETERS.')
+            CALL REDGET(INDIC,VALI(IPAR),FLOTT,TEXT72,DFLOTT)
+            IF(INDIC.NE.1) CALL XABORT('ACRDRV: INTEGER DATA EXPECTED.')
+            CALL hdf5_read_data(IPAPX,RECNAM,VINTE)
+            DO 70 J=1,NVALUE(IPAR)
+            IF(VALI(IPAR).EQ.VINTE(J)) THEN
+               MUPLET(IPAR)=J
+               MUTYPE(IPAR)=ITYPE
+               DEALLOCATE(NVALUE,VINTE)
+               GO TO 10
+            ENDIF
+   70       CONTINUE
+            WRITE(HSMG,'(26HACRDRV: INTEGER PARAMETER ,A,9H WITH VAL,
+     1      2HUE,I5,33H NOT FOUND IN APEX FILE DATABASE.)') 
+     2      TRIM(PARKEY(IPAR)),VALI(IPAR)
+            CALL XABORT(HSMG)
+         ELSE IF(PARFMT(IPAR).EQ.'FLOTTANT') THEN
+            CALL REDGET(INDIC,NITMA,VALR(IPAR,1),TEXT72,DFLOTT)
+            IF(INDIC.NE.2) CALL XABORT('ACRDRV: REAL DATA EXPECTED.')
+            VALR(IPAR,2)=VALR(IPAR,1)
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT)
+            IF(INDIC.EQ.2) THEN
+               VALR(IPAR,2)=FLOTT
+               CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT)
+            ENDIF
+            CALL hdf5_read_data(IPAPX,RECNAM,VREAL)
+            IF(VALR(IPAR,1).EQ.VALR(IPAR,2)) THEN
+               DO 80 J=1,NVALUE(IPAR)
+               IF(ABS(VALR(IPAR,1)-VREAL(J)).LE.REPS*ABS(VREAL(J))) THEN
+                  MUPLET(IPAR)=J
+                  IF(ITYPE.NE.1) MUPLET(IPAR)=-1
+                  MUTYPE(IPAR)=ITYPE
+                  DEALLOCATE(NVALUE,VREAL)
+                  GO TO 20
+               ENDIF
+   80          CONTINUE
+            ENDIF
+            IF(VALR(IPAR,1).LT.VREAL(1)) THEN
+               WRITE(HSMG,'(23HACRDRV: REAL PARAMETER ,A,10H WITH VALU,
+     1         1HE,1P,E12.4,25H IS OUTSIDE THE DOMAIN (<,E12.4,1H))')
+     2         TRIM(PARKEY(IPAR)),VALR(IPAR,1),VREAL(1)
+               CALL XABORT(HSMG)
+            ELSE IF(VALR(IPAR,2).GT.VREAL(NVALUE(IPAR))) THEN
+               WRITE(HSMG,'(23HACRDRV: REAL PARAMETER ,A,10H WITH VALU,
+     1         1HE,1P,E12.4,25H IS OUTSIDE THE DOMAIN (>,E12.4,1H))')
+     2         TRIM(PARKEY(IPAR)),VALR(IPAR,1),VREAL(NVALUE(IPAR))
+               CALL XABORT(HSMG)
+            ELSE IF(VALR(IPAR,1).GT.VALR(IPAR,2)) THEN
+               WRITE(HSMG,'(23HACRDRV: REAL PARAMETER ,A,9H IS DEFIN,
+     1         7HED WITH,1P,E12.4,2H >,E12.4,1H.)') TRIM(PARKEY(IPAR)),
+     2         VALR(IPAR,1),VALR(IPAR,2)
+               CALL XABORT(HSMG)
+            ENDIF
+            MUPLET(IPAR)=-1
+            MUTYPE(IPAR)=ITYPE
+            DEALLOCATE(NVALUE,VREAL)
+            GO TO 20
+         ELSE IF(PARFMT(IPAR).EQ.'CHAINE') THEN
+            IF(ITYPE.NE.1) CALL XABORT('ACRDRV: SET MANDATORY WITH STR'
+     1      //'ING PARAMETERS.')
+            CALL REDGET(INDIC,NITMA,FLOTT,VALH(IPAR),DFLOTT)
+            IF(INDIC.NE.3) CALL XABORT('ACRDRV: STRING DATA EXPECTED.')
+            CALL hdf5_read_data(IPAPX,RECNAM,VCHAR)
+            DO 90 J=1,NVALUE(IPAR)
+            IF(VALH(IPAR).EQ.VCHAR(J)) THEN
+               MUPLET(IPAR)=J
+               MUTYPE(IPAR)=ITYPE
+               DEALLOCATE(NVALUE,VCHAR)
+               GO TO 10
+            ENDIF
+   90       CONTINUE
+            WRITE(HSMG,'(25HACRDRV: STRING PARAMETER ,A,10H WITH VALU,
+     1      2HE ,A12,33H NOT FOUND IN APEX FILE DATABASE.)')
+     2      TRIM(PARKEY(IPAR)), VALH(IPAR)
+            CALL XABORT(HSMG)
+         ELSE
+            CALL XABORT('ACRDRV: INVALID FORMAT='//PARFMT(IPAR))
+         ENDIF
+      ELSE IF(TEXT72.EQ.'ENDMIX') THEN
+*----
+*  COMPUTE THE TERP FACTORS USING TABLE-OF-CONTENT INFORMATION.
+*----
+         IF(IMPX.GT.0) THEN
+           DO IPAR=1,NPAR
+             IF(PARFMT(IPAR).EQ.'FLOTTANT')THEN
+               IF(LCUB2(IPAR)) THEN
+                 WRITE(IOUT,'(26H ACRDRV: GLOBAL PARAMETER:,A,7H ->CUBI,
+     1           16HC INTERPOLATION.)') TRIM(PARKEY(IPAR))
+               ELSE
+                 WRITE(IOUT,'(26H ACRDRV: GLOBAL PARAMETER:,A,7H ->LINE,
+     1           17HAR INTERPOLATION.)') TRIM(PARKEY(IPAR))
+               ENDIF
+             ENDIF
+           ENDDO
+         ENDIF
+         IF(IBMOLD.GT.NMIL)CALL XABORT('ACRDRV: APEX MIX OVERFLOW(3).')
+         IF(IBM.GT.NMIX)CALL XABORT('ACRDRV: MIX OVERFLOW (MICROLIB).')
+         IF(NCAL.EQ.1) THEN
+           TERP(1,IBM)=1.0
+         ELSE
+           CALL ACRTRP(IPAPX,LCUB2,IMPX,NPAR,NCAL,MUPLET,MUTYPE,VALR,
+     1     0.0,TERP(1,IBM))
+         ENDIF
+         IBM=0
+      ELSE IF((TEXT72.EQ.'APEX').OR.(TEXT72.EQ.'TABLE').OR.
+     1   (TEXT72.EQ.'CHAIN').OR.(TEXT72.EQ.';')) THEN
+*----
+*  CHECK TERP FACTORS AND RETURN
+*----
+         IF(TEXT72.EQ.';') ITER=0
+         IF(TEXT72.EQ.'APEX') ITER=1
+         IF(TEXT72.EQ.'TABLE') ITER=2
+         IF(TEXT72.EQ.'CHAIN') ITER=3
+         DO 150 IBM=1,NMIX
+         IBMOLD=MIXC(IBM)
+         IF(IBMOLD.EQ.0) GO TO 150
+         IF(NISO(IBM).GT.MAXNIS) CALL XABORT('ACRDRV: MAXNIS OVERFLOW.')
+         IF(LDELTA(IBM)) THEN
+            SUM=0.0
+         ELSE
+            SUM=1.0
+         ENDIF
+         DO 140 ICAL=1,NCAL
+         SUM=SUM-TERP(ICAL,IBM)
+  140    CONTINUE
+         IF(ABS(SUM).GT.1.0E-4) THEN
+            WRITE(HSMG,'(43HACRDRV: INVALID INTERPOLATION FACTORS IN MI,
+     1      5HXTURE,I4,1H.)') IBM
+            CALL XABORT(HSMG)
+         ENDIF
+  150    CONTINUE
+         GO TO 160
+      ELSE
+         CALL XABORT('ACRDRV: '//TEXT72//' IS AN INVALID KEYWORD.')
+      ENDIF
+      GO TO 10
+*----
+*  PRINT INTERPOLATION (TERP) FACTORS
+*----
+  160 IF(IMPX.GT.2) THEN
+        WRITE(IOUT,'(/30H ACRDRV: INTERPOLATION FACTORS)')
+        DO ICAL=1,NCAL
+          DO IBM=1,NMIX
+            IF(TERP(ICAL,IBM).NE.0.0) THEN
+              WRITE(IOUT,170) ICAL,(TERP(ICAL,JBM),JBM=1,NMIX)
+              EXIT
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      IF(NPAR.GT.0) DEALLOCATE(PARFMT,PARKEY)
+      DEALLOCATE(LDELTA)
+      RETURN
+  170 FORMAT(6H CALC=,I8,6H TERP=,1P,8E13.5/(20X,8E13.5))
+      END
diff --git a/Donjon/src/ACRISO.f b/Donjon/src/ACRISO.f
new file mode 100644
index 0000000..11645b8
--- /dev/null
+++ b/Donjon/src/ACRISO.f
@@ -0,0 +1,262 @@
+*DECK ACRISO
+      SUBROUTINE ACRISO(IPLIB,NREA,NGRP,NL,NPRC,NOMREA,NWT0,XS,SIGS,
+     > SS2D,TAUXFI,LXS,LAMB,CHIRS,BETAR,INVELS,INAME,LSTRD,LPURE,ILUPS,
+     > ITRANC,IFISS)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Store an isotopic data recovered from an APEX file into a Microlib.
+*
+*Copyright:
+* Copyright (C) 2021 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPLIB   address of the output microlib LCM object
+* NREA    number of reactions in the Apex file
+* NGRP    number of energy groups
+* NL      maximum Legendre order (NL=1 is for isotropic scattering)
+* NPRC    number of delayed neutron precursor groups
+* NOMREA  names of reactions in the Apex file
+* NWT0    average flux
+* XS      cross sections per reaction
+* SIGS    scattering cross sections
+* SS2D    complete scattering matrix
+* TAUXFI  interpolated fission rate
+* LXS     existence flag of each reaction
+* LAMB    decay constants of the delayed neutron precursor groups
+* CHIRS   delayed neutron emission spectrums
+* BETAR   delayed neutron fractions
+* INVELS  group-average of the inverse neutron velocity
+* INAME   name of the isotope.
+* LSTRD   flag set to .true. if B2=0.0.
+* LPURE   =.true. if the interpolation is a pure linear interpolation 
+*         with TERP factors.
+* ILUPS   up-scattering removing flag (=1 to remove up-scattering from
+*         output cross-sections).
+*
+*Parameters: output
+* ITRANC  transport correction flag
+* IFISS   fission flag
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPLIB
+      INTEGER NREA,NGRP,NL,NPRC,INAME(2),ITRANC,IFISS,ILUPS
+      REAL NWT0(NGRP),XS(NGRP,NREA),SIGS(NGRP,NL),SS2D(NGRP,NGRP,NL),
+     > TAUXFI,LAMB(NPRC),CHIRS(NGRP,NPRC),BETAR(NPRC),INVELS(NGRP)
+      LOGICAL LXS(NREA),LSTRD,LPURE
+      CHARACTER NOMREA(NREA)*12
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER I0, IGFROM, IGMAX, IGMIN, IGR, JGR, IGTO, ILEG, IPRC,
+     & IREA, NXSCMP, IL, IRENT0
+      LOGICAL LDIFF,LHFACT,LZERO
+      REAL CONVEN,FF,CSCAT
+      CHARACTER TEXT12*12
+      CHARACTER HCM(0:10)*2,NAMLEG*2
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: ITYPRO,NJJ,IJJ
+      REAL, ALLOCATABLE, DIMENSION(:) :: STRD,WRK,XSSCMP,EFACT
+      DATA HCM  /'00','01','02','03','04','05','06','07','08','09','10'/
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(STRD(NGRP),EFACT(NGRP))
+*----
+*  UP-SCATTERING CORRECTION
+*----
+      IRENT0=0
+      DO IREA=1,NREA
+        IF(NOMREA(IREA).EQ.'TOTA') IRENT0=IREA
+      ENDDO
+      IF(IRENT0.EQ.0) CALL XABORT('ACRISO: MISSING NTOT0.')
+      IF(ILUPS.EQ.1) THEN
+        DO JGR=2,NGRP
+          DO IGR=1,JGR-1 ! IGR < JGR
+            CSCAT=SS2D(IGR,JGR,1)
+            FF=NWT0(JGR)/NWT0(IGR)
+            XS(IGR,IRENT0)=XS(IGR,IRENT0)-CSCAT*FF
+            XS(JGR,IRENT0)=XS(JGR,IRENT0)-CSCAT
+            DO IL=1,NL
+              CSCAT=SS2D(IGR,JGR,IL)
+              SIGS(IGR,IL)=SIGS(IGR,IL)-CSCAT*FF
+              SIGS(JGR,IL)=SIGS(JGR,IL)-CSCAT
+              SS2D(JGR,IGR,IL)=SS2D(JGR,IGR,IL)-CSCAT*FF
+              SS2D(IGR,JGR,IL)=0.0
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF
+*----
+*  BUILD MICROLIB
+*----
+      WRITE(TEXT12,'(2A4)') (INAME(I0),I0=1,2)
+      CALL LCMPTC(IPLIB,'ALIAS',12,TEXT12)
+      CALL LCMPUT(IPLIB,'NWT0',NGRP,2,NWT0)
+      IF(NPRC.GT.0) THEN
+        CALL LCMPUT(IPLIB,'LAMBDA-D',NPRC,2,LAMB)
+        CALL LCMPUT(IPLIB,'OVERV',NGRP,2,INVELS)
+      ENDIF
+      ITRANC=0
+      IFISS=0
+      LDIFF=.FALSE.
+      LHFACT=.FALSE.
+      STRD(:NGRP)=0.0
+      EFACT(:NGRP)=0.0
+      CONVEN=1.0E6 ! convert MeV to eV
+      DO IREA=1,NREA
+        IF(.NOT.LXS(IREA)) CYCLE
+        LZERO=.TRUE.
+        DO IGR=1,NGRP
+          LZERO=LZERO.AND.(XS(IGR,IREA).EQ.0.0)
+        ENDDO
+        IF(LZERO) CYCLE
+        IF(NOMREA(IREA).EQ.'TOTA') THEN
+          IF(LSTRD) THEN
+            DO IGR=1,NGRP
+              STRD(IGR)=STRD(IGR)+XS(IGR,IREA)
+            ENDDO
+          ENDIF
+          CALL LCMPUT(IPLIB,'NTOT0',NGRP,2,XS(1,IREA))
+        ELSE IF(NOMREA(IREA).EQ.'N2N') THEN
+*         correct scattering XS with excess XS
+          DO IGR=1,NGRP
+            SIGS(IGR,1)=SIGS(IGR,1)+XS(IGR,IREA)
+          ENDDO
+          CALL LCMPUT(IPLIB,'N2N',NGRP,2,XS(1,IREA))
+        ELSE IF(NOMREA(IREA).EQ.'FISS') THEN
+          CALL LCMPUT(IPLIB,'NFTOT',NGRP,2,XS(1,IREA))
+        ELSE IF(NOMREA(IREA).EQ.'ABSO') THEN
+          CALL LCMPUT(IPLIB,'NG',NGRP,2,XS(1,IREA))
+        ELSE IF(NOMREA(IREA).EQ.'CHI') THEN
+          IF(.NOT.LPURE) THEN
+            DO IGR=1,NGRP
+              IF(XS(IGR,IREA).NE.0.0) THEN
+                XS(IGR,IREA)=XS(IGR,IREA)/TAUXFI
+              ENDIF
+            ENDDO
+          ENDIF
+          CALL LCMPUT(IPLIB,'CHI',NGRP,2,XS(1,IREA))
+          DO IPRC=1,NPRC
+            WRITE(TEXT12,'(A3,I2.2)') 'CHI',IPRC
+            CALL LCMPUT(IPLIB,TEXT12,NGRP,2,CHIRS(1,IPRC))
+          ENDDO
+        ELSE IF(NOMREA(IREA).EQ.'NUFI') THEN
+          IFISS=1
+          CALL LCMPUT(IPLIB,'NUSIGF',NGRP,2,XS(1,IREA))
+          IF(NPRC.GT.0) THEN
+            ALLOCATE(WRK(NGRP))
+            DO IPRC=1,NPRC
+              DO IGR=1,NGRP
+                WRK(IGR)=XS(IGR,IREA)*BETAR(IPRC)
+              ENDDO
+              WRITE(TEXT12,'(A6,I2.2)') 'NUSIGF',IPRC
+              CALL LCMPUT(IPLIB,TEXT12,NGRP,2,WRK)
+            ENDDO
+            DEALLOCATE(WRK)
+          ENDIF
+        ELSE IF(NOMREA(IREA).EQ.'ENER') THEN
+          LHFACT=.TRUE.
+          DO IGR=1,NGRP
+            EFACT(IGR)=EFACT(IGR)+XS(IGR,IREA)*CONVEN
+          ENDDO
+        ELSE IF(NOMREA(IREA).EQ.'EGAM') THEN
+          LHFACT=.TRUE.
+          DO IGR=1,NGRP
+            EFACT(IGR)=EFACT(IGR)+XS(IGR,IREA)*CONVEN
+          ENDDO
+        ELSE IF(NOMREA(IREA).EQ.'KAFI') THEN
+          LHFACT=.TRUE.
+          DO IGR=1,NGRP
+            EFACT(IGR)=EFACT(IGR)+XS(IGR,IREA)*CONVEN
+          ENDDO
+        ELSE IF(NOMREA(IREA).EQ.'LEAK') THEN
+          LDIFF=LSTRD
+          IF(.NOT.LSTRD) THEN
+            DO IGR=1,NGRP
+              LDIFF=LDIFF.OR.(XS(IGR,IREA).NE.0.0)
+              STRD(IGR)=XS(IGR,IREA)
+            ENDDO
+          ENDIF
+        ELSE IF(NOMREA(IREA).EQ.'DIFF') THEN
+          CYCLE
+        ELSE IF(NOMREA(IREA).EQ.'SCAT') THEN
+          CYCLE
+        ELSE
+          CALL LCMPUT(IPLIB,NOMREA(IREA),NGRP,2,XS(1,IREA))
+        ENDIF
+      ENDDO
+      IF(LSTRD) THEN
+        IF((ITRANC.EQ.0).AND.(NL.GT.1)) THEN
+*         Apollo-type transport correction
+          DO IGR=1,NGRP
+            STRD(IGR)=STRD(IGR)-SIGS(IGR,2)
+          ENDDO
+        ENDIF
+      ELSE
+        DO IGR=1,NGRP
+          STRD(IGR)=1.0/(3.0*STRD(IGR))
+        ENDDO
+      ENDIF
+      IF((ITRANC.EQ.0).AND.(NL.GT.1)) THEN
+*       Apollo-type transport correction
+        ITRANC=2
+        CALL LCMPUT(IPLIB,'TRANC',NGRP,2,SIGS(1,2))
+      ENDIF
+      IF(LDIFF.OR.LSTRD) CALL LCMPUT(IPLIB,'STRD',NGRP,2,STRD)
+      IF(LHFACT)  CALL LCMPUT(IPLIB,'H-FACTOR',NGRP,2,EFACT)
+*----
+*  SAVE SCATTERING VECTORS AND MATRICES (DO NOT USE XDRLGS TO SAVE CPU
+*  TIME)
+*----
+      ALLOCATE(NJJ(NGRP),IJJ(NGRP),XSSCMP(NGRP*NGRP),ITYPRO(NL))
+      DO ILEG=1,NL
+        IF(ILEG.LE.11) THEN
+          NAMLEG=HCM(ILEG-1)
+        ELSE
+          WRITE(NAMLEG,'(I2.2)') ILEG-1
+        ENDIF
+        CALL LCMPUT(IPLIB,'SIGS'//NAMLEG,NGRP,2,SIGS(1,ILEG))
+        NXSCMP=0
+        DO IGTO=1,NGRP
+          IGMIN=IGTO
+          IGMAX=IGTO
+          DO IGFROM=1,NGRP
+            IF(SS2D(IGTO,IGFROM,ILEG).NE.0.0) THEN
+              IGMIN=MIN(IGMIN,IGFROM)
+              IGMAX=MAX(IGMAX,IGFROM)
+            ENDIF
+          ENDDO
+          IJJ(IGTO)=IGMAX
+          NJJ(IGTO)=IGMAX-IGMIN+1
+          DO IGFROM=IGMAX,IGMIN,-1
+            NXSCMP=NXSCMP+1
+            XSSCMP(NXSCMP)=SS2D(IGTO,IGFROM,ILEG)
+          ENDDO
+        ENDDO
+        CALL LCMPUT(IPLIB,'NJJS'//NAMLEG,NGRP,1,NJJ)
+        CALL LCMPUT(IPLIB,'IJJS'//NAMLEG,NGRP,1,IJJ)
+        CALL LCMPUT(IPLIB,'SCAT'//NAMLEG,NXSCMP,2,XSSCMP)
+        ITYPRO(ILEG)=1
+      ENDDO
+      CALL LCMPUT(IPLIB,'SCAT-SAVED',NL,1,ITYPRO)
+      DEALLOCATE(ITYPRO,XSSCMP,IJJ,NJJ)
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(EFACT,STRD)
+      RETURN
+      END
diff --git a/Donjon/src/ACRLIB.f b/Donjon/src/ACRLIB.f
new file mode 100644
index 0000000..cc2cf8e
--- /dev/null
+++ b/Donjon/src/ACRLIB.f
@@ -0,0 +1,899 @@
+*DECK ACRLIB
+      SUBROUTINE ACRLIB(MAXNIS,MAXISO,IPLIB,IPAPX,IACCS,NMIX,NGRP,IMPX,
+     1 HEQUI,NCAL,ITER,MY1,MY2,MD1,MD2,TERP,NISO,LISO,HISO,CONC,ITODO,
+     2 MIXC,LRES,LPURE,LTOTAL,ILUPS,B2,LFROM,VTOT,YLDS,DECAYC)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Build the Microlib by scanning the NCAL elementary calculations in
+* a Apex file and weighting them with TERP factors.
+*
+*Copyright:
+* Copyright (C) 2021 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* MAXNIS  maximum value of NISO(I) in user data.
+* MAXISO  maximum allocated space for output Microlib TOC information.
+* IPLIB   address of the output Microlib LCM object.
+* IPAPX   pointer to the Apex file.
+* IACCS   =0 Microlib is created; =1 ... is updated.
+* NMIX    maximum number of material mixtures in the Microlib.
+* NGRP    number of energy groups.
+* IMPX    print parameter (equal to zero for no print).
+* HEQUI   keyword of SPH-factor set to be recovered.
+* NCAL    number of elementary calculations in the Apex file.
+* ITER    completion flag (=0: compute the macrolib).
+* MY1     number of fissile isotopes including macroscopic sets.
+* MY2     number of fission fragment.
+* MD1     number of types of radioactive decay reactions.
+* MD2     number of particularized isotopes including macro.
+* TERP    interpolation factors.
+* NISO    number of user-selected isotopes.
+* LISO    type of treatment (=.true.: ALL; =.false.: ONLY).
+* HISO    name of the user-selected isotopes.
+* CONC    user-defined number density of the user-selected isotopes. A
+*         value of -99.99 is set to indicate that the Apex file value is
+*         used.
+* ITODO   non-depletion mask (=1 to force a user-selected isotope to be
+*         non-depleting)
+* MIXC    mixture index in the Apex file corresponding to each Microlib
+*         mixture. Equal to zero if a Microlib mixture is not updated.
+* LRES    =.true. if the interpolation is done without updating isotopic 
+*         densities
+* LPURE   =.true. if the interpolation is a pure linear interpolation 
+*         with TERP factors.
+* LTOTAL =.true. to use the mac/TOTAL macroscopic set.
+* ILUPS   up-scattering removing flag (=1 to remove up-scattering from
+*         output cross-sections).
+* B2      buckling
+* LFROM   macroregion flag (=.true. if 'xs       n' groups are set).
+* VTOT    volume of updated core.
+* YLDS    fission yields.
+* DECAYC  radioactive decay constants.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      USE hdf5_wrap
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPLIB,IPAPX
+      INTEGER MAXNIS,MAXISO,IACCS,NMIX,NGRP,IMPX,NCAL,ITER,MY1,MY2,MD1,
+     1 MD2,NISO(NMIX),ITODO(NMIX,MAXNIS),MIXC(NMIX),ILUPS
+      REAL TERP(NCAL,NMIX),CONC(NMIX,MAXNIS),B2
+      DOUBLE PRECISION VTOT,YLDS(MY1,MY2),DECAYC(MD1,MD2)
+      LOGICAL LISO(NMIX),LRES,LPURE,LTOTAL,LFROM
+      CHARACTER(LEN=80) HEQUI
+      CHARACTER(LEN=8) HISO(NMIX,MD2)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXMAC=2
+      INTEGER, PARAMETER::MAXREA=50
+      INTEGER, PARAMETER::NSTATE=40
+      INTEGER, PARAMETER::MAXFRD=4
+      TYPE(C_PTR) JPLIB,KPLIB
+      REAL B2APEX, FACT0, WEIGHT
+      INTEGER I, I0, K, IBM, IBMOLD, ICAL, ID1, IED2, IFISS, IGR,
+     & ILONG, IMAC, IOF, IPRC, IREA, IREAF, IRES, ISO, ITRANC, ITSTMP,
+     & ITYLCM, IY1, IY2, JSO,  KSO, KSO1, LMY1, LSO, MAXMIX, NBISO,
+     & NBISO1, NBISO2, NBISO2I, NBS1, NCALS, NED2, NL, NLAM, NBMAC,
+     & NMIL, NPAR, NPRC, NREA, NSURFD, NISOF, NISOP, NISOS, NISOTS,
+     & NVP, RANK, NBYTE, TYPE, ISURF, DIMSR(5)
+      CHARACTER RECNAM*80,TEXT8*8, TEXT12*12,HSMG*131,HVECT2(MAXREA)*8,
+     1 HRESID*8,HHAD(MAXFRD)*16
+      INTEGER ISTATE(NSTATE),INAME(2),IHRES(2)
+      REAL TMPDAY(3)
+      LOGICAL LUSER,LSTRD
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IMIX2,ITOTM,IRESM,ISONA,
+     1 ISOMI,ITOD2,ISTY1,ISTY2,IPIFI,IMICR,ITOD1,JJSO,IPYMIX,DIMS_APX
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: HUSE2,HNAM2
+      REAL, ALLOCATABLE, DIMENSION(:) :: DENS2,DENS3,VOL2,VOLMI2,SPH,
+     1 ENER,XVOLM,CONCE,TAUXFI,NWT0,FLUXS,DENIS,GAR1,GAR2,LAMB,BETAR,
+     2 INVELS,BETARB,INVELSB
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: ADF,DENS1,FACT,DECAY2,
+     1 CHIRS,CHIRSB
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: XS,SIGS,DENS0,FLUX,ADF2,
+     1 YLDS2
+      REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: SS2D
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: YLDSM
+      LOGICAL, ALLOCATABLE, DIMENSION(:) :: LXS,MASK,MASKL
+      CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: HADF,HNOMIS,NOMISO,
+     1 NOMMAC,HPYNAM
+      CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: NOMREA
+*----
+*  RECOVER APEX FILE CHARACTERISTICS
+*----
+      I=0
+      CALL APXTOC(IPAPX,0,NLAM,NREA,NBISO,NBMAC,NMIL,NPAR,NVP,NISOF,
+     1 NISOP,NISOS,NCALS,I,NISOTS,NSURFD,NPRC)
+      IF(NGRP.NE.I) CALL XABORT('ACRLIB: INVALID VALUE OF NGRP.')
+      IF(NREA.GT.MAXREA) CALL XABORT('ACRLIB: MAXREA OVERFLOW')
+      IF(NBMAC.GT.MAXMAC) CALL XABORT('ACRLIB: MAXMAC OVERFLOW')
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(IMIX2(MAXISO),ITOD2(MAXISO),ISTY1(MAXISO),ISTY2(MAXISO),
+     1 HUSE2(3,MAXISO),HNAM2(3,MAXISO))
+      ALLOCATE(DENS2(MAXISO),DENS3(MAXISO),VOL2(MAXISO),VOLMI2(NMIX),
+     1 FLUX(NMIX,NGRP,2),SPH(NGRP))
+      ALLOCATE(HADF(NSURFD),ADF2(NMIX,NGRP,NSURFD))
+*----
+*  MICROLIB INITIALIZATION
+*----
+      VOLMI2(:NMIX)=0.0
+      DENS2(:MAXISO)=0.0
+      VOL2(:MAXISO)=0.0
+      IMIX2(:MAXISO)=0
+      ITOD2(:MAXISO)=0
+      ISTY2(:MAXISO)=0
+      IF(NSURFD.GT.0) ADF2(:NMIX,:NGRP,:NSURFD)=0.0
+      IF(IACCS.EQ.0) THEN
+         IF(LRES) CALL XABORT('ACRLIB: RES OPTION IS INVALID.')
+         NBISO2=0
+         NED2=0
+         TEXT12='L_LIBRARY'
+         CALL LCMPTC(IPLIB,'SIGNATURE',12,TEXT12)
+      ELSE
+         CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+         IF(ISTATE(1).NE.NMIX) CALL XABORT('ACRLIB: INVALID NUMBER OF '
+     1   //'MATERIAL MIXTURES IN THE MICROLIB.')
+         IF(ISTATE(3).NE.NGRP) CALL XABORT('ACRLIB: INVALID NUMBER OF '
+     1   //'ENERGY GROUPS IN THE MICROLIB.')
+         NBISO2=ISTATE(2)
+         IF(NBISO2.GT.MAXISO) CALL XABORT('ACRLIB: MAXISO OVERFLOW(1).')
+         NED2=ISTATE(13)
+         IF(NED2.GT.MAXREA) CALL XABORT('ACRLIB: MAXREA OVERFLOW.')
+         CALL LCMLEN(IPLIB,'MIXTURESVOL',ILONG,ITYLCM)
+         IF(ILONG.GT.0) THEN
+           CALL LCMGET(IPLIB,'MIXTURESVOL',VOLMI2)
+         ELSE
+           VOLMI2(:NMIX)=0.0
+         ENDIF
+         CALL LCMGET(IPLIB,'ISOTOPESUSED',HUSE2)
+         CALL LCMGET(IPLIB,'ISOTOPERNAME',HNAM2)
+         CALL LCMGET(IPLIB,'ISOTOPESDENS',DENS2)
+         CALL LCMGET(IPLIB,'ISOTOPESVOL',VOL2)
+         CALL LCMGET(IPLIB,'ISOTOPESMIX',IMIX2)
+         CALL LCMGET(IPLIB,'ISOTOPESTODO',ITOD2)
+         CALL LCMGET(IPLIB,'ISOTOPESTYPE',ISTY2)
+         IF(NED2.GT.0) CALL LCMGTC(IPLIB,'ADDXSNAME-P0',8,NED2,HVECT2)
+         IF(NSURFD.GT.0) THEN
+           CALL LCMSIX(IPLIB,'MACROLIB',1)
+           CALL LCMLEN(IPLIB,'ADF',ILONG,ITYLCM)
+           IF(ILONG.EQ.0) THEN
+             CALL LCMLIB(IPLIB)
+             CALL XABORT('ACRLIB: UNABLE TO FIND DIRECTORY ADF.')
+           ENDIF
+           CALL LCMSIX(IPLIB,'ADF',1)
+           CALL LCMGTC(IPLIB,'HADF',8,NSURFD,HADF)
+           DO I=1,NSURFD
+             CALL LCMGET(IPLIB,HADF(I),ADF2(1,1,I))
+           ENDDO
+           CALL LCMSIX(IPLIB,' ',2)
+           CALL LCMSIX(IPLIB,' ',2)
+         ENDIF
+      ENDIF
+*----
+*  RECOVER INFORMATION FROM physconst GROUP.
+*----
+      IF(hdf5_group_exists(IPAPX,"/physconst/")) THEN
+        CALL hdf5_read_data(IPAPX,"/physconst/ENRGS",ENER)
+      ELSE IF(hdf5_group_exists(IPAPX,"/physco001/")) THEN
+        CALL hdf5_read_data(IPAPX,"/physco001/ENRGS",ENER)
+      ELSE
+        CALL XABORT('ACRLIB: GROUP physconst NOT FOUND IN HDF5 FILE.')
+      ENDIF
+      DO IGR=1,NGRP+1
+        ENER(IGR)=ENER(IGR)/1.0E-6
+      ENDDO
+      CALL LCMPUT(IPLIB,'ENERGY',NGRP+1,2,ENER)
+      DO IGR=1,NGRP
+        ENER(IGR)=LOG(ENER(IGR)/ENER(IGR+1))
+      ENDDO
+      CALL LCMPUT(IPLIB,'DELTAU',NGRP,2,ENER)
+      DEALLOCATE(ENER)
+*----
+*  RECOVER INFORMATION FROM explicit GROUP.
+*----
+      ALLOCATE(ITOTM(NMIL),IRESM(NMIL))
+      ITOTM(:)=0
+      IRESM(:)=0
+      IREAF=0
+      IF(NREA.GT.0) THEN
+        IF(hdf5_group_exists(IPAPX,"/explicit/")) THEN
+          CALL hdf5_read_data(IPAPX,"/explicit/REANAME",NOMREA)
+        ELSE IF(hdf5_group_exists(IPAPX,"/expli001/")) THEN
+          CALL hdf5_read_data(IPAPX,"/expli001/REANAME",NOMREA)
+        ELSE
+          CALL XABORT('ACRLIB: GROUP explicit NOT FOUND IN HDF5 FILE.')
+        ENDIF
+        IF(IMPX.GT.1) THEN
+          WRITE(IOUT,'(29H ACRLIB: Available reactions:/(1X,10A13))')
+     1    (NOMREA(I),I=1,NREA)
+        ENDIF
+        DO IREA=1,NREA
+          IF(NOMREA(IREA).EQ.'NUFI') THEN
+            IREAF=IREA
+            EXIT
+          ENDIF
+        ENDDO
+      ENDIF
+      IF(NBISO.GT.0) THEN
+        IF(hdf5_group_exists(IPAPX,"/explicit/")) THEN
+          CALL hdf5_read_data(IPAPX,"/explicit/ISONAME",NOMISO)
+        ELSE IF(hdf5_group_exists(IPAPX,"/expli001/")) THEN
+          CALL hdf5_read_data(IPAPX,"/expli001/ISONAME",NOMISO)
+        ELSE
+          CALL XABORT('ACRLIB: GROUP explicit NOT FOUND IN HDF5 FILE.')
+        ENDIF
+      ENDIF
+      IF(LTOTAL.AND.(NBMAC.EQ.0)) CALL XABORT('ACRLIB: NBMAC=0.')
+      IF(NBMAC.GT.0) THEN
+        IF(hdf5_group_exists(IPAPX,"/explicit/")) THEN
+          CALL hdf5_read_data(IPAPX,"/explicit/MACNAME",NOMMAC)
+        ELSE IF(hdf5_group_exists(IPAPX,"/expli001/")) THEN
+          CALL hdf5_read_data(IPAPX,"/expli001/MACNAME",NOMMAC)
+        ELSE
+          CALL XABORT('ACRLIB: GROUP explicit NOT FOUND IN HDF5 FILE.')
+        ENDIF
+        DO I=1,NBMAC
+          IF(NOMMAC(I).EQ.'TOTAL') ITOTM(:)=I
+          IF(NOMMAC(I).EQ.'RESIDUAL') IRESM(:)=I
+        ENDDO
+        NBISO1=NBISO+NBMAC
+        ALLOCATE(HNOMIS(NBISO1))
+        IF(NBISO.GT.0) HNOMIS(:NBISO)=NOMISO(:NBISO)
+        IF(LTOTAL) THEN
+          ! use the mac/TOTAL macroscopic set
+          HNOMIS(:NBISO)=' '
+          DO I=1,NBMAC
+            IF(NOMMAC(I).EQ.'TOTAL') THEN
+              HNOMIS(NBISO+I)='*MAC*RES'
+            ELSE IF(NOMMAC(I).EQ.'RESIDUAL') THEN
+              HNOMIS(NBISO+I)=' '
+            ENDIF
+          ENDDO
+        ELSE
+          ! use the mac/RESIDUAL macroscopic set
+          DO I=1,NBMAC
+            IF(NOMMAC(I).EQ.'TOTAL') THEN
+              HNOMIS(NBISO+I)=' '
+            ELSE IF(NOMMAC(I).EQ.'RESIDUAL') THEN
+              HNOMIS(NBISO+I)='*MAC*RES'
+            ENDIF
+          ENDDO
+        ENDIF
+      ELSE
+        NBISO1=NBISO
+        ALLOCATE(HNOMIS(NBISO1))
+        IF(NBISO.GT.0) HNOMIS(:NBISO)=NOMISO(:NBISO)
+      ENDIF
+*----
+*  RECOVER VOLUMES.
+*----
+      ALLOCATE(XVOLM(NMIL))
+      RECNAM='calc       1/xs/'
+      DO IBMOLD=1,NMIL
+        IF(LFROM) WRITE(RECNAM,'(4Hcalc,I8,3H/xs,I8,1H/)') ICAL,IBMOLD
+        CALL hdf5_info(IPAPX,TRIM(RECNAM)//"MEDIA_VOLUME",RANK,
+     1  TYPE,NBYTE,DIMSR)
+        IF(TYPE.EQ.99) THEN
+          XVOLM(IBMOLD)=1.0
+          WRITE(IOUT,'(44H ACRLIB: WARNING -- Record MEDIA_VOLUME is m,
+     1    42Hissing in the Apex file. Volume set to 1.0)')
+        ELSE
+          CALL hdf5_read_data(IPAPX,TRIM(RECNAM)//"MEDIA_VOLUME",
+     1    XVOLM(IBMOLD))
+        ENDIF
+      ENDDO
+*----
+*  FIND SCATTERING ANISOTROPY.
+*----
+      CALL hdf5_info(IPAPX,TRIM(RECNAM)//"mac/TOTAL/DIFF",RANK,
+     1 TYPE,NBYTE,DIMSR)
+      IF(TYPE.EQ.99) CALL XABORT('ACRLIB: MISSING SCATTERING INFO.')
+      NL=DIMSR(2)
+      IF(IMPX.GT.1) THEN
+        WRITE(IOUT,'(36H ACRLIB: number of Legendre orders =,I4)') NL
+      ENDIF
+*----
+*  LOOP OVER APEX MIXTURES TO COMPUTE DENS0(NMIL,NCAL,NBISO1)
+*----
+      ALLOCATE(DENS0(NMIL,NCAL,NBISO1))
+      DENS0(:NMIL,:NCAL,:NBISO1)=0.0
+      DO 30 IBMOLD=1,NMIL
+      DO ICAL=1,NCAL
+        DO IBM=1,NMIX
+          IF((TERP(ICAL,IBM).NE.0.0).AND.(MIXC(IBM).EQ.IBMOLD)) GO TO 10
+        ENDDO
+        CYCLE
+   10   WRITE(RECNAM,'(4Hcalc,I8,4H/xs/)') ICAL
+        IF(LFROM) WRITE(RECNAM,'(4Hcalc,I8,3H/xs,I8,1H/)') ICAL,IBMOLD
+        IF(NBISO.GT.0) THEN
+          CALL hdf5_read_data(IPAPX,TRIM(RECNAM)//"mic/CONC",CONCE)
+          DO 20 ISO=1,NBISO
+            DENS0(IBMOLD,ICAL,ISO)=CONCE(ISO)
+   20     CONTINUE
+        ENDIF
+      ENDDO
+   30 CONTINUE
+      IF(NBISO.GT.0) DEALLOCATE(CONCE)
+*----
+*  LOOP OVER MICROLIB MIXTURES
+*----
+      YLDS(:MY1,:MY2)=0.0D0
+      DECAYC(:MD1,:MD2)=0.0D0
+      VTOT=0.0D0
+      DO 40 IBM=1,NMIX
+      IBMOLD=MIXC(IBM)
+      IF(IBMOLD.NE.0) VTOT=VTOT+XVOLM(IBMOLD)
+   40 CONTINUE
+      ALLOCATE(JJSO(NBISO+NBMAC),YLDSM(MY1,MY2),ITOD1(NBISO1))
+      ALLOCATE(TAUXFI(NBISO+NBMAC),NWT0(NGRP),
+     1 SIGS(NGRP,NL,NBISO+NBMAC),SS2D(NGRP,NGRP,NL,NBISO+NBMAC),
+     2 XS(NGRP,NREA,NBISO+NBMAC))
+      ALLOCATE(LXS(NREA))
+      ALLOCATE(CHIRS(NGRP,NPRC),BETAR(NPRC),INVELS(NGRP))
+      CHIRS(:NGRP,:NPRC)=0.0
+      BETAR(:NPRC)=0.0
+      INVELS(:NGRP)=0.0
+      ALLOCATE(BETARB(NPRC),INVELSB(NGRP))
+      ALLOCATE(DENS1(NBISO1,NCAL),FACT(NBISO1,NCAL))
+      JPLIB=LCMLID(IPLIB,'ISOTOPESLIST',(NBISO+NBMAC)*NMIX)
+*
+      DO 180 IBM=1,NMIX
+      IBMOLD=MIXC(IBM)
+      IF(IBMOLD.EQ.0) GO TO 180
+      IF(NISO(IBM).GT.MAXNIS) CALL XABORT('ACRLIB: MAXNIS OVERFLOW.')
+      VOLMI2(IBM)=XVOLM(IBMOLD)
+      IMAC=ITOTM(IBMOLD)
+      IRES=IRESM(IBMOLD)
+*----
+*  RECOVER ITOD1(NBISO1) INDICES.
+*----
+      ITOD1(:NBISO1)=0
+      DO 50 ISO=1,NBISO1 ! Apex file isotope
+        DO KSO=1,NISO(IBM) ! user-selected isotope
+          IF(NOMISO(ISO).EQ.HISO(IBM,KSO)) THEN
+            ITOD1(ISO)=ITODO(IBM,KSO)
+            GO TO 50
+          ENDIF
+        ENDDO
+   50 CONTINUE
+*----
+*  COMPUTE THE NUMBER DENSITIES OF EACH ELEMENTARY CALCULATION.
+*----
+      DENS1(:NBISO1,:NCAL)=0.0
+      DENS3(:NBISO1)=0.0
+      DO ICAL=1,NCAL
+        WEIGHT=TERP(ICAL,IBM)
+        IF(WEIGHT.EQ.0.0) CYCLE
+        DO ISO=1,NBISO
+          LUSER=.FALSE.
+          KSO1=0
+          DO KSO=1,NISO(IBM) ! user-selected isotope
+            IF(NOMISO(ISO).EQ.HISO(IBM,KSO)) THEN
+              KSO1=KSO
+              LUSER=(CONC(IBM,KSO1).NE.-99.99)
+              GO TO 60
+            ENDIF
+          ENDDO
+   60     IF(LUSER) THEN
+            DENS1(ISO,ICAL)=CONC(IBM,KSO1)
+            CYCLE
+          ENDIF
+          IF(.NOT.LISO(IBM)) CYCLE
+          DENS1(ISO,ICAL)=DENS0(IBMOLD,ICAL,ISO)
+        ENDDO
+        IF((NBISO.NE.0).AND.(.NOT.LTOTAL)) THEN
+          DENS1(NBISO+IRES,ICAL)=1.0
+        ELSE IF(IMAC.NE.0) THEN
+          DENS1(NBISO+IMAC,ICAL)=1.0
+        ENDIF
+        DO ISO=1,NBISO1
+          DENS3(ISO)=DENS3(ISO)+WEIGHT*DENS1(ISO,ICAL)
+        ENDDO
+      ENDDO
+      FACT(:NBISO1,:NCAL)=1.0
+      IF(.NOT.LPURE) THEN
+        DO ICAL=1,NCAL
+          IF(TERP(ICAL,IBM).EQ.0.0) CYCLE
+          DO ISO=1,NBISO1
+            IF(DENS3(ISO).GT.DENS1(ISO,ICAL)*1.0E-9) THEN
+              FACT(ISO,ICAL)=DENS1(ISO,ICAL)/DENS3(ISO)
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDIF
+*----
+*  INITIALIZE WORKING ARRAYS.
+*----
+      TAUXFI(:NBISO1)=0.0
+      NWT0(:NGRP)=0.0
+      SIGS(:NGRP,:NL,:NBISO1)=0.0
+      SS2D(:NGRP,:NGRP,:NL,:NBISO1)=0.0
+      XS(:NGRP,:NREA,:NBISO1)=0.0
+      LXS(:NREA)=.FALSE.
+      YLDSM(:MY1,:MY2)=0.0D0
+*----
+*  MAIN LOOP OVER ELEMENTARY CALCULATIONS
+*----
+      TEXT12='*MAC*RES'
+      READ(TEXT12,'(2A4)') IHRES(1),IHRES(2)
+      LSTRD=.FALSE.
+      B2APEX=B2
+      DO 80 ICAL=1,NCAL
+      WEIGHT=TERP(ICAL,IBM)
+      IF(WEIGHT.EQ.0.0) GO TO 80
+*----
+*  RECOVER INFORMATION FROM caldir GROUP.
+*----
+      WRITE(RECNAM,'(4Hcalc,I8,10H/kinetics/)') ICAL
+      CALL hdf5_info(IPAPX,TRIM(RECNAM)//"LAMBDA",RANK,TYPE,NBYTE,DIMSR)
+      NPRC=0
+      IF(TYPE.NE.99) THEN
+        NPRC=DIMSR(1)
+        CALL hdf5_read_data(IPAPX,TRIM(RECNAM)//"LAMBDA",LAMB)
+        CALL hdf5_read_data(IPAPX,TRIM(RECNAM)//"CHIDA",CHIRSB)
+        CALL hdf5_read_data(IPAPX,TRIM(RECNAM)//"BETADA",BETARB)
+        CALL hdf5_read_data(IPAPX,TRIM(RECNAM)//"INVELA",INVELSB)
+      ENDIF
+*----
+*  SELECT APEX MIXTURE IBMOLD.
+*----
+      WRITE(RECNAM,'(4Hcalc,I8,4H/xs/)') ICAL
+      IF(LFROM) WRITE(RECNAM,'(4Hcalc,I8,3H/xs,I8,1H/)') ICAL,IBMOLD
+      IF(HEQUI.NE.' ') THEN
+        CALL hdf5_read_data(IPAPX,TRIM(RECNAM)//"MEDIA_SPH/"//HEQUI,SPH)
+      ELSE
+        SPH(:NGRP)=1.0
+      ENDIF
+      CALL hdf5_read_data(IPAPX,TRIM(RECNAM)//"FLUX",FLUXS)
+      DO I=1,NGRP
+        FLUXS(I)=FLUXS(I)/XVOLM(IBMOLD)
+        NWT0(I)=NWT0(I)+WEIGHT*FLUXS(I)/SPH(I)
+      ENDDO
+      IF((NBISO.NE.0).AND.(.NOT.LTOTAL)) THEN
+        DO ISO=1,NBISO
+          FACT0=FACT(ISO,ICAL)
+          CALL ACRSX2(IPAPX,RECNAM,NREA,NGRP,NISOF,NISOP,NL,ISO,
+     1    NOMREA,B2APEX,FACT0,WEIGHT,SPH,FLUXS,IREAF,LPURE,LXS,
+     2    XS(1,1,ISO),SIGS(1,1,ISO),SS2D(1,1,1,ISO),TAUXFI(ISO))
+        ENDDO
+        IF(IRES.NE.0) THEN
+          FACT0=1.0
+          CALL ACRSX2(IPAPX,RECNAM,NREA,NGRP,NISOF,NISOP,NL,-2,NOMREA,
+     1    B2APEX,FACT0,WEIGHT,SPH,FLUXS,IREAF,LPURE,LXS,XS(1,1,NBISO+1),
+     2    SIGS(1,1,NBISO+1),SS2D(1,1,1,NBISO+1),TAUXFI(NBISO+IRES))
+        ENDIF
+      ELSE IF(IMAC.NE.0) THEN
+        FACT0=1.0
+        CALL ACRSX2(IPAPX,RECNAM,NREA,NGRP,NISOF,NISOP,NL,-1,NOMREA,
+     1  B2APEX,FACT0,WEIGHT,SPH,FLUXS,IREAF,LPURE,LXS,XS(1,1,NBISO+1),
+     2  SIGS(1,1,NBISO+1),SS2D(1,1,1,NBISO+1),TAUXFI(NBISO+IMAC))
+      ELSE
+        CALL XABORT('ACRLIB: NO MACROSCOPIC SET.')
+      ENDIF
+      DEALLOCATE(FLUXS)
+*
+      IF(NPRC.GT.0) THEN
+        DO IGR=1,NGRP
+          INVELS(IGR)=INVELS(IGR)+SPH(IGR)*WEIGHT*INVELSB(IGR)
+          DO IPRC=1,NPRC
+            CHIRS(IGR,IPRC)=CHIRS(IGR,IPRC)+WEIGHT*CHIRSB(IGR,IPRC)
+          ENDDO
+        ENDDO
+        DO IPRC=1,NPRC
+          BETAR(IPRC)=BETAR(IPRC)+WEIGHT*BETARB(IPRC)
+        ENDDO
+      ENDIF
+*----
+*  COMPUTE DEPLETION CHAIN DATA
+*----
+      IF(NISOF*NISOP.GT.0) THEN
+        IF(hdf5_group_exists(IPAPX,"/physconst/")) THEN
+          CALL hdf5_read_data(IPAPX,"/physconst/FYIELDS",YLDS2)
+        ELSE IF(hdf5_group_exists(IPAPX,"/physco001/")) THEN
+          CALL hdf5_read_data(IPAPX,"/physco001/FYIELDS",YLDS2)
+        ELSE
+          CALL XABORT('ACRLIB: GROUP physconst NOT FOUND IN HDF5 FILE.')
+        ENDIF
+        DO IY2=1,NISOP
+          DO IY1=1,NISOF
+            YLDSM(IY1,IY2)=YLDSM(IY1,IY2)+WEIGHT*YLDS2(IY1,IY2,1)
+            YLDS(IY1,IY2)=YLDS(IY1,IY2)+WEIGHT*YLDS2(IY1,IY2,1)*
+     >      VOLMI2(IBM)/VTOT
+          ENDDO
+        ENDDO
+        DEALLOCATE(YLDS2)
+      ENDIF
+      IF((MD1*MD2.GT.0).AND.(NBISO.GT.0)) THEN
+        IF(hdf5_group_exists(IPAPX,"/physconst/")) THEN
+          CALL hdf5_read_data(IPAPX,"/physconst/DECAYC",DECAY2)
+        ELSE IF(hdf5_group_exists(IPAPX,"/physco001/")) THEN
+          CALL hdf5_read_data(IPAPX,"/physco001/DECAYC",DECAY2)
+        ELSE
+          CALL XABORT('ACRLIB: GROUP physconst NOT FOUND IN HDF5 FILE.')
+        ENDIF
+        DO ISO=1,NBISO
+          DO ID1=1,NLAM
+            DECAYC(ID1,ISO)=DECAYC(ID1,ISO)+WEIGHT*DECAY2(ID1,ISO)*
+     >      VOLMI2(IBM)/VTOT
+          ENDDO
+        ENDDO
+        DEALLOCATE(DECAY2)
+      ENDIF
+   80 CONTINUE ! end of loop over elementary calculations.
+*----
+*  IDENTIFY SPECIAL FLUX EDITS
+*----
+      DO IREA=1,NREA
+        IF(NOMREA(IREA).EQ.'ABSO') THEN
+          DO 90 IED2=1,NED2
+          IF(HVECT2(IED2).EQ.'ABSO') GO TO 100
+   90     CONTINUE
+          NED2=NED2+1
+          IF(NED2.GT.MAXREA) CALL XABORT('ACRLIB: MAXREA OVERFLOW(1).')
+          HVECT2(NED2)='ABSO'
+        ELSE IF(NOMREA(IREA).EQ.'FISS') THEN
+          DO 95 IED2=1,NED2
+          IF(HVECT2(IED2).EQ.'NFTOT') GO TO 100
+   95     CONTINUE
+          NED2=NED2+1
+          IF(NED2.GT.MAXREA) CALL XABORT('ACRLIB: MAXREA OVERFLOW(2).')
+          HVECT2(NED2)='NFTOT'
+        ENDIF
+  100   CONTINUE
+      ENDDO
+*----
+*  SET FLAG LSTRD
+*----
+      LSTRD=.TRUE.
+      DO IREA=1,NREA
+        IF(NOMREA(IREA).EQ.'LEAK') THEN
+          IF(LXS(IREA).AND.(B2APEX.NE.0.0)) LSTRD=.FALSE.
+          EXIT
+        ENDIF
+      ENDDO
+*----
+*  SAVE CROSS SECTIONS IN MICROLIB FOR MIXTURE IBM
+*----
+      ISTY1(:NBISO1)=0
+      JJSO(:NBISO1)=0
+      NBISO2I=NBISO2
+      IF((NBISO.NE.0).AND.(.NOT.LTOTAL)) THEN
+        HRESID=' '
+        DO ISO=1,NBISO
+          READ(HNOMIS(ISO),'(2A4)') INAME(:2)
+          CALL SCRFND(MAXISO,NBISO2I,NBISO2,INAME,IBM,HRESID,HUSE2,
+     1    HNAM2,IMIX2,JJSO(ISO))
+          KPLIB=LCMDIL(JPLIB,JJSO(ISO)) ! step up isot JJSO(ISO)
+          CALL ACRISO(KPLIB,NREA,NGRP,NL,NPRC,NOMREA,NWT0,XS(1,1,ISO),
+     1    SIGS(1,1,ISO),SS2D(1,1,1,ISO),TAUXFI(ISO),LXS,LAMB,CHIRS,
+     2    BETAR,INVELS,INAME,LSTRD,LPURE,ILUPS,ITRANC,IFISS)
+          IF(MY1*MY2.GT.0) CALL ACRNDF(IMPX,NBISO+NBMAC,ISO,IBM,HNOMIS,
+     1    IPAPX,KPLIB,MY1,MY2,YLDSM,ISTY1(ISO))
+        ENDDO
+        IF(IRES.NE.0) THEN
+          HRESID=NOMMAC(IRES)
+          CALL SCRFND(MAXISO,NBISO2I,NBISO2,IHRES,IBM,HRESID,HUSE2,
+     1    HNAM2,IMIX2,JJSO(NBISO+IRES))
+          KPLIB=LCMDIL(JPLIB,JJSO(NBISO+IRES)) ! step up isot JJSO(NBISO+IRES)
+          CALL ACRISO(KPLIB,NREA,NGRP,NL,NPRC,NOMREA,NWT0,
+     1    XS(1,1,NBISO+1),SIGS(1,1,NBISO+1),SS2D(1,1,1,NBISO+1),
+     2    TAUXFI(NBISO+IRES),LXS,LAMB,CHIRS,BETAR,INVELS,IHRES,
+     3    LSTRD,LPURE,ILUPS,ITRANC,IFISS)
+          IF(MY1*MY2.GT.0) CALL ACRNDF(IMPX,NBISO+NBMAC,NBISO+IRES,
+     1    IBM,HNOMIS,IPAPX,KPLIB,MY1,MY2,YLDSM,ISTY1(NBISO+IRES))
+        ENDIF
+        DEALLOCATE(NOMMAC)
+      ELSE IF(IMAC.NE.0) THEN
+        HRESID=NOMMAC(IMAC)
+        CALL SCRFND(MAXISO,NBISO2I,NBISO2,IHRES,IBM,HRESID,HUSE2,HNAM2,
+     1  IMIX2,JJSO(NBISO+IMAC))
+        KPLIB=LCMDIL(JPLIB,JJSO(NBISO+IMAC)) ! step up isot JJSO(NBISO+IMAC)
+        CALL ACRISO(KPLIB,NREA,NGRP,NL,NPRC,NOMREA,NWT0,XS(1,1,NBISO+1),
+     1  SIGS(1,1,NBISO+1),SS2D(1,1,1,NBISO+1),TAUXFI(NBISO+IMAC),LXS,
+     2  LAMB,CHIRS,BETAR,INVELS,IHRES,LSTRD,LPURE,ILUPS,ITRANC,IFISS)
+        DEALLOCATE(NOMMAC)
+      ENDIF
+*----
+*  SET NUMBER DENSITIES AND VOLUMES IN OUTPUT MICROLIB
+*----
+      IF(LRES) THEN
+*       -- Number densities are left unchanged except if they are
+*       -- listed in HISO array.
+        DO 110 KSO=1,NISO(IBM) ! user-selected isotope
+          DO JSO=1,NBISO2 ! microlib isotope
+            IF(IMIX2(JSO).NE.IBM) CYCLE
+            WRITE(TEXT8,'(2A4)') HUSE2(1,JSO),HUSE2(2,JSO)
+            IF(HISO(IBM,KSO).EQ.TEXT8) THEN
+              ITOD2(JSO)=ITODO(IBM,KSO)
+              IF(CONC(IBM,KSO).EQ.-99.99) THEN
+*               -- Only number densities of isotopes set with "MICR" and
+*               -- "*" keywords are interpolated
+                DENS2(JSO)=0.0
+                DO ISO=1,NBISO1 ! Apex file isotope
+                  IF(JJSO(ISO).EQ.JSO) DENS2(JSO)=DENS2(JSO)+DENS3(ISO)
+                ENDDO
+              ELSE IF(CONC(IBM,KSO).NE.-99.99) THEN
+*               -- Number densities of isotopes set with "MICR" and
+*               -- fixed value are forced to this value
+                DENS2(JSO)=CONC(IBM,KSO)
+              ENDIF
+              GO TO 110
+            ENDIF
+          ENDDO
+          WRITE(HSMG,'(31HACRLIB: UNABLE TO FIND ISOTOPE ,A8,6H IN MI,
+     1    5HXTURE,I8,1H.)') HISO(IBM,KSO),IBM
+          CALL XABORT(HSMG)
+  110   CONTINUE
+      ELSE
+*       -- Number densities are interpolated or not according to
+*       -- ALL/ONLY option
+        DO JSO=1,NBISO2 ! microlib isotope
+          WRITE(TEXT8,'(2A4)') HUSE2(1,JSO),HUSE2(2,JSO)
+          IF(IBM.EQ.IMIX2(JSO)) THEN
+            DO ISO=1,NBISO1 ! Apex file isotope
+              IF(HNOMIS(ISO).EQ.TEXT8) THEN
+                DENS2(JSO)=0.0
+                VOL2(JSO)=0.0
+                CYCLE
+              ENDIF
+            ENDDO
+          ENDIF
+        ENDDO
+        DO 130 ISO=1,NBISO1 ! Apex file isotope
+        IF(.NOT.LISO(IBM)) THEN
+*         --ONLY option
+          DO KSO=1,NISO(IBM) ! user-selected isotope
+            IF(HNOMIS(ISO).EQ.HISO(IBM,KSO)) GO TO 120
+          ENDDO
+          GO TO 130
+        ENDIF
+  120   JSO=JJSO(ISO)
+        IF(JSO.GT.0) THEN
+          ITOD2(JSO)=ITOD1(ISO)
+          ISTY2(JSO)=ISTY1(ISO)
+          DENS2(JSO)=DENS2(JSO)+DENS3(ISO)
+          VOL2(JSO)=VOL2(JSO)+XVOLM(IBMOLD)
+        ENDIF
+  130   CONTINUE
+      ENDIF
+*----
+*  SET PIFI INFORMATION
+*----
+      ALLOCATE(IMICR(NBISO1))
+      IMICR(:NBISO1)=0
+      NBS1=0
+      DO 140 JSO=1,NBISO2 ! microlib isotope
+      IF(IMIX2(JSO).EQ.IBM) THEN
+        NBS1=NBS1+1
+        IF(NBS1.GT.NBISO1) CALL XABORT('ACRLIB: NBISO1 OVERFLOW.')
+        IMICR(NBS1)=JSO
+      ENDIF
+  140 CONTINUE
+      DO 170 ISO=1,NBS1 ! Apex file isotope
+      JSO=IMICR(ISO)
+      KPLIB=LCMDIL(JPLIB,JSO) ! step up isot JSO
+      CALL LCMLEN(KPLIB,'PYIELD',LMY1,ITYLCM)
+      IF(LMY1.GT.0) THEN
+        ALLOCATE(HPYNAM(LMY1),IPYMIX(LMY1),IPIFI(LMY1))
+        IPIFI(:LMY1)=0
+        CALL LCMGTC(KPLIB,'PYNAM',8,LMY1,HPYNAM)
+        CALL LCMGET(KPLIB,'PYMIX',IPYMIX)
+        DO 160 IY1=1,LMY1
+        IF(HPYNAM(IY1).NE.' ') THEN
+          DO 150 KSO=1,NBS1
+          LSO=IMICR(KSO)
+          WRITE(TEXT8,'(2A4)') HUSE2(:2,LSO)
+          IF((HPYNAM(IY1).EQ.TEXT8).AND.(IPYMIX(IY1).EQ.IMIX2(LSO)))
+     1    THEN
+            IPIFI(IY1)=LSO
+            GO TO 160
+          ENDIF
+  150     CONTINUE
+          IF(IPIFI(IY1).EQ.0) THEN
+            WRITE(HSMG,'(40HACRLIB: FAILURE TO FIND FISSILE ISOTOPE ,
+     1      A12,25H AMONG MICROLIB ISOTOPES.)') HPYNAM(IY1)
+            CALL XABORT(HSMG)
+          ENDIF
+        ENDIF
+  160   CONTINUE
+        CALL LCMPUT(KPLIB,'PIFI',LMY1,1,IPIFI)
+        DEALLOCATE(IPIFI,IPYMIX,HPYNAM)
+      ENDIF
+  170 CONTINUE
+      DEALLOCATE(IMICR)
+  180 CONTINUE ! end of loop over microlib mixtures.
+*----
+*  RELEASE MEMORY
+*----
+      DEALLOCATE(FACT,DENS1)
+      IF(NPRC.GT.0) DEALLOCATE(INVELSB,BETARB,CHIRSB,INVELS,BETAR,
+     1 CHIRS,LAMB)
+      DEALLOCATE(LXS,XS,SS2D,SIGS,NWT0,TAUXFI)
+      DEALLOCATE(ITOD1,YLDSM)
+      IF(NBISO.GT.0) DEALLOCATE(NOMISO)
+      DEALLOCATE(JJSO,DENS0,XVOLM,HNOMIS,IRESM,ITOTM)
+*----
+*  MICROLIB FINALIZATION
+*----
+      IF(.NOT.LRES) THEN
+        ISTATE(:NSTATE)=0
+        ISTATE(1)=NMIX
+        ISTATE(2)=NBISO2
+        ISTATE(3)=NGRP
+        ISTATE(4)=NL
+        ISTATE(5)=ITRANC
+        ISTATE(7)=1
+        IF(ITER.EQ.3) ISTATE(12)=NMIX
+        ISTATE(13)=NED2
+        ISTATE(14)=NMIX
+        ISTATE(18)=1
+        ISTATE(19)=NPRC
+        ISTATE(20)=MY1
+        ISTATE(22)=MAXISO/NMIX
+        IF(NSURFD.GT.0) ISTATE(24)=3 ! ADF/CPDF information
+        IF(NBISO2.EQ.0) CALL XABORT('ACRLIB: NBISO2=0.')
+        CALL LCMPUT(IPLIB,'STATE-VECTOR',NSTATE,1,ISTATE)
+        CALL LCMPUT(IPLIB,'MIXTURESVOL',NMIX,2,VOLMI2)
+        CALL LCMPUT(IPLIB,'ISOTOPESUSED',3*NBISO2,3,HUSE2)
+        CALL LCMPUT(IPLIB,'ISOTOPERNAME',3*NBISO2,3,HNAM2)
+        CALL LCMPUT(IPLIB,'ISOTOPESDENS',NBISO2,2,DENS2)
+        CALL LCMPUT(IPLIB,'ISOTOPESMIX',NBISO2,1,IMIX2)
+        CALL LCMPUT(IPLIB,'ISOTOPESVOL',NBISO2,2,VOL2)
+        IF(NED2.GT.0) CALL LCMPTC(IPLIB,'ADDXSNAME-P0',8,NED2,HVECT2)
+        CALL LCMPUT(IPLIB,'ISOTOPESTODO',NBISO2,1,ITOD2)
+        CALL LCMPUT(IPLIB,'ISOTOPESTYPE',NBISO2,1,ISTY2)
+      ELSE IF(LRES.AND.(NBISO.GT.0)) THEN
+        CALL LCMPUT(IPLIB,'ISOTOPESDENS',NBISO2,2,DENS2)
+        CALL LCMPUT(IPLIB,'ISOTOPESVOL',NBISO2,2,VOL2)
+      ENDIF
+      IF(IMPX.GT.5) CALL LCMLIB(IPLIB)
+      IACCS=1
+*----
+*  COMPUTE THE MACROSCOPIC X-SECTIONS
+*----
+      IF((ITER.NE.0).AND.(ITER.NE.3)) GO TO 280
+      CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+      MAXMIX=ISTATE(1)
+      IF(MAXMIX.NE.NMIX) CALL XABORT('ACRLIB: INVALID NMIX.')
+      NBISO=ISTATE(2)
+      ALLOCATE(MASK(MAXMIX),MASKL(NGRP))
+      ALLOCATE(ISONA(3*NBISO),ISOMI(NBISO),DENIS(NBISO))
+      CALL LCMGET(IPLIB,'ISOTOPESUSED',ISONA)
+      CALL LCMGET(IPLIB,'ISOTOPESMIX',ISOMI)
+      CALL LCMGET(IPLIB,'ISOTOPESDENS',DENIS)
+      MASK(:MAXMIX)=.TRUE.
+      MASKL(:NGRP)=.TRUE.
+      ITSTMP=0
+      TMPDAY(1)=0.0
+      TMPDAY(2)=0.0
+      TMPDAY(3)=0.0
+      CALL LCMLEN(IPLIB,'MACROLIB',ILONG,ITYLCM)
+      IF(ILONG.NE.0) CALL LCMDEL(IPLIB,'MACROLIB')
+      CALL LIBMIX(IPLIB,MAXMIX,NGRP,NBISO,ISONA,ISOMI,DENIS,MASK,MASKL,
+     1 ITSTMP,TMPDAY)
+      DEALLOCATE(MASKL,MASK)
+      DEALLOCATE(DENIS,ISOMI,ISONA)
+      IF(NSURFD.GT.0) THEN
+        CALL LCMSIX(IPLIB,'MACROLIB',1)
+        CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+        ISTATE(12)=3 ! ADF information
+        CALL LCMPUT(IPLIB,'STATE-VECTOR',NSTATE,1,ISTATE)
+        CALL LCMSIX(IPLIB,' ',2)
+      ENDIF
+*----
+*  INCLUDE LEAKAGE IN THE MACROLIB (USED ONLY FOR NON-REGRESSION TESTS)
+*----
+      IF(B2.NE.0.0) THEN
+        IF(IMPX.GT.0) WRITE(IOUT,'(/31H ACRLIB: INCLUDE LEAKAGE IN THE,
+     1  14H MACROLIB (B2=,1P,E12.5,2H).)') B2
+        CALL LCMSIX(IPLIB,'MACROLIB',1)
+        JPLIB=LCMGID(IPLIB,'GROUP')
+        ALLOCATE(GAR1(NMIX),GAR2(NMIX))
+        DO 270 IGR=1,NGRP
+          KPLIB=LCMGIL(JPLIB,IGR)
+          CALL LCMGET(KPLIB,'NTOT0',GAR1)
+          CALL LCMGET(KPLIB,'DIFF',GAR2)
+          DO 260 IBM=1,NMIX
+            IF(MIXC(IBM).NE.0) GAR1(IBM)=GAR1(IBM)+B2*GAR2(IBM)
+  260     CONTINUE
+          CALL LCMPUT(KPLIB,'NTOT0',NMIX,2,GAR1)
+  270   CONTINUE
+        DEALLOCATE(GAR2,GAR1)
+        CALL LCMSIX(IPLIB,' ',2)
+      ENDIF
+*----
+*  PROCESS ADF INFORMATION
+*----
+  280 IF(NSURFD.GT.0) THEN
+        DO 285 IBM=1,NMIX ! mixtures in Macrolib
+          IF(MIXC(IBM).NE.0) ADF2(IBM,:NGRP,:NSURFD)=0.0
+  285   CONTINUE
+        DO 300 ICAL=1,NCAL
+        DO 290 IBM=1,NMIX ! mixtures in Macrolib
+        IBMOLD=MIXC(IBM)
+        IF(IBMOLD.EQ.0) GO TO 290
+        WEIGHT=TERP(ICAL,IBM)
+        IF(WEIGHT.EQ.0.0) GO TO 290
+        WRITE(RECNAM,'(4Hcalc,I8,15H/miscellaneous/)') ICAL
+        K=0
+        CALL hdf5_info(IPAPX,TRIM(RECNAM)//"ADF",RANK,TYPE,NBYTE,DIMSR)
+        IF(TYPE.NE.99) THEN
+          HHAD(K+1)='ADF'
+          K=K+1
+        ENDIF
+        CALL hdf5_info(IPAPX,TRIM(RECNAM)//"CPDF",RANK,TYPE,NBYTE,DIMSR)
+        IF(TYPE.NE.99) THEN
+          HHAD(K+1)='CPDF'
+          K=K+1
+        ENDIF
+        CALL hdf5_info(IPAPX,TRIM(RECNAM)//"INTERNAL_ADF",RANK,TYPE,
+     1  NBYTE,DIMSR)
+        IF(TYPE.NE.99) THEN
+          HHAD(K+1)='INTERNAL_ADF'
+          K=K+1
+        ENDIF
+        CALL hdf5_info(IPAPX,TRIM(RECNAM)//"INTERNAL_CPDF",RANK,TYPE,
+     1  NBYTE,DIMSR)
+        IF(TYPE.NE.99) THEN
+          HHAD(K+1)='INTERNAL_CPDF'
+          K=K+1
+        ENDIF
+        IF(4*K.NE.NSURFD) CALL XABORT('ACRLIB: INVALID ADF COUNT.')
+        DO I=1,K
+          CALL hdf5_get_shape(IPAPX,TRIM(RECNAM)//HHAD(I),DIMS_APX)
+          ISURF=DIMS_APX(1)
+          DEALLOCATE(DIMS_APX)
+          CALL hdf5_read_data(IPAPX,TRIM(RECNAM)//HHAD(I),ADF)
+          DO I0=1,ISURF
+            IF(HHAD(I).EQ.'ADF') THEN
+              WRITE(TEXT8,'(3HADF,I1)') I0
+            ELSE IF(HHAD(I).EQ.'CPDF') THEN
+              WRITE(TEXT8,'(4HCPDF,I1)') I0
+            ELSE IF(HHAD(I).EQ.'INTERNAL_ADF') THEN
+              WRITE(TEXT8,'(6HIN_ADF,I1)') I0
+            ELSE IF(HHAD(I).EQ.'INTERNAL_CPDF') THEN
+              WRITE(TEXT8,'(7HIN_CPDF,I1)') I0
+            ENDIF
+            IOF=(I-1)*ISURF+I0
+            HADF(IOF)=TEXT8
+            DO IGR=1,NGRP
+              ADF2(IBM,IGR,IOF)=ADF2(IBM,IGR,IOF)+WEIGHT*ADF(I0,IGR)
+            ENDDO
+          ENDDO
+          DEALLOCATE(ADF)
+        ENDDO
+  290   CONTINUE
+  300   CONTINUE
+        CALL LCMSIX(IPLIB,'MACROLIB',1)
+        CALL LCMSIX(IPLIB,'ADF',1)
+        CALL LCMPUT(IPLIB,'NTYPE',1,1,NSURFD)
+        CALL LCMPTC(IPLIB,'HADF',8,NSURFD,HADF)
+        DO I=1,NSURFD
+          CALL LCMPUT(IPLIB,HADF(I),NMIX*NGRP,2,ADF2(1,1,I))
+        ENDDO
+        CALL LCMSIX(IPLIB,' ',2)
+        CALL LCMSIX(IPLIB,' ',2)
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(ADF2,HADF)
+      DEALLOCATE(SPH,FLUX,VOLMI2,VOL2,DENS3,DENS2)
+      DEALLOCATE(HNAM2,HUSE2,ISTY2,ISTY1,ITOD2,IMIX2)
+      RETURN
+      END
diff --git a/Donjon/src/ACRMAC.f b/Donjon/src/ACRMAC.f
new file mode 100644
index 0000000..37f5444
--- /dev/null
+++ b/Donjon/src/ACRMAC.f
@@ -0,0 +1,521 @@
+*DECK ACRMAC
+      SUBROUTINE ACRMAC(IPMAC,IPAPX,IACCS,NMIL,NMIX,NGRP,IMPX,HEQUI,
+     1 NCAL,NSURFD,ILUPS,MIXC,TERP,LPURE,B2,LFROM)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Build the Macrolib by scanning the NCAL elementary calculations of
+* a HDF5 file and weighting them with TERP factors.
+*
+*Copyright:
+* Copyright (C) 2021 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPMAC   address of the output Macrolib LCM object.
+* IPAPX   pointer to the Apex file.
+* IACCS   =0 macrolib is created; =1 ... is updated.
+* NMIL    number of material mixtures in the Apex file.
+* NMIX    maximum number of material mixtures in the Macrolib.
+* NGRP    number of energy groups.
+* IMPX    print parameter (equal to zero for no print).
+* HEQUI   keyword of SPH-factor set to be recovered.
+* NCAL    number of elementary calculations in the Apex file.
+* NSURFD  number of discontinuity factors.
+* ILUPS   up-scattering removing flag (=1 to remove up-scattering from
+*         output cross-sections).
+* MIXC    mixture index in the Apex file corresponding to each Microlib
+*         mixture. Equal to zero if a Microlib mixture is not updated.
+* TERP    interpolation factors.
+* LPURE   =.true. if the interpolation is a pure linear interpolation 
+*         with TERP factors.
+* B2      buckling
+* LFROM   macroregion flag (=.true. if 'xs       n' groups are set).
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAC,IPAPX
+      INTEGER IACCS,NMIL,NMIX,NGRP,IMPX,NCAL,NSURFD,ILUPS,MIXC(NMIX)
+      REAL TERP(NCAL,NMIX),B2
+      LOGICAL LPURE,LFROM
+      CHARACTER(LEN=80) HEQUI
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAX1D=40
+      INTEGER, PARAMETER::MAX2D=20
+      INTEGER, PARAMETER::MAXED=30
+      INTEGER, PARAMETER::MAXNFI=1
+      INTEGER, PARAMETER::MAXNL=6
+      INTEGER, PARAMETER::NSTATE=40
+      INTEGER, PARAMETER::MAXRES=MAX1D-8
+      REAL FLOTVA, WEIGHT, FKEFF, B2R
+      INTEGER I, I1D, I2D, IBM, IBMOLD, ICAL, IDEL, IDF, IED, IGMAX,
+     & IGMIN, IGR, JGR, IKEFF, IL, ILONG, IOF, IPOSDE, ITRANC, ITYLCM,
+     & ITYPE, LENGTH, N1D, N2D, NDEL, NED, NEDTMP, NF, NFTMP, NL, NLTMP,
+     & NTYPE, IMC, NALBP
+      TYPE(C_PTR) JPMAC,KPMAC,IPTMP,JPTMP,KPTMP
+      INTEGER ISTATE(NSTATE)
+      LOGICAL LMAKE1(MAX1D),LMAKE2(MAX2D),LWD
+      CHARACTER TEXT8*8,TEXT12*12,CM*2,HMAK1(MAX1D)*12,HMAK2(MAX2D)*12,
+     1 HVECT(MAXED)*8
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IJJ,NJJ,IPOS,IJJB,NJJB,IPOSB
+      REAL, ALLOCATABLE, DIMENSION(:) :: GAR4,GAR4B,WORK1,WORK2,XVOLM,
+     1 ENERG,VOSAP,WDLA
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: SPH
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: GAR1,ADF2
+      REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: GAR2,GAR3
+      CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: HADF
+      REAL, POINTER, DIMENSION(:) :: FLOT
+      TYPE(C_PTR) FLOT_PTR
+*----
+*  DATA STATEMENTS
+*----
+      DATA HMAK1 / 'FLUX-INTG','NTOT0','OVERV','DIFF','FLUX-INTG-P1',
+     1 'NTOT1','H-FACTOR','TRANC',MAXRES*' '/
+*----
+*  ACRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(IJJ(NMIX),NJJ(NMIX),IPOS(NMIX),IJJB(NMIL),NJJB(NMIL),
+     1 IPOSB(NMIL))
+      ALLOCATE(GAR1(NMIX,NGRP,MAX1D),GAR2(NMIX,MAXNFI,NGRP,MAX2D),
+     1 GAR3(NMIX,NGRP,NGRP,MAXNL),GAR4(NMIX*NGRP),GAR4B(NMIL*NGRP),
+     2 ADF2(NMIX,NGRP,NSURFD))
+      ALLOCATE(HADF(NSURFD))
+*----
+*  MACROLIB INITIALIZATION
+*----
+      LMAKE1(:MAX1D)=.FALSE.
+      LMAKE2(:MAX2D)=.FALSE.
+      GAR1(:NMIX,:NGRP,:MAX1D)=0.0
+      GAR2(:NMIX,:MAXNFI,:NGRP,:MAX2D)=0.0
+      GAR3(:NMIX,:NGRP,:NGRP,:MAXNL)=0.0
+      IF(NSURFD.GT.0) ADF2(:NMIX,:NGRP,:NSURFD)=0.0
+      ALLOCATE(XVOLM(NMIX),ENERG(NGRP+1))
+      XVOLM(:NMIX)=0.0
+      ENERG(:NGRP+1)=0.0
+      IBMOLD=0
+      N1D=0
+      N2D=0
+      NDEL=0
+      NL=0
+      NF=0
+      NED=0
+      ITRANC=0
+      IDF=0
+      N1D=0
+      N2D=0
+*----
+*  READ EXISTING MACROLIB INFORMATION
+*----
+      IF(IACCS.EQ.0) THEN
+        TEXT12='L_MACROLIB'
+        CALL LCMPTC(IPMAC,'SIGNATURE',12,TEXT12)
+      ELSE
+        CALL LCMGTC(IPMAC,'SIGNATURE',12,TEXT12)
+        IF(TEXT12.NE.'L_MACROLIB') THEN
+          CALL XABORT('ACRMAC: SIGNATURE OF INPUT MACROLIB IS '//TEXT12
+     1    //'. L_MACROLIB EXPECTED.')
+        ENDIF
+        CALL LCMGET(IPMAC,'STATE-VECTOR',ISTATE)
+        IF(ISTATE(1).NE.NGRP) THEN
+          CALL XABORT('ACRMAC: INVALID NUMBER OF ENERGY GROUPS(1).')
+        ELSE IF(ISTATE(2).NE.NMIX) THEN
+          CALL XABORT('ACRMAC: INVALID NUMBER OF MIXTURES(1).')
+        ENDIF
+        NL=ISTATE(3)
+        NF=ISTATE(4)
+        IF(NF.GT.MAXNFI) CALL XABORT('ACRMAC: MAXNFI OVERFLOW(1).')
+        NED=ISTATE(5)
+        ITRANC=ISTATE(6)
+        NDEL=ISTATE(7)
+        IDF=ISTATE(12)
+        IF(NED.GT.MAXED) CALL XABORT('ACRMAC: MAXED OVERFLOW(1).')
+        CALL LCMGTC(IPMAC,'ADDXSNAME-P0',8,NED,HVECT)
+        N1D=8+NED+NL
+        N2D=2*(NDEL+1)
+        IF(NL.GT.MAXNL) CALL XABORT('ACRMAC: MAXNL OVERFLOW(1).')
+        IF(N1D.GT.MAX1D) CALL XABORT('ACRMAC: MAX1D OVERFLOW(1).')
+        IF(N2D.GT.MAX2D) CALL XABORT('ACRMAC: MAX2D OVERFLOW(1).')
+        DO 20 IED=1,NED
+        HMAK1(8+IED)=HVECT(IED)
+   20   CONTINUE
+        DO 30 IL=1,NL
+        WRITE(CM,'(I2.2)') IL-1
+        HMAK1(8+NED+IL)='SIGS'//CM
+   30   CONTINUE
+        HMAK2(1)='NUSIGF'
+        HMAK2(2)='CHI'
+        DO 40 IDEL=1,NDEL
+        WRITE(TEXT8,'(6HNUSIGF,I2.2)') IDEL
+        HMAK2(2+2*(IDEL-1)+1)=TEXT8
+        WRITE(TEXT8,'(3HCHI,I2.2)') IDEL
+        HMAK2(2+2*(IDEL-1)+2)=TEXT8
+   40   CONTINUE
+        CALL LCMGET(IPMAC,'STATE-VECTOR',ISTATE)
+        CALL LCMGET(IPMAC,'VOLUME',XVOLM)
+        JPMAC=LCMGID(IPMAC,'GROUP')
+        DO 105 IGR=1,NGRP
+        KPMAC=LCMGIL(JPMAC,IGR)
+        DO 60 I1D=1,N1D
+        CALL LCMLEN(KPMAC,HMAK1(I1D),ILONG,ITYLCM)
+        IF(ILONG.NE.0) THEN
+          LMAKE1(I1D)=.TRUE.
+          CALL LCMGET(KPMAC,HMAK1(I1D),GAR1(1,IGR,I1D))
+          DO 55 IBM=1,NMIX
+          DO 50 IBMOLD=1,NMIL
+          IF(MIXC(IBM).EQ.IBMOLD) GAR1(IBM,IGR,I1D)=0.0
+   50     CONTINUE
+   55     CONTINUE
+        ENDIF
+   60   CONTINUE
+        DO 80 I2D=1,N2D
+        CALL LCMLEN(KPMAC,HMAK2(I2D),ILONG,ITYLCM)
+        IF(ILONG.NE.0) THEN
+          LMAKE2(I2D)=.TRUE.
+          CALL LCMGET(KPMAC,HMAK2(I2D),GAR2(1,1,IGR,I2D))
+          DO 72 I=1,NF
+          DO 71 IBM=1,NMIX
+          DO 70 IBMOLD=1,NMIL
+          IF(MIXC(IBM).EQ.IBMOLD) GAR2(IBM,I,IGR,I2D)=0.0
+   70     CONTINUE
+   71     CONTINUE
+   72     CONTINUE
+        ENDIF
+   80   CONTINUE
+        DO 100 IL=1,NL
+        WRITE(CM,'(I2.2)') IL-1
+        ILONG=1
+        IF(IL.GT.1) CALL LCMLEN(KPMAC,'SCAT'//CM,ILONG,ITYLCM)
+        IF(ILONG.NE.0) THEN
+          CALL LCMGET(KPMAC,'SCAT'//CM,GAR4)
+          CALL LCMGET(KPMAC,'NJJS'//CM,NJJ)
+          CALL LCMGET(KPMAC,'IJJS'//CM,IJJ)
+          CALL LCMGET(KPMAC,'IPOS'//CM,IPOS)
+          DO 95 IBM=1,NMIX
+          IPOSDE=IPOS(IBM)
+          DO 90 JGR=IJJ(IBM),IJJ(IBM)-NJJ(IBM)+1,-1
+          GAR3(IBM,JGR,IGR,IL)=GAR4(IPOSDE)
+          DO 85 IBMOLD=1,NMIL
+          IF(MIXC(IBM).EQ.IBMOLD) GAR3(IBM,JGR,IGR,IL)=0.0
+   85     CONTINUE
+          IPOSDE=IPOSDE+1
+   90     CONTINUE
+   95     CONTINUE
+        ENDIF
+  100   CONTINUE
+  105   CONTINUE
+        IF(IDF.EQ.3) THEN
+          CALL LCMSIX(IPMAC,'ADF',1)
+          CALL LCMGTC(IPMAC,'HADF',8,NSURFD,HADF)
+          DO ITYPE=1,NSURFD
+            CALL LCMGET(IPMAC,HADF(ITYPE),ADF2(1,1,ITYPE))
+          ENDDO
+          CALL LCMSIX(IPMAC,' ',2)
+        ENDIF
+      ENDIF
+*----
+*  OVERALL ELEMENTARY CALCULATION LOOP
+*----
+      DO 210 ICAL=1,NCAL
+      DO 110 IBM=1,NMIX ! mixtures in Macrolib
+      WEIGHT=TERP(ICAL,IBM)
+      IF(WEIGHT.NE.0.0) GO TO 120
+  110 CONTINUE
+      GO TO 210
+*----
+*  PRODUCE AN ELEMENTARY MACROLIB
+*----
+  120 CALL LCMOP(IPTMP,'*ELEMENTARY*',0,1,0)
+      ALLOCATE(SPH(NMIL,NGRP))
+      B2R=B2
+      CALL SPHAPX(IPAPX,IPTMP,ICAL,IMPX,HEQUI,NMIL,NGRP,LFROM,ILUPS,
+     1 SPH,B2R)
+*----
+*  RECOVER MACROLIB PARAMETERS
+*----
+      CALL LCMGET(IPTMP,'STATE-VECTOR',ISTATE)
+      NLTMP=ISTATE(3)
+      NFTMP=ISTATE(4)
+      NEDTMP=ISTATE(5)
+      IF(NLTMP.GT.MAXNL) CALL XABORT('ACRMAC: MAXNL OVERFLOW(2).')
+      IF(NFTMP.GT.MAXNFI) CALL XABORT('ACRMAC: MAXNFI OVERFLOW(2).')
+      IF(NEDTMP.GT.MAXED) CALL XABORT('ACRMAC: MAXED OVERFLOW(2).')
+      IF(IACCS.EQ.0) THEN
+        IF(ISTATE(1).NE.NGRP) THEN
+          CALL XABORT('ACRMAC: INVALID NUMBER OF ENERGY GROUPS(2).')
+        ELSE IF(ISTATE(2).NE.NMIL) THEN
+          CALL XABORT('ACRMAC: INVALID NUMBER OF MIXTURES(2).')
+        ENDIF
+        NL=NLTMP
+        NF=NFTMP
+        NED=NEDTMP
+        ITRANC=ISTATE(6)
+        NDEL=ISTATE(7)
+        IDF=ISTATE(12)
+        CALL LCMGTC(IPTMP,'ADDXSNAME-P0',8,NED,HVECT)
+        N1D=8+NED+NL
+        N2D=2*(NDEL+1)
+        IF(N1D.GT.MAX1D) CALL XABORT('ACRMAC: MAX1D OVERFLOW(2).')
+        IF(N2D.GT.MAX2D) CALL XABORT('ACRMAC: MAX2D OVERFLOW(2).')
+        DO 130 IED=1,NED
+        HMAK1(8+IED)=HVECT(IED)
+  130   CONTINUE
+        DO 140 IL=1,NL
+        WRITE(CM,'(I2.2)') IL-1
+        HMAK1(8+NED+IL)='SIGS'//CM
+  140   CONTINUE
+        HMAK2(1)='NUSIGF'
+        HMAK2(2)='CHI'
+        DO 150 IDEL=1,NDEL
+        WRITE(TEXT8,'(6HNUSIGF,I2.2)') IDEL
+        HMAK2(2+2*(IDEL-1)+1)=TEXT8
+        WRITE(TEXT8,'(3HCHI,I2.2)') IDEL
+        HMAK2(2+2*(IDEL-1)+2)=TEXT8
+  150   CONTINUE
+        NLTMP=NL
+        NFTMP=NF
+      ELSE
+        NL=MAX(NL,NLTMP)
+        IF(NLTMP.GT.NL) CALL XABORT('ACRMAC: NL OVERFLOW.')
+        ITRANC=MAX(ITRANC,ISTATE(6))
+        IF(ISTATE(1).NE.NGRP) THEN
+          CALL XABORT('ACRMAC: INVALID NUMBER OF ENERGY GROUPS(3).')
+        ELSE IF(ISTATE(2).NE.NMIL)THEN
+          CALL XABORT('ACRMAC: INVALID NUMBER OF MIXTURES(3).')
+        ELSE IF(ISTATE(5).NE.NED) THEN
+          CALL XABORT('ACRMAC: INVALID NUMBER OF EDIT REACTIONS(3).')
+        ELSE IF((NFTMP.NE.0).AND.(NFTMP.NE.NF)) THEN
+          CALL XABORT('ACRMAC: INVALID NUMBER OF FISSILE ISOTOPES(3).')
+        ELSE IF(ISTATE(7).NE.NDEL) THEN
+          CALL XABORT('ACRMAC: INVALID NUMBER OF PRECURSOR GROUPS(3).')
+        ELSE IF(ISTATE(12).NE.IDF) THEN
+          CALL XABORT('ACRMAC: INVALID TYPE OF ADF DIRECTORY.')
+        ENDIF
+      ENDIF
+*----
+*  SPH CORRECTION OF MACROLIB INFORMATION
+*----
+      IMC=1 ! SPH correction for SPN macro-calculation
+      NALBP=0 ! no albedo correction
+      CALL SPHCMA(IPTMP,IMPX,IMC,NMIL,NGRP,NFTMP,NEDTMP,NALBP,SPH)
+      DEALLOCATE(SPH)
+*----
+*  RECOVER KEFF, VOLUMES, ENERGY GROUPS, EDIT NAMES, AND LAMBDA-D.
+*----
+      CALL LCMLEN(IPTMP,'K-EFFECTIVE',IKEFF,ITYLCM)
+      IF(IKEFF.EQ.1) CALL LCMGET(IPTMP,'K-EFFECTIVE',FKEFF)
+      CALL LCMLEN(IPTMP,'VOLUME',ILONG,ITYLCM)
+      IF(ILONG.EQ.NMIL) THEN
+        ALLOCATE(VOSAP(NMIL))
+        CALL LCMGET(IPTMP,'VOLUME',VOSAP)
+        DO 160 IBM=1,NMIX ! mixtures in Macrolib
+        IBMOLD=MIXC(IBM) ! mixture in Apex file
+        IF(IBMOLD.NE.0) XVOLM(IBM)=VOSAP(IBMOLD)
+  160   CONTINUE
+        DEALLOCATE(VOSAP)
+      ENDIF
+      CALL LCMLEN(IPTMP,'ENERGY',ILONG,ITYLCM)
+      IF(ILONG.EQ.NGRP+1) CALL LCMGET(IPTMP,'ENERGY',ENERG)
+      CALL LCMLEN(IPTMP,'LAMBDA-D',LENGTH,ITYLCM)
+      LWD=(LENGTH.EQ.NDEL).AND.(NDEL.GT.0)
+      IF(LWD) THEN
+        ALLOCATE(WDLA(NDEL))
+        CALL LCMGET(IPTMP,'LAMBDA-D',WDLA)
+        CALL LCMPUT(IPMAC,'LAMBDA-D',NDEL,2,WDLA)
+        DEALLOCATE(WDLA)
+      ENDIF
+*----
+*  PERFORM INTERPOLATION
+*----
+      JPTMP=LCMGID(IPTMP,'GROUP')
+      DO 200 IBM=1,NMIX ! mixtures in Macrolib
+      WEIGHT=TERP(ICAL,IBM)
+      IF(WEIGHT.EQ.0.0) GO TO 200
+      IBMOLD=MIXC(IBM) ! mixture in Apex file
+      IF(IBMOLD.EQ.0) GO TO 200
+*
+      DO 195 IGR=1,NGRP
+      KPTMP=LCMGIL(JPTMP,IGR)
+      DO 170 I1D=1,N1D
+      CALL LCMLEN(KPTMP,HMAK1(I1D),ILONG,ITYLCM)
+      IF(ILONG.NE.0) THEN
+        LMAKE1(I1D)=.TRUE.
+        CALL LCMGPD(KPTMP,HMAK1(I1D),FLOT_PTR)
+        CALL C_F_POINTER(FLOT_PTR,FLOT,(/ ILONG /))
+        FLOTVA=FLOT(IBMOLD)
+        IF((.NOT.LPURE).AND.(I1D.EQ.4)) FLOTVA=1.0/FLOTVA
+        GAR1(IBM,IGR,I1D)=GAR1(IBM,IGR,I1D)+WEIGHT*FLOTVA
+      ENDIF
+  170 CONTINUE
+      IF(ISTATE(4).GT.0) THEN
+        DO 175 I2D=1,N2D
+        CALL LCMLEN(KPTMP,HMAK2(I2D),ILONG,ITYLCM)
+        IF(ILONG.NE.0) THEN
+          LMAKE2(I2D)=.TRUE.
+          CALL LCMGPD(KPTMP,HMAK2(I2D),FLOT_PTR)
+          CALL C_F_POINTER(FLOT_PTR,FLOT,(/ ILONG /))
+          DO 174 I=1,NF
+          IOF=(IBMOLD-1)*NF+I
+          GAR2(IBM,I,IGR,I2D)=GAR2(IBM,I,IGR,I2D)+WEIGHT*FLOT(IOF)
+  174     CONTINUE
+        ENDIF
+  175   CONTINUE
+      ENDIF
+      DO 190 IL=1,NLTMP
+      WRITE(CM,'(I2.2)') IL-1
+      CALL LCMLEN(KPTMP,'SCAT'//CM,ILONG,ITYLCM)
+      IF(ILONG.NE.0) THEN
+        CALL LCMGET(KPTMP,'SCAT'//CM,GAR4B)
+        CALL LCMGET(KPTMP,'NJJS'//CM,NJJB)
+        CALL LCMGET(KPTMP,'IJJS'//CM,IJJB)
+        CALL LCMGET(KPTMP,'IPOS'//CM,IPOSB)
+        IPOSDE=IPOSB(IBMOLD)
+        DO 180 JGR=IJJB(IBMOLD),IJJB(IBMOLD)-NJJB(IBMOLD)+1,-1
+        GAR3(IBM,JGR,IGR,IL)=GAR3(IBM,JGR,IGR,IL)+WEIGHT*GAR4B(IPOSDE)
+        IPOSDE=IPOSDE+1
+  180   CONTINUE
+      ENDIF
+  190 CONTINUE
+  195 CONTINUE
+*----
+*  PROCESS ADF INFORMATION
+*----
+      IF(IDF.EQ.3) THEN
+        CALL LCMSIX(IPTMP,'ADF',1)
+        CALL LCMGET(IPTMP,'NTYPE',NTYPE)
+        IF(NTYPE.NE.NSURFD) CALL XABORT('ACRMAC: INVALID NTYPE VALUE.')
+        CALL LCMGTC(IPTMP,'HADF',8,NSURFD,HADF)
+        DO ITYPE=1,NSURFD
+          CALL LCMGET(IPTMP,HADF(ITYPE),GAR4)
+          DO IGR=1,NGRP
+            ADF2(IBM,IGR,ITYPE)=ADF2(IBM,IGR,ITYPE)+WEIGHT*GAR4(IGR)
+          ENDDO
+        ENDDO
+        CALL LCMSIX(IPTMP,' ',2)
+      ENDIF
+  200 CONTINUE
+      CALL LCMCL(IPTMP,2)
+  210 CONTINUE
+*----
+*  WRITE INTERPOLATED MACROLIB INFORMATION
+*----
+      IF(IKEFF.EQ.1) CALL LCMPUT(IPMAC,'K-EFFECTIVE',1,2,FKEFF)
+      CALL LCMPUT(IPMAC,'VOLUME',NMIX,2,XVOLM)
+      CALL LCMPUT(IPMAC,'ENERGY',NGRP+1,2,ENERG)
+      DEALLOCATE(ENERG,XVOLM)
+      IF(NED.GT.0) CALL LCMPTC(IPMAC,'ADDXSNAME-P0',8,NED,HVECT)
+      JPMAC=LCMLID(IPMAC,'GROUP',NGRP)
+      DO 365 IGR=1,NGRP
+      KPMAC=LCMDIL(JPMAC,IGR)
+      DO 320 I1D=1,N1D
+      IF(LMAKE1(I1D)) THEN
+        IF((.NOT.LPURE).AND.(I1D.EQ.4)) THEN
+          DO 311 IBM=1,NMIX
+          DO 310 IBMOLD=1,NMIL
+          IF(MIXC(IBM).EQ.IBMOLD) GAR1(IBM,IGR,I1D)=1./GAR1(IBM,IGR,I1D)
+  310     CONTINUE
+  311     CONTINUE
+        ELSE IF(I1D.EQ.7) THEN
+          DO 316 IBM=1,NMIX
+          DO 315 IBMOLD=1,NMIL
+          IF(MIXC(IBM).EQ.IBMOLD) GAR1(IBM,IGR,I1D)=GAR1(IBM,IGR,I1D)*
+     1    1.0E6 ! convert MeV to eV
+  315     CONTINUE
+  316     CONTINUE
+        ENDIF
+        CALL LCMPUT(KPMAC,HMAK1(I1D),NMIX,2,GAR1(1,IGR,I1D))
+      ENDIF
+  320 CONTINUE
+      DO 325 I2D=1,N2D
+      IF(LMAKE2(I2D).AND.(NF.GT.0)) THEN
+        CALL LCMPUT(KPMAC,HMAK2(I2D),NMIX*NF,2,GAR2(1,1,IGR,I2D))
+      ENDIF
+  325 CONTINUE
+      DO 360 IL=1,NL
+      WRITE(CM,'(I2.2)') IL-1
+      IPOSDE=0
+      DO 350 IBM=1,NMIX
+      IPOS(IBM)=IPOSDE+1
+      IGMIN=IGR
+      IGMAX=IGR
+      DO 330 JGR=1,NGRP
+      IF(GAR3(IBM,JGR,IGR,IL).NE.0.0) THEN
+        IGMIN=MIN(IGMIN,JGR)
+        IGMAX=MAX(IGMAX,JGR)
+      ENDIF
+  330 CONTINUE
+      IJJ(IBM)=IGMAX
+      NJJ(IBM)=IGMAX-IGMIN+1
+      DO 340 JGR=IGMAX,IGMIN,-1
+      IPOSDE=IPOSDE+1
+      GAR4(IPOSDE)=GAR3(IBM,JGR,IGR,IL)
+  340 CONTINUE
+  350 CONTINUE
+      IF(IPOSDE.GT.0) THEN
+        CALL LCMPUT(KPMAC,'SCAT'//CM,IPOSDE,2,GAR4)
+        CALL LCMPUT(KPMAC,'NJJS'//CM,NMIX,1,NJJ)
+        CALL LCMPUT(KPMAC,'IJJS'//CM,NMIX,1,IJJ)
+        CALL LCMPUT(KPMAC,'IPOS'//CM,NMIX,1,IPOS)
+        CALL LCMPUT(KPMAC,'SIGW'//CM,NMIX,2,GAR3(1,IGR,IGR,IL))
+      ENDIF
+  360 CONTINUE
+  365 CONTINUE
+      IF(IDF.EQ.3) THEN
+        CALL LCMSIX(IPMAC,'ADF',1)
+        CALL LCMPUT(IPMAC,'NTYPE',1,1,NSURFD)
+        CALL LCMPTC(IPMAC,'HADF',8,NSURFD,HADF)
+        DO ITYPE=1,NSURFD
+          CALL LCMPUT(IPMAC,HADF(ITYPE),NMIX*NGRP,2,ADF2(1,1,ITYPE))
+        ENDDO
+        CALL LCMSIX(IPMAC,' ',2)
+      ENDIF
+      IACCS=1
+*----
+*  UPDATE STATE-VECTOR
+*----
+      ISTATE(2)=NMIX
+      ISTATE(3)=NL
+      ISTATE(4)=NF
+      ISTATE(5)=NED
+      ISTATE(6)=ITRANC
+      CALL LCMPUT(IPMAC,'STATE-VECTOR',NSTATE,1,ISTATE)
+*----
+*  INCLUDE LEAKAGE IN THE MACROLIB (USED ONLY FOR NON-REGRESSION TESTS)
+*----
+      IF(B2.NE.0.0) THEN
+        IF(IMPX.GT.0) WRITE(IOUT,'(/31H ACRMAC: INCLUDE LEAKAGE IN THE,
+     1  14H MACROLIB (B2=,1P,E12.5,2H).)') B2
+        JPMAC=LCMGID(IPMAC,'GROUP')
+        ALLOCATE(WORK1(NMIX),WORK2(NMIX))
+        DO 520 IGR=1,NGRP
+          KPMAC=LCMGIL(JPMAC,IGR)
+          CALL LCMGET(KPMAC,'NTOT0',WORK1)
+          CALL LCMGET(KPMAC,'DIFF',WORK2)
+          DO 510 IBM=1,NMIX
+            IF(MIXC(IBM).NE.0) WORK1(IBM)=WORK1(IBM)+B2*WORK2(IBM)
+  510     CONTINUE
+          CALL LCMPUT(KPMAC,'NTOT0',NMIX,2,WORK1)
+  520   CONTINUE
+        DEALLOCATE(WORK2,WORK1)
+      ENDIF
+*----
+*  ACRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(HADF)
+      DEALLOCATE(ADF2,GAR4B,GAR4,GAR3,GAR2,GAR1)
+      DEALLOCATE(IPOSB,NJJB,IJJB,IPOS,NJJ,IJJ)
+      RETURN
+      END
diff --git a/Donjon/src/ACRNDF.f b/Donjon/src/ACRNDF.f
new file mode 100644
index 0000000..583ea46
--- /dev/null
+++ b/Donjon/src/ACRNDF.f
@@ -0,0 +1,106 @@
+*DECK ACRNDF
+      SUBROUTINE ACRNDF(IMPX,NBISO1,ISO,IBM,HNOMIS,IPAPX,IPLIB,MY1,MY2,
+     1 YLDS,ISTYP)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Store records PYNAM, PYMIX and PYIELD into a Microlib.
+*
+*Copyright:
+* Copyright (C) 2021 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IMPX    print parameter (equal to zero for no print).
+* NBISO1  number of particularized isotopes.
+* ISO     particularized isotope index.
+* IBM     material mixture.
+* HNOMIS  array containing the names of the particularized isotopes.
+* IPAPX   address of the Apex file.
+* IPLIB   address of the output microlib LCM object.
+* MY1     number of fissile isotopes including macroscopic sets.
+* MY2     number of fission fragment.
+* YLDS    fission yields.
+*
+*Parameters: output
+* ISTYP   type of isotope ISO (=1: stable;=2: fissile; =3: fission
+*         product).
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      USE hdf5_wrap
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPAPX,IPLIB
+      INTEGER IMPX,NBISO1,ISO,IBM,MY1,MY2,ISTYP
+      DOUBLE PRECISION YLDS(MY1,MY2)
+      CHARACTER(LEN=8) HNOMIS(NBISO1)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER I, IOF, NBISO
+*----
+*  ALLOCATABLE AYYAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IPYMIX
+      REAL, ALLOCATABLE, DIMENSION(:) :: PYIELD
+      CHARACTER(LEN=4), ALLOCATABLE, DIMENSION(:) :: TYPISO
+      CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: HPYNAM
+*
+      IF(hdf5_group_exists(IPAPX,"/physconst/")) THEN
+        CALL hdf5_read_data(IPAPX,"/physconst/ISOTYP",TYPISO)
+      ELSE IF(hdf5_group_exists(IPAPX,"/physco001/")) THEN
+        CALL hdf5_read_data(IPAPX,"/physco001/ISOTYP",TYPISO)
+      ELSE
+        CALL XABORT('ACRNDF: GROUP physconst NOT FOUND IN HDF5 FILE.')
+      ENDIF
+      NBISO=SIZE(TYPISO,1)
+      IF(ISO.LE.NBISO) THEN
+        IF(TYPISO(ISO).EQ.'OTHE') ISTYP=1
+        IF(TYPISO(ISO).EQ.'FISS') ISTYP=2
+        IF(TYPISO(ISO).EQ.'F.P.') ISTYP=3
+      ELSE
+        ISTYP=1
+      ENDIF
+      IF(ISTYP.EQ.3) THEN
+        ALLOCATE(HPYNAM(MY1),PYIELD(MY1),IPYMIX(MY1))
+        IOF=0
+        DO I=1,NBISO
+          IF(TYPISO(I).EQ.'FISS') THEN
+            IOF=IOF+1
+            IF(IOF.GT.MY1) CALL XABORT('ACRNDF: MY1 OVERFLOW.')
+            HPYNAM(IOF)=HNOMIS(I)
+            IPYMIX(IOF)=IBM
+            PYIELD(IOF)=REAL(YLDS(IOF,ISO))
+          ENDIF
+        ENDDO
+        DO I=NBISO+1,NBISO1
+            IOF=IOF+1
+            IF(IOF.GT.MY1) CALL XABORT('ACRNDF: MY1 OVERFLOW.')
+            HPYNAM(IOF)=HNOMIS(I)
+            IPYMIX(IOF)=IBM
+            PYIELD(IOF)=0.0
+        ENDDO
+        IF(IOF.NE.MY1) CALL XABORT('ACRNDF: MY1 COUNT ERROR.')
+        CALL LCMPTC(IPLIB,'PYNAM',8,MY1,HPYNAM)
+        CALL LCMPUT(IPLIB,'PYMIX',MY1,1,IPYMIX)
+        CALL LCMPUT(IPLIB,'PYIELD',MY1,2,PYIELD)
+        IF(IMPX.GT.2) THEN
+          WRITE(6,'(3X,7HPYIELD=,1P,8E12.4/(8X,10E12.4))') (PYIELD(I),
+     1    I=1,MY1)
+        ENDIF
+        DEALLOCATE(IPYMIX,PYIELD,HPYNAM)
+      ENDIF
+      DEALLOCATE(TYPISO)
+      RETURN
+      END
diff --git a/Donjon/src/ACRRGR.f b/Donjon/src/ACRRGR.f
new file mode 100644
index 0000000..544c480
--- /dev/null
+++ b/Donjon/src/ACRRGR.f
@@ -0,0 +1,894 @@
+*DECK ACRRGR
+      SUBROUTINE ACRRGR(IPAPX,IPMAP,LCUBIC,NMIX,IMPX,NMIL,NCAL,MD2,
+     1 NCH,NB,NFUEL,NPARM,NPAR,ITER,MAXNIS,MIXC,TERP,NISO,LISO,HISO,
+     2 CONC,ITODO,LFROM)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute TERP factors for Apex file interpolation. Use global
+* parameters from a fuel-map object and optional user-defined values.
+*
+*Copyright:
+* Copyright (C) 2021 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPAPX   address of the Apex file.
+* IPMAP   address of the fuel-map object.
+* LCUBIC  =.TRUE.: cubic Ceschino interpolation; =.FALSE: linear
+*         Lagrange interpolation.
+* NMIX    number of material mixtures in the fuel-map macrolib.
+* IMPX    print parameter (equal to zero for no print).
+* NMIL    number of material mixtures in the Apex file.
+* NCAL    number of elementary calculations in the Apex file.
+* MD2     number of particularized and macro isotopes in the Apex file.
+* NCH     number of reactor channels.
+* NB      number of fuel bundles per channel.
+* NFUEL   number of fuel types.
+* NPARM   number of additional parameters (other than burnup) defined
+*         in FMAP object
+* NPAR    number of parameters
+*
+*Parameters: output
+* ITER    completion flag (=0: all over; =1: use another Apex file;
+*         =2 use another L_MAP + Apex file).
+* MAXNIS  maximum value of NISO(I) in user data.
+* MIXC    mixture index in the Apex file corresponding to each microlib
+*         mixture.
+* TERP    interpolation factors.
+* NISO    number of user-selected isotopes.
+* LISO    type of treatment (=.true.: ALL; =.false.: ONLY).
+* HISO    name of the user-selected isotopes.
+* CONC    user-defined number density of the user-selected isotopes. A
+*         value of -99.99 is set to indicate that the compo value is
+*         used.
+* ITODO   non-depletion mask (=1 to force a user-selected isotope to be
+*         non-depleting)
+* LFROM   macroregion flag (=.true. if 'xs       n' groups are set).
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      USE hdf5_wrap
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPAPX,IPMAP
+      INTEGER NMIX,IMPX,NMIL,NCAL,MD2,NFUEL,NCH,NB,ITER,MAXNIS,
+     1        MIXC(NMIX),NPARM,NPAR,NISO(NMIX),ITODO(NMIX,MD2)
+      REAL TERP(NCAL,NMIX),CONC(NMIX,MD2)
+      LOGICAL LCUBIC,LISO(NMIX),LFROM
+      CHARACTER(LEN=8) HISO(NMIX,MD2)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXADD=10
+      INTEGER, PARAMETER::MAXPAR=50
+      INTEGER, PARAMETER::MAXLIN=50
+      REAL, PARAMETER::REPS=1.0E-4
+      INTEGER IBMOLD, IBM, IBTYP, IB, ICAL, ICH, IFUEL, ILONG, IMIX,
+     & IMPY, INDIC, IPAR, ISO, ITYPE, ITYP, IVARTY, I, JBM, JB, JCAL,
+     & JPARM, JPAR, J, NISOMI, NITMA, NPARMP, NTOT, N, RANK, TYPE,
+     & NBYTE, DIMSR(5)
+      REAL BURN0, BURN1, FLOTT, SUM, VALR1, VALR2, VARVAL
+      CHARACTER TEXT24*24,HSMG*131,TEXT132*132,VALH(MAXPAR)*12,
+     1 RECNAM*12,HPARNA*24,HCUBIC*24,TEXT12*12,HNAVAL*12
+      INTEGER VALI(MAXPAR),MUPLET(2*MAXPAR),MUTYPE(2*MAXPAR),
+     1 MAPLET(2*MAXPAR,MAXADD),MATYPE(2*MAXPAR,MAXADD),
+     2 IDLTA(2*MAXPAR,MAXADD),NDLTA(2*MAXPAR),IDLTA1,
+     3 MUPLT2(2*MAXPAR),MUTYP2(2*MAXPAR)
+      DOUBLE PRECISION DFLOTT
+      REAL VALR(2*MAXPAR,2),VALRA(2*MAXPAR,2,MAXADD),CONCMI(MD2)
+      LOGICAL LDELT(2*MAXPAR),LDELT1,LSET(2*MAXPAR),LADD(2*MAXPAR),
+     1 LSET1,LADD1,LDMAP(2*MAXPAR,2),LAMAP(2*MAXPAR,2,MAXADD),
+     2 LCUB2(MAXPAR),LTST,LISOMI
+      TYPE(C_PTR) JPMAP,KPMAP
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: NVALUE,FMIX,ZONEC,VINTE
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ZONEDP
+      REAL, ALLOCATABLE, DIMENSION(:) :: BRN0,BRN1,VARC,TERPA,VREAL
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: WPAR
+      LOGICAL, ALLOCATABLE, DIMENSION(:) :: LPARM,LDELTA
+      CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: HISOMI, PARFMT
+      CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: VCHAR
+      CHARACTER(LEN=24), ALLOCATABLE, DIMENSION(:) :: HPAR, PARKEY
+      CHARACTER(LEN=132), ALLOCATABLE, DIMENSION(:) :: TEXT132V1
+*----
+*  SCRATCH STORAGE ALLOCATION
+*   FMIX    fuel mixture indices per fuel bundle.
+*   BRN0    contains either low burnup integration limits or
+*           instantaneous burnups per fuel bundle.
+*   BRN1    upper burnup integration limits per fuel bundle.
+*   WPAR    other parameter distributions.
+*   HPAR    'PARKEY' name of the other parameters.
+*----
+      ALLOCATE(LPARM(NPARM+1),FMIX(NCH*NB),ZONEDP(NCH,NB),ZONEC(NCH),
+     1 BRN0(NCH*NB),BRN1(NCH*NB),WPAR(NCH*NB,NPARM),LDELTA(NMIX),
+     2 HPAR(NPARM+1),HISOMI(MD2))
+*----
+*  RECOVER INFORMATION FOR THE APEX FILE.
+*----
+      CALL hdf5_info(IPAPX,"/Calculation_Content",RANK,TYPE,NBYTE,DIMSR)
+      IF(RANK.GT.MAXLIN) CALL XABORT('ACRRGR: MAXLIN OVERFLOW.')
+      IF(NPAR.GT.MAXPAR) CALL XABORT('ACRRGR: MAXPAR OVERFLOW.')
+      CALL hdf5_read_data(IPAPX,"/Calculation_Content",TEXT132)
+      IF((RANK.EQ.1).AND.(DIMSR(1).EQ.1)) THEN
+        CALL hdf5_read_data(IPAPX,"/Calculation_Content",TEXT132)
+        IF(IMPX.GT.0) WRITE(IOUT,'(1X,A)') TEXT132
+      ELSE IF(RANK.EQ.1) THEN
+        CALL hdf5_read_data(IPAPX,"/Calculation_Content",TEXT132V1)
+        IF(IMPX.GT.0) THEN
+          DO I=1,DIMSR(1)
+            WRITE(IOUT,'(1X,A)') TEXT132V1(I)
+          ENDDO
+        ENDIF
+        DEALLOCATE(TEXT132V1)
+      ENDIF
+      IF(NPAR.GT.0) THEN
+         CALL hdf5_read_data(IPAPX,"/paramdescrip/PARNAM",PARKEY)
+         CALL hdf5_read_data(IPAPX,"/paramdescrip/PARFMT",PARFMT)
+      ENDIF
+      IF(IMPX.GT.1) THEN
+        WRITE(IOUT,*) 'NPAR=',NPAR,SIZE(PARKEY,1)
+        DO I=1,NPAR
+          WRITE(IOUT,*)'PARKEY(',I,')=',PARKEY(I),' PARFMT=',PARFMT(I)
+        ENDDO
+      ENDIF
+      TERP(:NCAL,:NMIX)=0.0
+      MIXC(:NMIX)=0
+*----
+*  READ (INTERP_DATA) AND SET VALI, VALR AND VALH PARAMETERS
+*  CORRESPONDING TO THE INTERPOLATION POINT. FILL MUPLET FOR
+*  PARAMETERS SET WITHOUT INTERPOLATION.
+*----
+      IBM=0
+      MAXNIS=0
+      NISOMI=0
+      LISOMI=.TRUE.
+      LDELT1=.FALSE.
+      LADD1=.FALSE.
+      NISO(:NMIX)=0
+      LISO(:NMIX)=.TRUE.
+      LDELTA(:NMIX)=.FALSE.
+      ITODO(:NMIX,:MD2)=0
+      IDLTA1=0
+      LFROM=.FALSE.
+      DO I=1,2*MAXPAR
+         LSET(I)=.FALSE.
+         LDELT(I)=.FALSE.
+         LADD(I)=.FALSE.
+         LDMAP(I,:2)=.FALSE.
+         LAMAP(I,:2,:MAXADD)=.FALSE.
+         NDLTA(I)=0
+      ENDDO
+*----
+*  READ THE PARKEY NAME OF THE BURNUP FOR THIS APEX.
+*----
+      CALL REDGET(INDIC,NITMA,FLOTT,TEXT24,DFLOTT)
+      IF(INDIC.NE.3)CALL XABORT('ACRRGR: CHARACTER DATA EXPECTED(1).')
+      IF((TEXT24.EQ.'MIX').OR.(TEXT24.EQ.';')) THEN
+        NPARMP=NPARM
+        GO TO 30
+      ELSE
+*       add burnup to parameters
+        NPARMP=NPARM+1
+        HPAR(NPARMP)=TEXT24
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3)CALL XABORT('MCRRGR: CHARACTER DATA EXPECTED(2).')
+        IF((TEXT12.EQ.'MIX').OR.(TEXT12.EQ.';')) GO TO 30
+        HNAVAL=TEXT12
+      ENDIF
+*----
+*  MAIN LOOP OF THE SUBROUTINE (UNTIL THE END)
+*----
+   20 CALL REDGET(INDIC,NITMA,FLOTT,TEXT24,DFLOTT)
+      IF(INDIC.NE.3)CALL XABORT('ACRRGR: CHARACTER DATA EXPECTED(2).')
+   30 IF(TEXT24.EQ.'MIX')THEN
+        NISOMI=0
+        LISOMI=.TRUE.
+        IVARTY=0
+        IBTYP=0
+        HNAVAL=' '
+        MUPLET(:NPAR)=0
+        MUTYPE(:NPAR)=0
+        VALI(:NPAR)=0
+        VALR(:NPAR,1)=0.0
+        VALR(:NPAR,2)=0.0
+        DO 35 I=1,MAXADD
+          MAPLET(:NPAR,I)=0
+          MATYPE(:NPAR,I)=0
+          VALRA(:NPAR,1,I)=0.0
+          VALRA(:NPAR,2,I)=0.0
+   35   CONTINUE
+        DO I=1,2*MAXPAR
+          LSET(I)=.FALSE.
+          LDELT(I)=.FALSE.
+          LADD(I)=.FALSE.
+          LDMAP(I,:2)=.FALSE.
+          LAMAP(I,:2,:MAXADD)=.FALSE.
+        ENDDO
+        DO 40 I=1,NPAR
+        VALH(I)=' '
+   40   CONTINUE
+        LCUB2(:NPAR)=LCUBIC
+        CALL REDGET(INDIC,IBM,FLOTT,TEXT24,DFLOTT)
+        IF(INDIC.NE.1)CALL XABORT('ACRRGR: INTEGER DATA EXPECTED.')
+*       CHECK FUEL MIXTURE
+        JPMAP=LCMGID(IPMAP,'FUEL')
+        DO IFUEL=1,NFUEL
+          KPMAP=LCMGIL(JPMAP,IFUEL)
+          CALL LCMGET(KPMAP,'MIX',IMIX)
+          IF(IMIX.EQ.IBM)GOTO 50
+        ENDDO
+        WRITE(IOUT,*)'ACRRGR: UNABLE TO FIND FUEL MIXTURE ',IBM
+        CALL XABORT('ACRRGR: WRONG MIXTURE NUMBER.')
+   50   IBMOLD=1
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT24,DFLOTT)
+        IF(INDIC.NE.3)CALL XABORT('ACRRGR: CHARACTER DATA EXPECTED(3).')
+        IF(TEXT24.EQ.'FROM')THEN
+          CALL REDGET(INDIC,IBMOLD,FLOTT,TEXT24,DFLOTT)
+          IF(INDIC.NE.1)CALL XABORT('ACRRGR: INTEGER DATA EXPECTED.')
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT24,DFLOTT)
+          IF(INDIC.NE.3)CALL XABORT('ACRRGR: CHARACTER DATA EXPECTE'
+     1     //'D.')
+          LFROM=.TRUE.
+        ELSE IF(TEXT24.EQ.'USE') THEN
+          IBMOLD=IBM
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT24,DFLOTT)
+          IF(INDIC.NE.3)CALL XABORT('ACRRGR: CHARACTER DATA EXPECTE'
+     1     //'D.')
+          LFROM=.TRUE.
+        ENDIF
+        GOTO 30
+      ELSEIF(TEXT24.EQ.'MICRO')THEN
+        IF(IBM.EQ.0) CALL XABORT('ACRRGR: MIX NOT SET (1).')
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT24,DFLOTT)
+        IF(INDIC.NE.3)CALL XABORT('ACRRGR: CHARACTER DATA EXPECTED(4).')
+        IF(TEXT24.EQ.'ALL')THEN
+          LISOMI=.TRUE.
+        ELSEIF(TEXT24.EQ.'ONLY')THEN
+          LISOMI=.FALSE.
+        ENDIF
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT24,DFLOTT)
+        IF(INDIC.NE.3)CALL XABORT('ACRRGR: CHARACTER DATA EXPECTED(5).')
+   60   IF(TEXT24.EQ.'ENDMIX')THEN
+          GOTO 30
+        ELSE IF(TEXT24.EQ.'NOEV') THEN
+          IF(NISOMI.EQ.0) CALL XABORT('ACRRGR: MISPLACED NOEV.')
+          ITODO(IBM,NISOMI)=1
+        ELSE
+          NISOMI=NISOMI+1
+          IF(NISOMI.GT.MD2) CALL XABORT('ACRRGR: MD2 OVERFLOW.')
+          MAXNIS=MAX(MAXNIS,NISOMI)
+          HISOMI(NISOMI)=TEXT24(:8)
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT24,DFLOTT)
+          IF(INDIC.EQ.2)THEN
+            CONCMI(NISOMI)=FLOTT
+          ELSEIF((INDIC.EQ.3).AND.(TEXT24.EQ.'*'))THEN
+            CONCMI(NISOMI)=-99.99
+          ELSE
+            CALL XABORT('ACRRGR: INVALID HISO DATA.')
+          ENDIF
+        ENDIF
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT24,DFLOTT)
+        IF(INDIC.NE.3)CALL XABORT('ACRRGR: CHARACTER DATA EXPECTED.')
+        GOTO 60
+      ELSEIF((TEXT24.EQ.'SET').OR.(TEXT24.EQ.'DELTA').OR.
+     1       (TEXT24.EQ.'ADD'))THEN
+        IF(IBM.EQ.0) CALL XABORT('ACRRGR: MIX NOT SET (2).')
+        LSET1=.FALSE.
+        LDELT1=.FALSE.
+        LADD1=.FALSE.
+        ITYPE=0
+        IF(TEXT24.EQ.'SET')THEN
+          ITYPE=1
+          LSET1=.TRUE.
+        ELSEIF(TEXT24.EQ.'DELTA')THEN
+          ITYPE=2
+          LDELT1=.TRUE.
+        ELSEIF(TEXT24.EQ.'ADD')THEN
+          ITYPE=2
+          LADD1=.TRUE.
+          IDLTA1=IDLTA1+1
+          DO 65 JPAR=1,NPAR
+            MAPLET(JPAR,IDLTA1)=MUPLET(JPAR)
+            MATYPE(JPAR,IDLTA1)=MUTYPE(JPAR)
+   65     CONTINUE
+        ENDIF
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT24,DFLOTT)
+        IF(INDIC.NE.3)CALL XABORT('ACRRGR: CHARACTER DATA EXPECTED(7).')
+        IF((TEXT24.EQ.'LINEAR').OR.(TEXT24.EQ.'CUBIC')) THEN
+          HCUBIC=TEXT24
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT24,DFLOTT)
+        ELSE
+          HCUBIC=' '
+        ENDIF
+        IF(INDIC.NE.3)CALL XABORT('ACRRGR: CHARACTER DATA EXPECTED(8).')
+        DO I=1,NPAR
+          IF(TEXT24.EQ.PARKEY(I))THEN
+            IPAR=I
+            HPARNA=TEXT24
+            GOTO 70
+          ENDIF
+        ENDDO
+        WRITE(HSMG,'(18HACRRGR: PARAMETER ,A,14H NOT FOUND(1).)') TEXT24
+        CALL XABORT(HSMG)
+*
+   70   IF(HCUBIC.EQ.'LINEAR') THEN
+          LCUB2(IPAR)=.FALSE.
+        ELSE IF(HCUBIC.EQ.'CUBIC') THEN
+          LCUB2(IPAR)=.TRUE.
+        ENDIF
+        CALL hdf5_read_data(IPAPX,"/paramdescrip/NVALUE",NVALUE)
+        WRITE(RECNAM,'(''/paramvalues/PVAL'',I8)') IPAR
+        CALL hdf5_info(IPAPX,RECNAM,RANK,TYPE,NBYTE,DIMSR)
+        IF(TYPE.EQ.99) THEN
+          WRITE(HSMG,'(25HACRRGR: GLOBAL PARAMETER ,A,12H NOT SET(1).)')
+     1    TRIM(PARKEY(IPAR))
+          CALL XABORT(HSMG)
+        ENDIF
+        IF((IPAR.GT.NPAR).OR.
+     1   ((IPAR.LE.NPAR).AND.(PARFMT(IPAR).EQ.'FLOTTANT')))THEN
+          CALL hdf5_read_data(IPAPX,RECNAM,VREAL)
+          CALL REDGET(INDIC,NITMA,VALR1,TEXT24,DFLOTT)
+          IF(INDIC.EQ.2)THEN
+            VALR2=VALR1
+            IF(LSET1) THEN
+              LSET(IPAR)=.TRUE.
+              VALR(IPAR,1)=VALR1
+              VALR(IPAR,2)=VALR1
+            ENDIF
+            IF(LDELT1) THEN
+              LDELT(IPAR)=.TRUE.
+              VALR(IPAR,1)=VALR1
+              VALR(IPAR,2)=VALR1
+            ELSEIF(LADD1) THEN
+              LADD(IPAR)=.TRUE.
+              VALRA(IPAR,1,IDLTA1)=VALR1
+              VALRA(IPAR,2,IDLTA1)=VALR1
+              NDLTA(IPAR)=NDLTA(IPAR)+1
+              IF(NDLTA(IPAR).GT.MAXADD) CALL XABORT('ACRRGR: MAXADD OV'
+     1        //'ERFLOW.')
+              IDLTA(IPAR,NDLTA(IPAR))=IDLTA1
+            ENDIF
+          ELSEIF(TEXT24.EQ.'MAP')THEN
+            IF(LDELT1)THEN
+              LDELT(IPAR)=.TRUE.
+              LDMAP(IPAR,1)=.TRUE.
+            ELSEIF(LADD1)THEN
+              LADD(IPAR)=.TRUE.
+              NDLTA(IPAR)=NDLTA(IPAR)+1
+              IF(NDLTA(IPAR).GT.MAXADD) CALL XABORT('ACRRGR: MAXADD OV'
+     1        //'ERFLOW.')
+              LAMAP(IPAR,1,NDLTA(IPAR))=.TRUE.
+              IDLTA(IPAR,NDLTA(IPAR))=IDLTA1
+            ENDIF
+            IF(LSET1.AND.(.NOT.LSET(IPAR))) GO TO 20
+          ELSE
+            CALL XABORT('ACRRGR: real value or "MAP" expected(1).')
+          ENDIF
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT24,DFLOTT)
+          IF(ITYPE.GE.2)THEN
+            IF(INDIC.EQ.2)THEN
+              VALR2=FLOTT
+              IF(LDELT1)THEN
+                VALR(IPAR,2)=VALR2
+              ELSEIF(LADD1)THEN
+                VALRA(IPAR,2,IDLTA1)=VALR2
+              ENDIF
+            ELSEIF(TEXT24.EQ.'MAP')THEN
+              IF(LDELT1)THEN
+                LDMAP(IPAR,2)=.TRUE.
+              ELSEIF(LADD1)THEN
+                LAMAP(IPAR,2,IDLTA1)=.TRUE.
+              ENDIF
+            ELSE
+              CALL XABORT('ACRRGR: real value or "MAP" expected(2).')
+            ENDIF
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT24,DFLOTT)
+          ENDIF
+          LTST=.FALSE.
+          IF(.NOT.LADD1)THEN
+            IF(VALR(IPAR,1).EQ.VALR(IPAR,2)) LTST=.TRUE.
+            MUPLET(IPAR)=-1
+            MUTYPE(IPAR)=ITYPE
+          ELSE
+            MAPLET(IPAR,IDLTA1)=-1
+            MATYPE(IPAR,IDLTA1)=2
+          ENDIF
+          IF((LTST).AND.(ITYPE.EQ.1))THEN
+            DO J=1,NVALUE(IPAR)
+              IF(ABS(VALR(IPAR,1)-VREAL(J)).LE.REPS*ABS(VREAL(J)))THEN
+                MUPLET(IPAR)=J
+                GOTO 30
+              ENDIF
+            ENDDO
+          ENDIF
+*----
+*  ERRORS HANDLING
+*----
+          IF(VALR1.LT.VREAL(1))THEN
+*           OUTSIDE OF THE DOMAIN (1)
+            WRITE(HSMG,'(23HACRRGR: REAL PARAMETER ,A,10H WITH VALU,
+     1       1HE,1P,E12.4,26H IS OUTSIDE THE DOMAIN.(1))') TRIM(HPARNA),
+     2       VALR1
+             WRITE(6,*)'Domain:',VREAL(1),' <-> ',VREAL(NVALUE(IPAR))
+            CALL XABORT(HSMG)
+          ELSEIF(VALR2.GT.VREAL(NVALUE(IPAR)))THEN
+*           OUTSIDE OF THE DOMAIN (2)
+            WRITE(HSMG,'(23HACRRGR: REAL PARAMETER ,A,10H WITH VALU,
+     1       1HE,1P,E12.4,26H IS OUTSIDE THE DOMAIN.(2))') TRIM(HPARNA),
+     2       VALR2
+             WRITE(6,*)'Domain:',VREAL(1),' <-> ',VREAL(NVALUE(IPAR))
+            CALL XABORT(HSMG)
+          ELSEIF((VALR1.GT.VALR2).AND.(ITYPE.EQ.1))THEN
+*           ITYPE=1 correspond to an integral between VALR1 and VALR2
+*           otherwise it is a simple difference
+            WRITE(HSMG,'(23HACRRGR: REAL PARAMETER ,A,9H IS DEFIN,
+     1       7HED WITH,1P,E12.4,2H >,E12.4,4H.(1))') TRIM(HPARNA),
+     2       VALR1,VALR2
+            CALL XABORT(HSMG)
+          ENDIF
+          IF((LADD1).AND.(TEXT24.EQ.'REF'))THEN
+  120       DEALLOCATE(VREAL)
+            IPAR=-99
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT24,DFLOTT)
+            IF(TEXT24.EQ.'ENDREF') GOTO 140
+            DO I=1,NPAR
+              IF(TEXT24.EQ.PARKEY(I))THEN
+                IPAR=I
+                GOTO 130
+              ENDIF
+            ENDDO
+            CALL XABORT('ACRRGR: PARAMETER '//TEXT24//' NOT FOUND(2).')
+  130       CONTINUE
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT24,DFLOTT)
+            IF(INDIC.EQ.2)THEN
+              VALRA(IPAR,1,IDLTA1)=FLOTT
+              VALRA(IPAR,2,IDLTA1)=FLOTT
+              WRITE(RECNAM,'(''/paramvalues/PVAL'',I8)') IPAR
+              CALL hdf5_info(IPAPX,RECNAM,RANK,TYPE,NBYTE,DIMSR)
+              IF(TYPE.EQ.99) THEN
+                 WRITE(HSMG,'(25HACRRGR: GLOBAL PARAMETER ,A,
+     1           12H NOT SET(2).)') TRIM(PARKEY(IPAR))
+                 CALL XABORT(HSMG)
+              ENDIF
+              CALL hdf5_read_data(IPAPX,RECNAM,VREAL)
+              MAPLET(IPAR,IDLTA1)=-1
+              MATYPE(IPAR,IDLTA1)=1
+              DO J=1,NVALUE(IPAR)
+                IF(ABS(VALRA(IPAR,1,IDLTA1)-VREAL(J)).LE.
+     1             REPS*ABS(VREAL(J)))THEN
+                  MAPLET(IPAR,IDLTA1)=J
+                  GOTO 120
+                ENDIF
+              ENDDO
+            ELSEIF(TEXT24.EQ.'SAMEASREF')THEN
+              MAPLET(IPAR,IDLTA1)=-1
+              MATYPE(IPAR,IDLTA1)=-1
+            ELSE
+              CALL XABORT('ACRRGR: REAL or "SAMEASREF" expected')
+            ENDIF
+            GOTO 120
+  140       CALL REDGET(INDIC,NITMA,FLOTT,TEXT24,DFLOTT)
+          ELSE IF((LDELT1).AND.(TEXT24.EQ.'REF'))THEN
+  150       DEALLOCATE(VREAL)
+            IPAR=-99
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT24,DFLOTT)
+            IF(TEXT24.EQ.'ENDREF') GOTO 170
+            DO I=1,NPAR
+              IF(TEXT24.EQ.PARKEY(I))THEN
+                IPAR=I
+                GOTO 160
+              ENDIF
+            ENDDO
+            CALL XABORT('ACRRGR: PARAMETER '//TEXT24//' NOT FOUND(3).')
+  160       CONTINUE
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT24,DFLOTT)
+            IF(INDIC.EQ.2)THEN
+              VALR(IPAR,1)=FLOTT
+              VALR(IPAR,2)=FLOTT
+              WRITE(RECNAM,'(''/paramvalues/PVAL'',I8)') IPAR
+              CALL hdf5_info(IPAPX,RECNAM,RANK,TYPE,NBYTE,DIMSR)
+              IF(TYPE.EQ.99) THEN
+                 WRITE(HSMG,'(25HACRRGR: GLOBAL PARAMETER ,A,
+     1           12H NOT SET(3).)') TRIM(PARKEY(IPAR))
+                 CALL XABORT(HSMG)
+              ENDIF
+              CALL hdf5_read_data(IPAPX,RECNAM,VREAL)
+              MUPLET(IPAR)=-1
+              MUTYPE(IPAR)=1
+              DO J=1,NVALUE(IPAR)
+                IF(ABS(VALR(IPAR,1)-VREAL(J)).LE.REPS*ABS(VREAL(J)))THEN
+                  MUPLET(IPAR)=J
+                  GOTO 150
+                ENDIF
+              ENDDO
+            ELSEIF(TEXT24.EQ.'SAMEASREF')THEN
+              MUPLET(IPAR)=-1
+              MUTYPE(IPAR)=-1
+            ELSE
+              CALL XABORT('ACRRGR: REAL or "SAMEASREF" expected')
+            ENDIF
+            GOTO 150
+  170       CALL REDGET(INDIC,NITMA,FLOTT,TEXT24,DFLOTT)
+          ENDIF
+          DEALLOCATE(VREAL)
+          GOTO 30
+        ELSEIF(PARFMT(IPAR).EQ.'ENTIER')THEN
+          IF(ITYPE.NE.1)CALL XABORT('ACRRGR: SET MANDATORY WITH INT'
+     1     //'EGER PARAMETERS.')
+          CALL REDGET(INDIC,VALI(IPAR),FLOTT,TEXT24,DFLOTT)
+          IF(INDIC.NE.1)CALL XABORT('ACRRGR: INTEGER DATA EXPECTED.')
+          CALL hdf5_read_data(IPAPX,RECNAM,VINTE)
+          DO 175 J=1,NVALUE(IPAR)
+            IF(VALI(IPAR).EQ.VINTE(J))THEN
+              MUPLET(IPAR)=J
+              MUTYPE(IPAR)=ITYPE
+              GOTO 20
+            ENDIF
+  175      CONTINUE
+          WRITE(HSMG,'(26HACRRGR: INTEGER PARAMETER ,A,9H WITH VAL,
+     1     2HUE,I5,28H NOT FOUND IN APEX DATABASE.)') PARKEY(IPAR),
+     2     VALI(IPAR)
+           CALL XABORT(HSMG)
+        ELSEIF(PARFMT(IPAR).EQ.'CHAINE')THEN
+          IF(ITYPE.NE.1)CALL XABORT('ACRRGR: SET MANDATORY WITH STR'
+     1     //'ING PARAMETERS.')
+          CALL REDGET(INDIC,NITMA,FLOTT,VALH(IPAR),DFLOTT)
+          IF(INDIC.NE.3)CALL XABORT('ACRRGR: STRING DATA EXPECTED.')
+          CALL hdf5_read_data(IPAPX,RECNAM,VCHAR)
+          DO 180 J=1,NVALUE(IPAR)
+            IF(VALH(IPAR).EQ.VCHAR(J))THEN
+              MUPLET(IPAR)=J
+              MUTYPE(IPAR)=ITYPE
+              GOTO 20
+            ENDIF
+  180     CONTINUE
+          WRITE(HSMG,'(25HACRRGR: STRING PARAMETER ,A,10H WITH VALU,
+     1     1HE,A12,28H NOT FOUND IN APEX DATABASE.)') PARKEY(IPAR),
+     2     VALH(IPAR)
+          CALL XABORT(HSMG)
+        ELSE
+          CALL XABORT('ACRRGR: INVALID FORMAT='//PARFMT(IPAR))
+        ENDIF
+      ELSEIF(TEXT24.EQ.'TIMAV-BURN')THEN
+        IF(IBM.EQ.0) CALL XABORT('ACRRGR: MIX NOT SET (3).')
+        IBTYP=1
+      ELSEIF(TEXT24.EQ.'INST-BURN')THEN
+        IF(IBM.EQ.0) CALL XABORT('ACRRGR: MIX NOT SET (4).')
+        IBTYP=2
+      ELSEIF(TEXT24.EQ.'AVG-EX-BURN')THEN
+        IF(IBM.EQ.0) CALL XABORT('ACRRGR: MIX NOT SET (5).')
+        IBTYP=3
+        CALL REDGET(INDIC,IVARTY,FLOTT,TEXT24,DFLOTT)
+        IF(INDIC.NE.1)CALL XABORT('ACRRGR: INTEGER DATA EXPECTED.')
+      ELSEIF(TEXT24.EQ.'ENDMIX')THEN
+*----
+*  RECOVER FUEL-MAP INFORMATION.
+*----
+        IF(IMPX.GT.0) THEN
+          DO IPAR=1,NPAR
+            IF(PARFMT(IPAR).EQ.'FLOTTANT')THEN
+              IF(LCUB2(IPAR)) THEN
+                WRITE(IOUT,'(26H ACRRGR: GLOBAL PARAMETER:,A12,5H ->CU,
+     1          18HBIC INTERPOLATION.)') PARKEY(IPAR)
+              ELSE
+                WRITE(IOUT,'(26H ACRRGR: GLOBAL PARAMETER:,A12,5H ->LI,
+     1          19HNEAR INTERPOLATION.)') PARKEY(IPAR)
+              ENDIF
+            ENDIF
+          ENDDO
+        ENDIF
+        FMIX(:NCH*NB)=0
+        CALL LCMGET(IPMAP,'FLMIX',FMIX)
+        CALL NCRMAP(IPMAP,NPARM,HPAR,NCH,NB,IBTYP,HNAVAL,IMPX,BRN0,BRN1,
+     1              WPAR,LPARM)
+        IF(IBTYP.EQ.3) THEN
+          IF(IVARTY.EQ.0) CALL XABORT('ACRRGR: IVARTY NOT SET.')
+          CALL LCMGET(IPMAP,'B-ZONE',ZONEC)
+          DO ICH=1,NCH
+            DO J=1,NB
+              IF(ZONEC(ICH).EQ.IVARTY) THEN
+                ZONEDP(ICH,J)=1
+              ELSE
+                ZONEDP(ICH,J)=0
+              ENDIF
+            ENDDO
+          ENDDO
+          CALL LCMLEN(IPMAP,'B-VALUE',ILONG,ITYP)
+          IF (ILONG.EQ.0) CALL XABORT('ACRRGR: NO SAVED VALUES FOR '
+     1    //'THIS TYPE OF VARIABLE IN L_MAP')
+          ALLOCATE(VARC(ILONG))
+          CALL LCMGET(IPMAP,'B-VALUE',VARC)
+          VARVAL=VARC(IVARTY)
+          DEALLOCATE(VARC)
+        ENDIF
+*----
+*  PERFORM INTERPOLATION OVER THE FUEL MAP.
+*----
+        DO 185 JPARM=1,NPARMP
+          IPAR=0
+          DO I=1,NPAR
+            IF(HPAR(JPARM).EQ.PARKEY(I))THEN
+              IPAR=I
+              IF(LSET(IPAR)) THEN
+                IF(IMPX.GT.0) WRITE(6,*) 'L_MAP values overwritten by '
+     1          // 'the SET option for parameter '//TRIM(HPAR(JPARM))
+                IF(.NOT.LADD(IPAR)) LPARM(JPARM)=.FALSE.
+              ENDIF
+              GOTO 185
+            ENDIF
+          ENDDO
+          LPARM(JPARM)=.FALSE.
+  185   CONTINUE
+*----
+*  COMPUTE ALL THE MUPLETS FOR EACH BUNDLE
+*----
+        IMPY=MAX(0,IMPX-1)
+        NTOT=0
+        DO 285 JB=1,NB
+        DO 280 ICH=1,NCH
+        IB=(JB-1)*NCH+ICH
+        IF(FMIX(IB).EQ.0) GO TO 280
+        NTOT=NTOT+1
+        IF(FMIX(IB).EQ.IBM)THEN
+          IF(NTOT.GT.NMIX) CALL XABORT('ACRRGR: NMIX OVERFLOW.')
+          DO 260 JPARM=1,NPARMP
+          IF(.NOT.LPARM(JPARM))GOTO 260
+        DO I=1,NPAR
+          IF(HPAR(JPARM).EQ.PARKEY(I))THEN
+            IPAR=I
+            HPARNA=HPAR(JPARM)
+            GOTO 190
+          ENDIF
+        ENDDO
+        WRITE(HSMG,'(18HACRRGR: PARAMETER ,A,14H NOT FOUND(4).)')
+     1  TRIM(HPAR(JPARM))
+        CALL XABORT(HSMG)
+  190   CONTINUE
+        WRITE(RECNAM,'(''/paramvalues/PVAL'',I8)') IPAR
+        CALL hdf5_info(IPAPX,RECNAM,RANK,TYPE,NBYTE,DIMSR)
+        IF(TYPE.EQ.99) THEN
+          WRITE(HSMG,'(25HACRRGR: GLOBAL PARAMETER ,A,12H NOT SET(4).)')
+     1    TRIM(PARKEY(IPAR))
+          CALL XABORT(HSMG)
+        ENDIF
+        ITYPE=0
+        IF((JPARM.EQ.NPARMP).AND.(NPARMP.EQ.NPARM+1))THEN
+*         parameter JPARAM is burnup
+          IF(.NOT.LSET(IPAR))THEN
+            MUTYPE(IPAR)=1
+            MUPLET(IPAR)=-1
+            BURN0=0.0
+            BURN1=0.0
+            IF(IBTYP.EQ.1)THEN
+*             TIME-AVERAGE
+              BURN0=BRN0(IB)
+              BURN1=BRN1(IB)
+            ELSEIF(IBTYP.EQ.2)THEN
+*             INSTANTANEOUS
+              BURN0=BRN0(IB)
+              BURN1=BURN0
+            ELSEIF(IBTYP.EQ.3)THEN
+*             DIFFERENCIATION RELATIVE TO EXIT BURNUP
+              ITYPE=3
+              BURN0=BRN0(IB)
+              BURN1=BRN1(IB)
+            ENDIF
+            VALR(IPAR,1)=BURN0
+            VALR(IPAR,2)=BURN1
+            VALR1=VALR(IPAR,1)
+            VALR2=VALR(IPAR,2)
+            ITYPE=1
+          ENDIF
+        ELSE
+          IF(.NOT.LSET(IPAR))THEN
+            VALR(IPAR,1)=WPAR(IB,JPARM)
+            VALR(IPAR,2)=WPAR(IB,JPARM)
+            MUPLET(IPAR)=-1
+            MUTYPE(IPAR)=1
+            VALR1=VALR(IPAR,1)
+            VALR2=VALR(IPAR,2)
+            ITYPE=1
+          ENDIF
+          IF(LDMAP(IPAR,1).OR.LDMAP(IPAR,2))THEN
+            IF(LDMAP(IPAR,1)) VALR(IPAR,1)=WPAR(IB,JPARM)
+            IF(LDMAP(IPAR,2)) VALR(IPAR,2)=WPAR(IB,JPARM)
+            MUPLET(IPAR)=-1
+            MUTYPE(IPAR)=2
+            VALR1=VALR(IPAR,1)
+            VALR2=VALR(IPAR,2)
+            ITYPE=2
+          ELSE IF(LADD(IPAR))THEN
+            DO N=1,NDLTA(IPAR)
+              IDLTA1=IDLTA(IPAR,N)
+              IF(LAMAP(IPAR,1,IDLTA1)) THEN
+                VALRA(IPAR,1,IDLTA1)=WPAR(IB,JPARM)
+                MAPLET(IPAR,IDLTA1)=-1
+                MATYPE(IPAR,IDLTA1)=2
+              ENDIF
+              IF(LAMAP(IPAR,2,IDLTA1)) THEN
+                VALRA(IPAR,2,IDLTA1)=WPAR(IB,JPARM)
+                MAPLET(IPAR,IDLTA1)=-1
+                MATYPE(IPAR,IDLTA1)=2
+              ENDIF
+            ENDDO
+            VALR1=VALRA(IPAR,1,IDLTA(IPAR,1))
+            VALR2=VALRA(IPAR,2,IDLTA(IPAR,1))
+            ITYPE=2
+          ENDIF
+        ENDIF
+        WRITE(RECNAM,'(''/paramvalues/PVAL'',I8)') IPAR
+        CALL hdf5_info(IPAPX,RECNAM,RANK,TYPE,NBYTE,DIMSR)
+        IF(TYPE.EQ.99) THEN
+          WRITE(HSMG,'(25HACRRGR: GLOBAL PARAMETER ,A,12H NOT SET(5).)')
+     1    TRIM(PARKEY(IPAR))
+          CALL XABORT(HSMG)
+        ENDIF
+        CALL hdf5_read_data(IPAPX,RECNAM,VREAL)
+        IF(ITYPE.EQ.1)THEN
+          IF(VALR1.EQ.VALR2)THEN
+            DO J=1,NVALUE(IPAR)
+              IF(ABS(VALR1-VREAL(J)).LE.REPS*ABS(VREAL(J)))THEN
+                MUPLET(IPAR)=J
+                MUTYPE(IPAR)=ITYPE
+                GOTO 260
+              ENDIF
+            ENDDO
+          ENDIF
+        ENDIF
+*----
+*  ERRORS HANDLING
+*----
+        IF(VALR1.LT.VREAL(1))THEN
+*         OUTSIDE OF THE DOMAIN (1)
+          WRITE(HSMG,'(23HACRRGR: REAL PARAMETER ,A,10H WITH VALU,
+     1    1HE,1P,E12.4,26H IS OUTSIDE THE DOMAIN(3).)') TRIM(HPARNA),
+     2    VALR1
+          WRITE(6,*)'Domain:',VREAL(1),' <-> ',VREAL(NVALUE(IPAR))
+          CALL XABORT(HSMG)
+        ELSEIF(VALR2.GT.VREAL(NVALUE(IPAR)))THEN
+*         OUTSIDE OF THE DOMAIN (2)
+          WRITE(HSMG,'(23HACRRGR: REAL PARAMETER ,A,10H WITH VALU,
+     1    1HE,1P,E12.4,26H IS OUTSIDE THE DOMAIN(4).)') TRIM(HPARNA),
+     2    VALR2
+          WRITE(6,*)'Domain:',VREAL(1),' <-> ',VREAL(NVALUE(IPAR))
+          CALL XABORT(HSMG)
+        ELSEIF((ITYPE.EQ.1).AND.(VALR1.GT.VALR2))THEN
+*         VALR1 > VALR2
+          WRITE(HSMG,'(23HACRRGR: REAL PARAMETER ,A,9H IS DEFIN,
+     1    7HED WITH,1P,E12.4,2H >,E12.4,4H.(2))') TRIM(HPARNA),
+     2    VALR1,VALR2
+          CALL XABORT(HSMG)
+        ENDIF
+        DEALLOCATE(VREAL)
+*----
+*  COMPUTE THE TERP FACTORS USING TABLE-OF-CONTENT INFORMATION.
+*----
+  260     CONTINUE
+          MIXC(NTOT)=IBMOLD
+          IF(IBMOLD.GT.NMIL)
+     1       CALL XABORT('ACRRGR: MIX OVERFLOW (APEX).')
+          IF(IMPY.GT.2) WRITE(6,'(32H ACRRGR: COMPUTE TERP FACTORS IN,
+     1    12H NEW MIXTURE,I5,1H.)') NTOT
+          NISO(NTOT)=NISOMI
+          LISO(NTOT)=LISOMI
+          LDELTA(NTOT)=LDELT1
+          DO ISO=1,NISOMI
+            HISO(NTOT,ISO)=HISOMI(ISO)
+            CONC(NTOT,ISO)=CONCMI(ISO)
+          ENDDO
+          DO JPAR=1,NPAR
+            MUPLT2(JPAR)=MUPLET(JPAR)
+          ENDDO
+          IF(IBTYP.EQ.3)THEN
+             IF(ZONEDP(ICH,JB).NE.0) THEN
+                CALL ACRTRP(IPAPX,LCUB2,IMPY,NPAR,NCAL,MUPLT2,MUTYPE,
+     1                      VALR(1,1),VARVAL,TERP(1,NTOT))
+             ELSE
+                TERP(:NCAL,NTOT)=0.0
+             ENDIF
+          ELSE
+             CALL ACRTRP(IPAPX,LCUB2,IMPY,NPAR,NCAL,MUPLT2,MUTYPE,
+     1                   VALR(1,1),VARVAL,TERP(1,NTOT))
+          ENDIF
+*         DELTA-ADD
+          DO 270 IPAR=1,NPAR
+            IF(LADD(IPAR))THEN
+              DO N=1,NDLTA(IPAR)
+                IDLTA1=IDLTA(IPAR,N)
+                DO JPAR=1,NPAR
+                  MUPLT2(JPAR)=MAPLET(JPAR,IDLTA1)
+                  MUTYP2(JPAR)=MATYPE(JPAR,IDLTA1)
+                ENDDO
+                DO JPAR=1,NPAR
+                  IF(MUTYP2(JPAR).LT.0)THEN
+                    MUPLT2(JPAR)=MUPLET(JPAR)
+                    MUTYP2(JPAR)=MUTYPE(JPAR)
+                    VALRA(JPAR,1,IDLTA1)=VALR(JPAR,1)
+                    VALRA(JPAR,2,IDLTA1)=VALR(JPAR,2)
+                  ENDIF
+                ENDDO
+                ALLOCATE(TERPA(NCAL))
+                CALL ACRTRP(IPAPX,LCUB2,IMPY,NPAR,NCAL,MUPLT2,MUTYP2,
+     1          VALRA(1,1,IDLTA1),VARVAL,TERPA(1))
+                DO 275 JCAL=1,NCAL
+                TERP(JCAL,NTOT)=TERP(JCAL,NTOT)+TERPA(JCAL)
+  275           CONTINUE
+                DEALLOCATE(TERPA)
+              ENDDO
+            ENDIF
+  270     CONTINUE
+        ENDIF
+  280   CONTINUE
+  285   CONTINUE
+        IF(NTOT.NE.NMIX) CALL XABORT('ACRRGR: ALGORITHM FAILURE.')
+        IBM=0
+      ELSEIF((TEXT24.EQ.'APEX').OR.(TEXT24.EQ.'TABLE').OR.
+     1   (TEXT24.EQ.'CHAIN').OR.(TEXT24.EQ.';')) THEN
+*----
+*  CHECK TERP FACTORS AND RETURN
+*----
+        IF(TEXT24.EQ.';') ITER=0
+        IF(TEXT24.EQ.'APEX') ITER=1
+        IF(TEXT24.EQ.'TABLE') ITER=2
+        IF(TEXT24.EQ.'CHAIN') ITER=3
+        DO 300 IBM=1,NMIX
+        IBMOLD=MIXC(IBM)
+        IF(IBMOLD.EQ.0) GO TO 300
+        IF(NISO(IBM).GT.MAXNIS) CALL XABORT('ACRRGR: MAXNIS OVERFLOW.')
+        IF(LDELTA(IBM)) THEN
+          SUM=0.0
+        ELSE
+          SUM=1.0
+        ENDIF
+        DO 290 ICAL=1,NCAL
+        SUM=SUM-TERP(ICAL,IBM)
+  290   CONTINUE
+        IF(ABS(SUM).GT.1.0E-4) THEN
+           WRITE(HSMG,'(43HACRRGR: INVALID INTERPOLATION FACTORS IN MI,
+     1     5HXTURE,I4,1H.)') IBM
+           CALL XABORT(HSMG)
+        ENDIF
+  300   CONTINUE
+        DEALLOCATE(NVALUE)
+*----
+*  EXIT MAIN LOOP OF THE SUBROUTINE
+*----
+        GO TO 310
+      ELSE
+        CALL XABORT('ACRRGR: '//TRIM(TEXT24)//' IS AN INVALID KEYWORD.')
+      ENDIF
+      GOTO 20
+*----
+*  PRINT INTERPOLATION (TERP) FACTORS
+*----
+  310 IF(IMPX.GT.2) THEN
+        WRITE(IOUT,'(/30H ACRRGR: INTERPOLATION FACTORS)')
+        DO ICAL=1,NCAL
+          DO IBM=1,NMIX
+            IF(TERP(ICAL,IBM).NE.0.0) THEN
+              WRITE(IOUT,320) ICAL,(TERP(ICAL,JBM),JBM=1,NMIX)
+              EXIT
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      IF(NPAR.GT.0) DEALLOCATE(PARFMT,PARKEY)
+      DEALLOCATE(HISOMI,HPAR,LDELTA,WPAR,BRN1,BRN0,ZONEC,ZONEDP,FMIX,
+     1 LPARM)
+      RETURN
+*
+  320 FORMAT(6H CALC=,I8,6H TERP=,1P,8E13.5/(20X,8E13.5))
+      END
diff --git a/Donjon/src/ACRSX2.f b/Donjon/src/ACRSX2.f
new file mode 100644
index 0000000..46b36eb
--- /dev/null
+++ b/Donjon/src/ACRSX2.f
@@ -0,0 +1,197 @@
+*DECK ACRSX2
+      SUBROUTINE ACRSX2(IPAPX,RECNAM,NREA,NGRP,NISOF,NISOP,NL,INDX,
+     1 NOMREA,B2APEX,FACT,WEIGHT,SPH,FLUXS,IREAF,LPURE,LXS,XS,SIGS,
+     2 SS2D,TAUXFI)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover the cross sections of an elementary calculation and single
+* mixture in an Apex file and perform multiparameter interpolation.
+*
+*Copyright:
+* Copyright (C) 2021 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): A. Hebert
+*
+*Parameters: input
+* IPAPX   pointer to the Apex file.
+* RECNAM  character identification of calculation.
+* NREA    number of reactions in the Apex file.
+* NGRP    number of energy groups.
+* NISOF   number of fissile isotopes.
+* NISOP   number of fission products.
+* NL      maximum Legendre order (NL=1 is for isotropic scattering).
+* INDX    position of isotopic set in current mixture (=-2: residual
+*         set; -1: total set; >0 isotope index).
+* NOMREA  names of reactions in the Apex file.
+* B2APEX  buckling as recovered from the Apex file
+* FACT   number density ratio for the isotope
+* WEIGHT  interpolation weight
+* SPH     SPH factors
+* FLUXS   averaged flux
+* IREAF   position of 'NUFI' reaction in NOMREA array
+* LPURE   =.true. if the interpolation is a pure linear interpolation 
+*         with TERP factors.
+*
+*Parameters: input/output
+* LXS     existence flag of each reaction.
+* XS      interpolated cross sections per reaction
+* SIGS    interpolated scattering cross sections
+* SS2D    interpolated scattering matrix
+* TAUXFI  interpolated fission rate
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      USE hdf5_wrap
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPAPX
+      CHARACTER RECNAM*80
+      INTEGER NREA,NGRP,NISOF,NISOP,NL,INDX,IREAF
+      REAL B2APEX,FACT,WEIGHT,SPH(NGRP),FLUXS(NGRP),SS2D(NGRP,NGRP,NL),
+     1 SIGS(NGRP,NL),XS(NGRP,NREA),TAUXFI
+      LOGICAL LXS(NREA),LPURE
+      CHARACTER NOMREA(NREA)*12
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER RANK,TYPE,NBYTE,DIMSR(5),IREA,IOF,IL,IGR,JGR
+      REAL TAUXF,XSECT
+      CHARACTER RECNAM2*80,RECNAM3*80
+      REAL, ALLOCATABLE, DIMENSION(:) :: WORK1D
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: WORK2D,SIGSB,XSB
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: WORK3D,SS2DB
+      REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: WORK4D
+*----
+*  FILL OUTPUT ARRAYS
+*----
+      ALLOCATE(SIGSB(NGRP,NL),SS2DB(NGRP,NGRP,NL),XSB(NGRP,NREA))
+      SIGSB(:NGRP,:NL)=0.0
+      SS2DB(:NGRP,:NGRP,:NL)=0.0
+      XSB(:NGRP,:NREA)=0.0
+      IOF=0
+      IF(INDX.EQ.-2) THEN
+        ! residual set
+        RECNAM2=TRIM(RECNAM)//"mac/RESIDUAL/"
+      ELSE IF(INDX.EQ.-1) THEN
+        ! total set
+        RECNAM2=TRIM(RECNAM)//"mac/TOTAL/"
+      ELSE IF((INDX.GE.1).AND.(INDX.LE.NISOF)) THEN
+        ! particularized fissile isotope set
+        IOF=0
+        RECNAM2=TRIM(RECNAM)//"mic/f.p./"
+      ELSE IF((INDX.GE.NISOF+1).AND.(INDX.LE.NISOF+NISOP)) THEN
+        ! particularized fission product set
+        IOF=NISOF
+        RECNAM2=TRIM(RECNAM)//"mic/fiss/"
+      ELSE IF(INDX.GE.NISOF+NISOP+1) THEN
+        ! particularized stable isotope set
+        IOF=NISOF+NISOP
+        RECNAM2=TRIM(RECNAM)//"mic/othe/"
+      ENDIF
+      DO IREA=1,NREA
+        RECNAM3=TRIM(RECNAM2)//NOMREA(IREA)
+        IF(NOMREA(IREA).EQ.'PROF') CYCLE
+        CALL hdf5_info(IPAPX,RECNAM3,RANK,TYPE,NBYTE,DIMSR)
+        IF(TYPE.NE.99) THEN
+          LXS(IREA)=.TRUE.
+          IF(NOMREA(IREA).EQ.'DIFF') THEN
+            IF(INDX.LT.0) THEN
+              CALL hdf5_read_data(IPAPX,RECNAM3,WORK2D)
+              SIGSB(:,:)=WORK2D(:,:)
+              DEALLOCATE(WORK2D)
+            ELSE
+              CALL hdf5_read_data(IPAPX,RECNAM3,WORK3D)
+              SIGSB(:,:)=WORK3D(:,:,INDX-IOF)
+              DEALLOCATE(WORK3D)
+            ENDIF
+          ELSE IF(NOMREA(IREA).EQ.'SCAT') THEN
+            IF(INDX.LT.0) THEN
+              CALL hdf5_read_data(IPAPX,RECNAM3,WORK3D)
+              SS2DB(:,:,:)=WORK3D(:,:,:)
+              DEALLOCATE(WORK3D)
+            ELSE
+              CALL hdf5_read_data(IPAPX,RECNAM3,WORK4D)
+              SS2DB(:,:,:)=WORK4D(:,:,:,INDX-IOF)
+              DEALLOCATE(WORK4D)
+            ENDIF
+            NL=SIZE(SS2DB,3)
+            DO IL=2,NL
+              SS2DB(:,:,IL)=SS2DB(:,:,IL)/REAL(2*IL-1)
+            ENDDO
+          ELSE
+            IF(INDX.LT.0) THEN
+              CALL hdf5_read_data(IPAPX,RECNAM3,WORK1D)
+              XSB(:,IREA)=WORK1D(:)
+              DEALLOCATE(WORK1D)
+            ELSE
+              CALL hdf5_read_data(IPAPX,RECNAM3,WORK2D)
+              XSB(:,IREA)=WORK2D(:,INDX-IOF)
+              DEALLOCATE(WORK2D)
+            ENDIF
+          ENDIF
+        ENDIF
+      ENDDO
+*----
+*  COMPUTE FISSION RATE FOR AN ELEMENTARY CALCULATION
+*----
+      TAUXF=0.0
+      IF(.NOT.LPURE.AND.(IREAF.GT.0)) THEN
+        DO IGR=1,NGRP
+          TAUXF=TAUXF+XSB(IGR,IREAF)*FLUXS(IGR)
+        ENDDO
+        TAUXFI=TAUXFI+WEIGHT*FACT*TAUXF
+      ENDIF
+*----
+*  WEIGHT MICROSCOPIC CROSS SECTION DATA IN AN INTERPOLATED MICROLIB
+*----
+      DO IGR=1,NGRP
+        DO IREA=1,NREA
+          IF(.NOT.LXS(IREA)) CYCLE
+          IF(LPURE.AND.NOMREA(IREA).EQ.'CHI') THEN
+            XS(IGR,IREA)=XS(IGR,IREA)+WEIGHT*XSB(IGR,IREA)
+          ELSE IF(NOMREA(IREA).EQ.'CHI') THEN
+            IF(IREAF.EQ.0) CALL XABORT('ACRSX2: IREAF=0.')
+            XS(IGR,IREA)=XS(IGR,IREA)+WEIGHT*FACT*TAUXF*XSB(IGR,IREA)
+          ELSE IF(NOMREA(IREA).EQ.'LEAK') THEN
+            IF(B2APEX.NE.0.0) THEN
+              XSECT=XSB(IGR,IREA)/B2APEX
+              XS(IGR,IREA)=XS(IGR,IREA)+SPH(IGR)*FACT*WEIGHT*XSECT
+            ENDIF
+          ELSE
+            XS(IGR,IREA)=XS(IGR,IREA)+FACT*SPH(IGR)*WEIGHT*XSB(IGR,IREA)
+          ENDIF
+        ENDDO
+        DO IL=1,NL
+          IF(MOD(IL,2).EQ.1) THEN
+            SIGS(IGR,IL)=SIGS(IGR,IL)+FACT*SPH(IGR)*WEIGHT*SIGSB(IGR,IL)
+          ELSE
+            DO JGR=1,NGRP
+              SIGS(IGR,IL)=SIGS(IGR,IL)+FACT*WEIGHT*SS2DB(JGR,IGR,IL)
+     1        /SPH(JGR)
+            ENDDO
+          ENDIF
+        ENDDO
+        DO JGR=1,NGRP
+          DO IL=1,NL
+            IF(MOD(IL,2).EQ.1) THEN
+              SS2D(IGR,JGR,IL)=SS2D(IGR,JGR,IL)+FACT*SPH(JGR)*WEIGHT*
+     1        SS2DB(IGR,JGR,IL)
+            ELSE
+              SS2D(IGR,JGR,IL)=SS2D(IGR,JGR,IL)+FACT*WEIGHT*
+     1        SS2DB(IGR,JGR,IL)/SPH(IGR)
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDDO
+      DEALLOCATE(XSB,SS2DB,SIGSB)
+      RETURN
+      END
diff --git a/Donjon/src/ACRTRP.f b/Donjon/src/ACRTRP.f
new file mode 100644
index 0000000..6a3e875
--- /dev/null
+++ b/Donjon/src/ACRTRP.f
@@ -0,0 +1,207 @@
+*DECK ACRTRP
+      SUBROUTINE ACRTRP(IPAPX,LCUB2,IMPX,NPAR,NCAL,MUPLET,MUTYPE,VALR,
+     1 VARVAL,TERP)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute the TERP interpolation/derivation/integration factors using
+* table-of-content information of the Apex file.
+*
+*Copyright:
+* Copyright (C) 2021 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPAPX   address of the multidimensional Apex file.
+* LCUB2   interpolation type for each parameter (=.TRUE.: cubic Ceschino
+*         interpolation; =.FALSE: linear Lagrange interpolation).
+* IMPX    print parameter (equal to zero for no print).
+* NPAR    number of global parameters.
+* NCAL    number of elementary calculations in the Apex file.
+* MUPLET  tuple used to identify an elementary calculation.
+* MUTYPE  type of interpolation (=1: interpolation; =2: delta-sigma).
+* VALR    real values of the interpolated point.
+* VARVAL  exit burnup used if MUTYPE(IPAR(ID))=3.
+*
+*Parameters: output
+* TERP    interpolation factors.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      USE hdf5_wrap
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER, PARAMETER::MAXPAR=50
+      TYPE(C_PTR) IPAPX
+      INTEGER IMPX,NPAR,NCAL,MUPLET(NPAR),MUTYPE(NPAR)
+      REAL VALR(2*MAXPAR,2),VARVAL,TERP(NCAL)
+      LOGICAL LCUB2(NPAR)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXDIM=10
+      INTEGER, PARAMETER::MAXVAL=200
+      INTEGER IPAR(MAXDIM),NVAL(MAXDIM),IDDIV(MAXDIM)
+      REAL BURN0, BURN1, DENOM, TERTMP
+      INTEGER I, ICAL, ID, IDTMP, IDTOT, JD, MAXNVP, NDELTA, NDIM,
+     1 NID, NTOT, NCRCAL
+      REAL T1D(MAXVAL,MAXDIM),WORK(MAXVAL)
+      CHARACTER HSMG*131,RECNAM*80
+      LOGICAL LCUBIC,LSINGL
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: NVALUE,JDEBAR,JARBVA
+      REAL, ALLOCATABLE, DIMENSION(:) :: TERPA,VREAL
+      CHARACTER(LEN=80), ALLOCATABLE, DIMENSION(:) :: PARNAM
+*----
+*  RECOVER TREE INFORMATION
+*----
+      CALL hdf5_read_data(IPAPX,"/paramtree/DEBTREE",JDEBAR)
+      CALL hdf5_read_data(IPAPX,"/paramtree/TREEVAL",JARBVA)
+      CALL hdf5_read_data(IPAPX,"/paramdescrip/NVALUE",NVALUE)
+*----
+*  COMPUTE TERP FACTORS
+*----
+      TERP(:NCAL)=0.0
+      IPAR(:MAXDIM)=0
+      NDIM=0
+      NDELTA=0
+      DO 10 I=1,NPAR
+        IF(MUPLET(I).EQ.-1) THEN
+          NDIM=NDIM+1
+          IF(MUTYPE(I).NE.1) NDELTA=NDELTA+1
+          IF(NDIM.GT.MAXDIM) THEN
+            WRITE(HSMG,'(7HACRTRP:,I4,29H-DIMENSIONAL INTERPOLATION NO,
+     1      14HT IMPLEMENTED.)') NDIM
+            CALL XABORT(HSMG)
+          ENDIF
+          IPAR(NDIM)=I
+        ENDIF
+   10 CONTINUE
+      IF(IMPX.GT.2) THEN
+        WRITE(IOUT,'(16H ACRTRP: MUPLET=,10I4/(16X,10I4))')
+     1  (MUPLET(I),I=1,NPAR)
+        WRITE(IOUT,'(8H ACRTRP:,I4,31H-DIMENSIONAL INTERPOLATION IN A,
+     1  9HPEX FILE.)') NDIM
+      ENDIF
+      IF(NDIM.EQ.0) THEN
+        ICAL=NCRCAL(1,MAXNVP,NPAR,JDEBAR,JARBVA,MUPLET)
+        IF(ICAL.GT.NCAL) CALL XABORT('ACRTRP: TERP OVERFLOW(1).')
+        IF(ICAL.EQ.0) GO TO 200
+        IF(ICAL.EQ.-1) GO TO 210
+        TERP(ICAL)=1.0
+      ELSE
+        NTOT=1
+        IDDIV(:MAXDIM)=1
+        DO 70 ID=1,NDIM
+        IF(IPAR(ID).LE.NPAR) THEN
+          WRITE(RECNAM,'(''paramvalues/PVAL'',I8)') IPAR(ID)
+          NID=NVALUE(IPAR(ID))
+        ELSE
+          CALL XABORT('ACRTRP: PARAMETER INDEX OVERFLOW.')
+        ENDIF
+        NTOT=NTOT*NID
+        DO 15 IDTMP=1,NDIM-ID
+        IDDIV(IDTMP)=IDDIV(IDTMP)*NID
+   15   CONTINUE
+        CALL hdf5_read_data(IPAPX,RECNAM,VREAL)
+        BURN0=VALR(IPAR(ID),1)
+        BURN1=VALR(IPAR(ID),2)
+        LSINGL=(BURN0.EQ.BURN1)
+        LCUBIC=LCUB2(IPAR(ID))
+        IF((MUTYPE(IPAR(ID)).EQ.1).AND.LSINGL) THEN
+          CALL ALTERP(LCUBIC,NID,VREAL,BURN0,.FALSE.,T1D(1,ID))
+        ELSE IF(MUTYPE(IPAR(ID)).EQ.1) THEN
+          IF(BURN0.GE.BURN1) CALL XABORT('ACRTRP: INVALID BURNUP'
+     1     //' LIMITS(1).')
+          CALL ALTERI(LCUBIC,NID,VREAL,BURN0,BURN1,T1D(1,ID))
+          DO 20 I=1,NID
+          T1D(I,ID)=T1D(I,ID)/(BURN1-BURN0)
+   20     CONTINUE
+        ELSE IF((MUTYPE(IPAR(ID)).EQ.2).AND.(.NOT.LSINGL)) THEN
+          CALL ALTERP(LCUBIC,NID,VREAL,BURN0,.FALSE.,WORK(1))
+          CALL ALTERP(LCUBIC,NID,VREAL,BURN1,.FALSE.,T1D(1,ID))
+          DO 30 I=1,NID
+          T1D(I,ID)=T1D(I,ID)-WORK(I)
+   30     CONTINUE
+        ELSE IF((MUTYPE(IPAR(ID)).EQ.2).AND.(LSINGL)) THEN
+          T1D(:NID,ID)=0.0
+        ELSE IF(MUTYPE(IPAR(ID)).EQ.3) THEN
+*          DERIVATIVE WITH RESPECT TO A SINGLE EXIT BURNUP. USE
+*          EQ.(3.3) OF RICHARD CHAMBON'S THESIS.
+          IF(BURN0.GE.BURN1) CALL XABORT('ACRTRP: INVALID BURNUP'
+     1    //' LIMITS(2).')
+          CALL hdf5_read_data(IPAPX,"/paramdescrip/PARNAM",PARNAM)
+          IF(PARNAM(IPAR(ID)).NE.'Burnup') THEN
+            CALL XABORT('ACRTRP: Burnup EXPECTED.')
+          ENDIF
+          DEALLOCATE(PARNAM)
+          ALLOCATE(TERPA(NID))
+          CALL ALTERI(LCUBIC,NID,VREAL,BURN0,BURN1,TERPA(1))
+          DO 40 I=1,NID
+          T1D(I,ID)=-TERPA(I)
+   40     CONTINUE
+          CALL ALTERP(LCUBIC,NID,VREAL,BURN0,.FALSE.,TERPA(1))
+          DO 50 I=1,NID
+          T1D(I,ID)=T1D(I,ID)-TERPA(I)*BURN0
+   50     CONTINUE
+          CALL ALTERP(LCUBIC,NID,VREAL,BURN1,.FALSE.,TERPA(1))
+          DENOM=VARVAL*(BURN1-BURN0)
+          DO 60 I=1,NID
+          T1D(I,ID)=(T1D(I,ID)+TERPA(I)*BURN1)/DENOM
+   60     CONTINUE
+          DEALLOCATE(TERPA)
+        ELSE
+          CALL XABORT('ACRTRP: INVALID OPTION.')
+        ENDIF
+        DEALLOCATE(VREAL)
+        NVAL(ID)=NID
+   70   CONTINUE
+
+* Example: NDIM=3, NVALUE=(3,2,2)
+* IDTOT 1  2  3  4  5  6  7  8  9 10 11 12
+* ID(1) 1  2  3  1  2  3  1  2  3  1  2  3
+* ID(2) 1  1  1  2  2  2  1  1  1  2  2  2
+* ID(3) 1  1  1  1  1  1  2  2  2  2  2  2
+* (NTOT=12, IDDIV=(6,3,1))
+        DO 100 IDTOT=1,NTOT               ! Ex.: IDTOT       = 9
+          TERTMP=1.0
+          IDTMP=IDTOT
+          DO 80 JD=1,NDIM                 ! Ex.: JD          = 1,2,3
+            ID=(IDTMP-1)/IDDIV(JD)+1      ! Ex.: ID(NDIM...1)= 2,1,3
+            IDTMP=IDTMP-(ID-1)*IDDIV(JD)  ! Ex.: IDTMP       = 3,3,1
+            MUPLET(IPAR(NDIM-JD+1))=ID
+            TERTMP=TERTMP*T1D(ID,NDIM-JD+1)
+   80     CONTINUE
+          ICAL=NCRCAL(1,MAXNVP,NPAR,JDEBAR,JARBVA,MUPLET)
+          IF(ICAL.GT.NCAL) CALL XABORT('ACRTRP: TERP OVERFLOW(2).')
+          IF(ICAL.EQ.0) GO TO 200
+          IF(ICAL.EQ.-1) GO TO 210
+          TERP(ICAL)=TERP(ICAL)+TERTMP
+  100   CONTINUE
+      ENDIF
+      IF(IMPX.GT.3) THEN
+        WRITE(IOUT,'(25H ACRTRP: TERP PARAMETERS:/(1X,1P,10E12.4))')
+     1  (TERP(I),I=1,NCAL)
+      ENDIF
+      DEALLOCATE(JARBVA,JDEBAR,NVALUE)
+      RETURN
+*----
+*  MISSING ELEMENTARY CALCULATION EXCEPTION.
+*----
+  200 WRITE(IOUT,'(16H ACRTRP: MUPLET=,10I4/(16X,10I4))')
+     1 (MUPLET(I),I=1,NPAR)
+      CALL XABORT('ACRTRP: MISSING ELEMENTARY CALCULATION.')
+  210 WRITE(IOUT,'(16H ACRTRP: MUPLET=,10I4/(16X,10I4))')
+     1 (MUPLET(I),I=1,NPAR)
+      WRITE(IOUT,'(9X,7HNVALUE=,10I4/(16X,10I4))') (NVALUE(I),I=1,NPAR)
+      CALL XABORT('ACRTRP: DEGENERATE ELEMENTARY CALCULATION.')
+      END
diff --git a/Donjon/src/AFM.f b/Donjon/src/AFM.f
new file mode 100644
index 0000000..a835024
--- /dev/null
+++ b/Donjon/src/AFM.f
@@ -0,0 +1,261 @@
+*DECK AFM
+      SUBROUTINE AFM(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Generate a macrolib using the AFM feedback model
+*
+*Copyright:
+* Copyright (C) 2002 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s):  
+* M.T. Sissaoui
+*
+*Update(s):
+*  E. Varin, B. Dionne
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Reference:
+* M. T. Sissaoui, G. Marleau and D. Rozon, "CANDU Reactor Simulations
+* Using the Feedback Model with Actinide Burnup History," Nucl.
+* Technology, 125, 197 (1999).
+*
+*Comments:
+* The AFM: calling specifications are:
+* MACRO := AFM: [ MACRO ] DBASE [ MAPFL ] :: (descafm) ;
+* where
+*   MACRO : name of the extended \emph{macrolib}
+*   DBASE : name of the \emph{database} object containing fuel properties with 
+*     respect to local parameters.
+*   MAPFL : name of the \emph{map} object containing fuel regions description 
+*     and burnupinformations. This file is only required when a \emph{MACRO is 
+*     created for fuel area.
+*   (descafm) : structure containing the data to module AFM:.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER (NSTATE=40) 
+      CHARACTER TEXT12*12,HSMG*131,HSIGN*12,TEXT*5,CTITRE*72,TINFO*72
+      LOGICAL LMCR,LMAP
+      DOUBLE PRECISION DFLOTT
+      INTEGER  IPAR(NSTATE),IDATA(NSTATE)
+      TYPE(C_PTR) IPLIST
+*
+      LMCR=.FALSE.
+      LMAP=.FALSE.
+      MSFT=0
+*
+* PARAMETER VALIDATION.
+      IF(NENTRY.LE.1) CALL XABORT('AFM: 2 PARAMETER EXPECTED.')
+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('AFM:'
+     1 //'  MACROLIB LINKED LIST OR XSM FILE EXPECTED AT LHS.')
+*
+      IF((IENTRY(2).NE.1).AND.(IENTRY(2).NE.2)) CALL XABORT('AFM:'
+     1 //' DATABASE LINKED LIST OR XSM FILE EXPECTED AT RHS.')
+      IF(JENTRY(2).NE.2) CALL XABORT('AFM: DATABASE IN READ-ONLY '
+     1 //'MODE EXPECTED AT RHS.')
+*
+      CALL REDGET (INDIC,NITMA,FLOTT,TEXT,DFLOTT)
+      IF(INDIC.NE.3) CALL XABORT('AFM: CHARACTER DATA EXPECTED.')
+      IF(TEXT.EQ.'MCR') THEN
+        LMCR=.TRUE.
+        WRITE(6,'(A37)') 'AFM: GENERATION OF A SINGLE MACROLIB'
+        CALL REDGET (INDIC,MXSH,FLOTT,TEXT,DFLOTT)
+        IF(INDIC.NE.1) CALL XABORT('AFM: INTEGER DATA EXPECTED.')
+      ELSEIF(TEXT.EQ.'MAP') THEN
+        LMAP=.TRUE.
+        IF((IENTRY(3).NE.1).AND.(IENTRY(3).NE.2)) CALL XABORT('AFM:'
+     1    //' FUEL MAP LINKED LIST OR XSM FILE EXPECTED AT RHS.')
+        IF(JENTRY(3).NE.2) CALL XABORT('AFM: COMPO IN READ-ONLY '
+     1    //'MODE EXPECTED AT RHS.')
+      ELSE
+         CALL XABORT('AFM: MAP OR MCR KEY WORD EXPECTED')
+      ENDIF
+*
+      ITYPE=JENTRY(1)
+      IPLIST=KENTRY(1)
+      MMIX=1
+*---------------------------------------------------------------*
+* CHECK THE SIGNTURE OF THE LINKED LIST OR XSM FILE
+      CALL LCMGTC(KENTRY(2),'SIGNATURE',12,HSIGN)
+      IF(HSIGN.NE.'REACTOR_XSDB') THEN
+         TEXT12=HENTRY(2)
+         CALL XABORT('AFM: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     1   '. REACTOR_XSDB EXPECTED.')
+      ENDIF
+*---------------------------------------------------------------*
+* IF L_MAP IS NOT AVAILABLE AFM GENERATE ONLY A TABLE
+      IF(LMAP) THEN
+        CALL LCMGTC(KENTRY(3),'SIGNATURE',12,HSIGN)
+        IF(HSIGN.NE.'L_MAP') THEN
+          TEXT12=HENTRY(3)
+          CALL XABORT('AFM: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     1   '. L_MAP EXPECTED.')
+        ENDIF
+        WRITE(6,'(A42)') 'AFM: GENARATION OF A MACROLIB USING L_MAP'
+      ENDIF
+*---------------------------------------------------------------*
+*        READ THE INFORMATION TITLE.
+      CALL REDGET (INDIC,NITMA,FLOTT,TEXT,DFLOTT)
+      IF(INDIC.NE.3) CALL XABORT('AFM: CHARACTER DATA EXPECTED.')
+      IF(TEXT.EQ.'INFOR') THEN
+         CALL REDGET(INDIC,NITMA,FLOTT,TINFO,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('AFM: CHARACTER DATA EXPECTED.')
+      ELSE
+          CALL XABORT('AFM:KEY WORD INFOR EXPECTED.')
+      ENDIF
+*
+* RECOVER SOME INFORMATIONS FROM THE DATABASE.
+      TEXT12='INFORMATION'
+      CALL LCMLEN(KENTRY(2),TEXT12,LENGT,ITYLCM)
+      IF(LENGT.GT.0) THEN
+        CALL LCMGTC(KENTRY(2),'INFORMATION',72,CTITRE)
+        WRITE(6,*)'INFORMATION TITLE ',TINFO
+*
+        IF(CTITRE.NE.TINFO) THEN
+            CALL XABORT('AFM: INCONSISTENT TITLES  '//CTITRE//
+     1      '  EXPECTED. INSTEAD OF ' //TINFO// ' ')
+        ENDIF
+      ELSE
+        CALL XABORT('AFM: DATA BASE TITLE IS NOT PROVIDED ')
+      ENDIF
+*---------------------------------------------------------------*
+*        CHECK THE NAMES OF THE DIFFERENTS DIRECTORIES
+      CALL REDGET (INDIC,NITMA,FLOTT,TEXT,DFLOTT)
+      IF(INDIC.NE.3) CALL XABORT('AFM: CHARACTER DATA EXPECTED.')
+      IF(TEXT.NE.'DNAME') CALL XABORT('AFM:KEY WORD DNAME EXPECTED.')
+      CALL REDGET(INDIC,NUT,FLOTT,TEXT,DFLOTT)
+      IF(INDIC.NE.1) CALL XABORT('AFM: INTEGER DATA EXPECTED.')
+      IF(NUT.GT.1.AND.LMCR) CALL XABORT('AFM: INVALID NUMBER.')
+      DO 100 IJ=1,NUT
+        CALL REDGET (INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3) CALL XABORT('AFM: CHARACTER DATA EXPECTED.')
+        CALL LCMLEN(KENTRY(2),TEXT12,LENGT,ITYLCM)
+        IF(LENGT.EQ.0) THEN
+           CALL XABORT('AFM: DATA NAME  '//TEXT12//
+     1        '  DO NOT EXIST ')
+         ENDIF
+ 100  CONTINUE
+*---------------------------------------------------------------*
+*     RECOVER SOME INFORMATIONS FROM DATABASE.
+*     TEXT12='SIGNATURE'
+      CALL LCMSIX(KENTRY(2),TEXT12,1)
+*     RECOVER THE TITLE.
+      CALL LCMLEN(KENTRY(2),'TITLE',LENGT,ITYLCM)
+      IF(LENGT.GT.0) THEN
+         CALL LCMGTC(KENTRY(2),'TITLE',72,CTITRE)
+      ELSE
+         CTITRE='*** NO TITLE PROVIDED ***'
+      ENDIF
+*     READ PARAMETERS DANS L_FBM 
+      CALL LCMGET(KENTRY(2),'PARAM',IPAR)
+      CALL LCMSIX(KENTRY(2),' ',2)
+      NGRP =IPAR(1)
+      NISO =IPAR(2)
+      NL   =IPAR(3)
+      NBURN=IPAR(4)
+      IXYZ =IPAR(5)
+*---------------------------------------------------------------*
+      IF(LMCR) THEN
+        NBCH=MXSH
+        NCCO=1
+        NCZO=1
+        ISC=4
+        MMIX=NBCH*NCCO
+        MSFT =0
+      ELSEIF (LMAP) THEN
+* RECOVER INFORMATIONS FROM L_MAP.
+*     READ PARAMETERS
+        CALL LCMGET(KENTRY(3),'STATE-VECTOR',IPAR)
+        NBCH =IPAR(1)
+        NCCO =IPAR(2)
+        NCZO =IPAR(3)
+        ISC  =IPAR(5)
+        MSFT =IPAR(6)
+        NPARM =IPAR(8)
+        MMIX=NBCH*NCCO
+C HISTORY PARAMETER
+        IF(IPAR(4).NE.NGRP) THEN
+            WRITE(HSMG,'(A40,I5,A18,I5)') 'AFM: INCONSISTENT NB OF '
+     1        //'GROUPS. IN MAP =',IPAR(4),' IN REACTOR_XSDB =',NGRP
+            CALL XABORT(HSMG)
+        ENDIF
+      ENDIF
+*  MSFT IS THE TOTAL NUMBER OF SHIFT
+      MNPS=MSFT+2
+*  READ THE INPUT DATA.
+*  TO USE THE SAME VECTOR TO GET THE REFERENCE LOCAL PARAMETER
+*      IF(NISO.LT.8) THEN
+*        NISM=8
+      IF(NISO.LT.7) THEN
+        NISM=7
+      ELSE
+        NISM=NISO
+      ENDIF
+      IF(ITYPE.NE.0) THEN
+         CALL LCMGET(IPLIST,'STATE-VECTOR',IDATA)
+         IF(NGRP.NE.IDATA(1)) CALL XABORT('WRONG NUMBER OF ENERGY'
+     1   //' GROUPS IN UPDATED MACROLIB')
+         IF(MMIX.NE.IDATA(2)) CALL XABORT('WRONG NUMBER OF MATER'
+     1   //'IAL MIXTURES IN UPDATED MACROLIB')
+         IF(NL.NE.IDATA(3)) CALL XABORT('WRONG ORDER OF ANISOTROPY'
+     1   //'IN UPDATED MACROLIB')
+      ENDIF
+*---------------------------------------------------------------*
+*        NTYP TYPE OF CROSS-SECTIONS CONSIDERED
+         NTYP=5+NL+IXYZ*2
+*---------------------------------------------------------------*
+*        DRIVER TO COMPUTE THE FEEDBACK COEFFICIENTS.
+*---------------------------------------------------------------*
+      CALL AFMDRV(KENTRY,NENTRY,NPARM,ITYPE,NBURN,NGRP,NISO,ISC,MNPS,
+     1 NL,ILEAK,NTYP,NBCH,NCCO,NCZO,NUT,CTITRE,LMCR,IXYZ,MMIX,MSFT,
+     2 NISM)
+*---------------------------------------------------------------*
+      IF(JENTRY(1).EQ.0) THEN
+        IDATA(:NSTATE)=0
+        HSIGN='L_MACROLIB'
+        CALL LCMPTC(IPLIST,'SIGNATURE',12,HSIGN)
+        IDATA(1)=NGRP
+        IDATA(2)=MMIX
+        IDATA(3)=NL
+        IDATA(4)=1
+        IDATA(9)=ILEAK
+        CALL LCMPUT(IPLIST,'STATE-VECTOR',NSTATE,1,IDATA)
+      ELSE
+        IDATA(1)=NGRP
+        IDATA(2)=MMIX
+        IDATA(3)=1
+        IDATA(4)=1
+        IDATA(9)=ILEAK
+        CALL LCMPUT(IPLIST,'STATE-VECTOR',NSTATE,1,IDATA)
+      ENDIF
+      RETURN
+      END
diff --git a/Donjon/src/AFMCPT.f b/Donjon/src/AFMCPT.f
new file mode 100644
index 0000000..5b697a7
--- /dev/null
+++ b/Donjon/src/AFMCPT.f
@@ -0,0 +1,467 @@
+*DECK AFMCPT
+      SUBROUTINE AFMCPT (KENTRY,NBURN,NGRP,NISO,NL,IMPX,
+     1 SMACB,XBORB,XPURB,XXENB,XT1FB,XT2FB,XT1CB,
+     1 XT2CB,XT1MB,XT2MB,XD1CB,XD2CB,XD1MB,XD2MB,
+     1 XSMB,XNP9B,XMFDB,XMMDB,XPF1B,XPF2B,XPF1LB,XPF2LB,
+     1 DENSITB,CPW1B,CPW2B,FLUXB,OVERVB,CHIB,
+     1 IJJ,NJJ,HISO,CTITRE,NMIX,SIGMA,NTYP,TF,TC,
+     1 TM,DC,DM,BOR,XEN,SM,RNP9,XI,TFR,TCR,TMR,XIR,
+     1 OVERV,FLUX,CHI,SCAT,MMIX,NPS,PW,XBRH,XBURN,
+     1 LTAV,IRAV,IDF,JTAB,IXYZ,ILIN)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute the cross sections
+*
+*Copyright:
+* Copyright (C) 1996 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* M.T. Sissaoui
+*
+*Parameters: input
+* KENTRY  address of the linked list or handle to the xsm file.
+* NGRP    number of energy groups.
+* NISO    number of extracted isotopes.
+* NL      number of Legendre orders (=1 for isotropic scattering).
+* NBURN   number of burnup steps.
+* NTYP    total number of cross sections type.
+* TF      fuel temperature.
+* TC      coolant temperature.
+* TM      moderator temperature.
+* DC      coolant density.
+* DM      moderator density.
+* BOR     Boron concentration.
+* XEN     Xenon concentration.
+* SM      Samarium concentration.
+* RNP9    Neptunium concentration.
+* XI      moderator purity.
+* NMIX    mixture number.
+* NPS     NPS-2 power shift.
+* IXYZ    type of diffusion coefficient (=0: isotropic; =1: directional)
+*
+*Parameters: 
+* IMPX     
+* SMACB    
+* XBORB    
+* XPURB    
+* XXENB    
+* XT1FB    
+* XT2FB    
+* XT1CB    
+* XT2CB    
+* XT1MB    
+* XT2MB    
+* XD1CB    
+* XD2CB    
+* XD1MB    
+* XD2MB    
+* XSMB     
+* XNP9B    
+* XMFDB    
+* XMMDB    
+* XPF1B    
+* XPF2B    
+* XPF1LB   
+* XPF2LB   
+* DENSITB  
+* CPW1B    
+* CPW2B    
+* FLUXB    
+* OVERVB   
+* CHIB     
+* IJJ      
+* NJJ      
+* HISO     
+* CTITRE   
+* SIGMA    
+* TFR      
+* TCR      
+* TMR      
+* XIR      
+* OVERV      
+* FLUX       
+* CHI        
+* SCAT       
+* MMIX       
+* PW           
+* XBRH     
+* XBURN    
+* LTAV     
+* IRAV     
+* IDF      
+* JTAB     
+* ILIN     
+*
+*-----------------------------------------------------------------------
+*
+      CHARACTER HMICRO*12,CTITRE*72
+      LOGICAL LTAV
+      DOUBLE PRECISION XCOF(3)
+      REAL CPF1(3)
+      DIMENSION KENTRY(*),
+     1 SMACB(NGRP*NGRP,NTYP,NISO,NBURN,*),
+     1 XBORB(NGRP*NGRP,NTYP,NISO,NBURN,*),
+     1 XXENB(NGRP*NGRP,NTYP,NISO,NBURN,*),
+     1 XT1FB(NGRP*NGRP,NTYP,NISO,NBURN,*),
+     1 XT2FB(NGRP*NGRP,NTYP,NISO,NBURN,*),
+     1 XT1CB(NGRP*NGRP,NTYP,NISO,NBURN,*),
+     1 XT2CB(NGRP*NGRP,NTYP,NISO,NBURN,*),
+     1 XT1MB(NGRP*NGRP,NTYP,NISO,NBURN,*),
+     1 XT2MB(NGRP*NGRP,NTYP,NISO,NBURN,*),
+     1 XD1CB(NGRP*NGRP,NTYP,NISO,NBURN,*),
+     1 XD2CB(NGRP*NGRP,NTYP,NISO,NBURN,*),
+     1 XD1MB(NGRP*NGRP,NTYP,NISO,NBURN,*),
+     1 XD2MB(NGRP*NGRP,NTYP,NISO,NBURN,*),
+     1 XSMB(NGRP*NGRP,NTYP,NISO,NBURN,*),
+     1 XNP9B(NGRP*NGRP,NTYP,NISO,NBURN,*),
+     1 XMFDB(NGRP*NGRP,NTYP,NISO,NBURN,*),
+     1 XMMDB(NGRP*NGRP,NTYP,NISO,NBURN,*),
+     1 XPF1B(NGRP*NGRP,NTYP,NISO,NBURN,*),
+     1 XPF2B(NGRP*NGRP,NTYP,NISO,NBURN,*),
+     1 XPF1LB(NGRP*NGRP,NTYP,NISO,NBURN,*),
+     1 XPF2LB(NGRP*NGRP,NTYP,NISO,NBURN,*),
+     1 XPURB(NGRP*NGRP,NTYP,NISO,NBURN,*),
+     1 DENSITB(NISO,NBURN,*),CPW1B(2,NBURN,*),
+     1 CPW2B(2,NBURN,*),FLUXB(NGRP,NBURN,*),
+     1 CHIB(NGRP,NBURN,*),OVERVB(NGRP,NBURN,*),
+     2 HISO(*),JTAB(*),
+     6 ELMT(3),PW(*),
+     7 SIGMA(MMIX,NGRP,NTYP),XBRH(*),
+     8 OVERV(MMIX,*),FLUX(MMIX,*),
+     7 CHI(MMIX,*),SCAT(MMIX,NL,NGRP,*),
+     1 XBURN(NBURN,*),NJJ(*),IJJ(*)
+      REAL, ALLOCATABLE, DIMENSION(:) :: DEL
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: CPW1,CPW2
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: SMAC
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(SMAC(NGRP*NGRP,NTYP,NISO),DEL(NISO),CPW1(3,NPS),
+     1 CPW2(3,NPS))
+*
+*     Remove warning for uninitialized variable
+      ISOB=0
+      D2MB=0.0
+      D2CB=0.0
+      D1M=0.0
+      D2C=0.0
+      CX=0.0
+      CSM=0.0
+      D1C=0.0
+      D2M=0.0
+      CNP9=0.0
+      CB=0.0
+      PUR=0.0
+*---------------------------------------------------------------*
+      IF(NBURN.EQ.0) CALL XABORT('AFMCPT: ZERO NUMBER OF MIXTURES.')
+      IF(NGRP.EQ.0) CALL XABORT('AFMCPT: ZERO NUMBER OF GROUPS.')
+*---------------------------------------------------------------*
+      NG2=NGRP*NGRP
+      NTM=4+2*IXYZ
+      IF(IMPX.GT.5) THEN
+         WRITE(6,'(9H AFMCPT: ,A)') CTITRE
+         WRITE(6,*) ' NTYP ',NTYP
+      ENDIF
+      XECON=0.0
+      TFAV=0.0
+      DCAV=0.0
+      CPF2=0.0
+      CF=0.0
+      DO 81 ISO=1,NISO
+       DO 80 ITY=1,NTYP
+        DO 79 IGR=1,NG2
+          SMAC(IGR,ITY,ISO)=0.0
+ 79     CONTINUE
+ 80    CONTINUE
+ 81   CONTINUE
+      DO 82 IGR=1,NGRP
+         FLUX(NMIX,IGR)=0.0
+         OVERV(NMIX,IGR)=0.0
+         CHI(NMIX,IGR)=0.0
+ 82   CONTINUE
+      DO 161 ISO=1,NISO
+         DEL(ISO)=0.0
+ 161  CONTINUE
+      DO 73 II=1,3
+         XCOF(II)=0.0D0
+         ELMT(II)=0.0
+         CPF1(II)=0.0
+ 73   CONTINUE
+      DO 74 K=1,NPS
+         DO II=1,3
+            CPW1(II,K)=0.0
+            CPW2(II,K)=0.0
+         ENDDO
+ 74   CONTINUE
+*
+      PREF=PW(1)
+      IPFBM=KENTRY(2)
+*---------------------------------------------------------------*
+*     COMPUTE THE HISTORY COEFFICIENTS
+      NPSX=NPS+NPS-1
+      DO 101 K=2,NPSX
+* XSECTION FOR SNAP-SHOT OR (TIME AVERAGE-HOMOG.)
+        IF(LTAV) THEN
+          IRMAX=IRAV
+          IRMIN=IRAV
+          XCOF(1)=1.0D0
+        ELSE
+*
+          IF(K.GT.NPS) THEN
+            XIRAD=XBRH(K-NPS+1)
+          ELSE
+            XIRAD=XBRH(NPS)-XBRH(K-1)
+          ENDIF
+           CALL AFMLOC(NBURN,NTP,XIRAD,XIRAD,XBURN(1,IDF),
+     1                IRMAX,IRMIN,XCOF,ILIN)
+        ENDIF
+*
+* INTERPOLATE THE HISTORY COEFFICIENTS
+        IH=0
+        DO 910 I = IRMIN,IRMAX
+          IH=IH+1
+          IF(K.LE.NPS) THEN
+            IF(PW(K).GT.PREF) THEN
+              CPW1(IH,K)=CPW1B(1,I,IDF) + CPW1(IH,K)
+              CPW2(IH,K)=CPW2B(1,I,IDF) + CPW2(IH,K)
+            ELSE
+              CPW1(IH,K)=CPW1B(2,I,IDF) + CPW1(IH,K)
+              CPW2(IH,K)=CPW2B(2,I,IDF) + CPW2(IH,K)
+            ENDIF
+*
+            IF(K.GT.2) THEN
+               IF(PW(K-1).GT.PREF) THEN
+                 CPW1(IH,K-1)=-CPW1B(1,I,IDF) + CPW1(IH,K-1)
+                 CPW2(IH,K-1)=-CPW2B(1,I,IDF) + CPW2(IH,K-1)
+               ELSE
+                 CPW1(IH,K-1)=-CPW1B(2,I,IDF) + CPW1(IH,K-1)
+                 CPW2(IH,K-1)=-CPW2B(2,I,IDF) + CPW2(IH,K-1)
+               ENDIF
+            ENDIF
+          ENDIF
+ 910    CONTINUE
+ 101  CONTINUE
+*
+      YF=0.0
+      DO 111 K=2,NPS
+        IF(K.EQ.2) THEN
+* CORRECTE THE STURATING PSEUDO-FISSILE ISOTOPE
+          IF(PW(K).GT.PREF) THEN
+            XPW=ALOG(PW(K)/PW(1))
+            XPWM=1.0/PW(K)-1.0/PW(1)
+            YF=0.0
+          ELSE
+            XPW=PW(K)-PW(1)
+            XPWM=(PW(K)-PW(1))**2
+            YF=1.0
+          ENDIF
+          DO IH=1,3
+          CPF1(IH)=CPF1(IH) +CPW1(IH,K)*XPW + CPW2(IH,K)*XPWM
+          ENDDO
+C
+        ELSE
+          IF(PW(K).GT.PREF) THEN
+            XPW=ALOG(PW(K)/PW(1))
+            XPWM=1.0/PW(K)-1.0/PW(1)
+          ELSE
+            XPW=PW(K)-PW(1)
+            XPWM=(PW(K)-PW(1))**2
+C
+          ENDIF
+          DO IH=1,3
+          CPF1(IH)=CPF1(IH) +CPW1(IH,K)*XPW + CPW2(IH,K)*XPWM
+          ENDDO
+        ENDIF
+ 111  CONTINUE
+*---------------------------------------------------------------*
+*         COMPUTE THE DEVIATION OF THE PSEUDO-ISOTOPE
+*         CPF1 AND CPF2
+*      CPF2=CPF1*CPF1
+*---------------------------------------------------------------*
+*  APPLY  THE FEEDBACK MODEL
+      T1F=SQRT(TF)-SQRT(TFR)
+      T2F=TF-TFR
+      T1C=ALOG(TC/TCR)
+      T2C=1.0/TC - 1.0/TCR
+      T1M=ALOG(TM/TMR)
+      T2M=1.0/TM - 1.0/TMR
+*
+* RECOVER LOCAL PARAMETER COEFFICIENT AND X-SECTIONS
+      II=0
+      DMOD=0.0
+      DO 900 I = IRMIN,IRMAX
+        II=II+1
+        RXCOEF=REAL(XCOF(II))
+        DO 249 IGR=1,NGRP
+          FLUX(NMIX,IGR)=FLUX(NMIX,IGR)+RXCOEF*FLUXB(IGR,I,IDF)
+          OVERV(NMIX,IGR)=OVERV(NMIX,IGR)+RXCOEF*OVERVB(IGR,I,IDF)
+ 249    CONTINUE
+* COMPUTE DELTA-CONCENTRATION
+        DO 49 ISO=1,NISO
+          IF(DENSITB(ISO,I,IDF).EQ.0.0) GO TO 49
+          WRITE(HMICRO,'(3A4)') (HISO((ISO-1)*3+IH),IH=1,3)
+          IF(HMICRO.EQ.'XE135') THEN
+            DEL(ISO)=XEN/(IRMAX-IRMIN+1)-DENSITB(ISO,I,IDF)*RXCOEF
+     1               +DEL(ISO)
+            CX=DEL(ISO)
+          ELSE IF(HMICRO.EQ.'BMOD') THEN
+            ISOB=ISO
+*
+*         ERROR IN CALCULATING BORON CONCENTRATION,
+*         BUT ADEQUATELY APPROXIMATED IF THE BORON REF EQ 0.0ppm
+*             
+*            DEL(ISO)=BOR/(IRMAX-IRMIN+1)-
+*     1               DENSITB(ISO,I,IDF)*RXCOEF+DEL(ISO)
+            DEL(ISO)=-DENSITB(ISO,I,IDF)*RXCOEF+DEL(ISO)
+            CB=DEL(ISO)
+          ELSE IF(HMICRO.EQ.'CWAT') THEN
+            DEL(ISO)=(DC-1.0)*DENSITB(ISO,I,IDF)
+            D1C=DEL(ISO)
+            D2C=D1C*D1C
+            D2CB=D1C*D1C
+          ELSE IF(HMICRO.EQ.'MWAT') THEN
+            DMOD=DENSITB(ISO,I,IDF)/(IRMAX-IRMIN+1)+DMOD
+            DEL(ISO)=(DM-1.0)*DENSITB(ISO,I,IDF)
+            D1M=ALOG(DM)
+            D2M=1.0/(DM*DENSITB(ISO,I,IDF)) - 1.0/DENSITB(ISO,I,IDF)
+            D2MB=DEL(ISO)
+*         PURITY
+            PUR=(XI-XIR)*DM*DENSITB(ISO,I,IDF)
+          ELSE IF(HMICRO.EQ.'SM149') THEN
+            DEL(ISO)=SM/(IRMAX-IRMIN+1)-DENSITB(ISO,I,IDF)*RXCOEF
+     1               +DEL(ISO)
+            CSM=DEL(ISO)
+          ELSE IF(HMICRO.EQ.'NP239') THEN
+            DEL(ISO)=RNP9/(IRMAX-IRMIN+1)-DENSITB(ISO,I,IDF)*RXCOEF
+     1               +DEL(ISO)
+            CNP9=DEL(ISO)
+          ELSE IF(HMICRO.EQ.'FPC') THEN
+*
+            CF= CF+DENSITB(ISO,I,IDF)*RXCOEF
+            DEL(ISO)=CPF1(II)*RXCOEF+DEL(ISO)
+          ELSE IF(HMICRO.EQ.'MACR') THEN
+            DEL(ISO)=DENSITB(ISO,I,IDF)
+            DO 271 IGR=1,NGRP
+              CHI(NMIX,IGR)=CHIB(IGR,I,IDF)*RXCOEF+CHI(NMIX,IGR)
+  271       CONTINUE
+          ENDIF
+   49   CONTINUE
+  900 CONTINUE
+* R.C. 24/05/2011
+* boron unit correction
+*    Bnat = 10.811  g/mol
+*    O16  = 15.9949 g/mol
+*    H1   =  1.0078 g/mol
+*    D2   =  2.0141 g/mol
+      CB=DMOD*BOR/10.811*((1.0078*(1-XI)+2.0141*XI)*2+15.9949)/3+CB
+      CB=CB*DM
+      DEL(ISOB)=CB
+* R.C.
+*  CORRECT THE FUEL TEMPERATURE
+      CQ=REAL((CPF1(1)*XCOF(1)+CPF1(2)*XCOF(2)+CPF1(3)*XCOF(3)+CF)/CF)
+      RCQ=1.0-CQ
+      CQ2=CQ*CQ
+      RCQ2=1.0-CQ2
+      IF(JTAB(1).EQ.0) THEN
+        CQ=0.0
+        RCQ=0.0
+        CQ2=0.0
+        RCQ2=0.0
+        CX=0.0
+        CSM=0.0
+        CNP9=0.0
+        D1C=0.0
+        D2C=0.0
+        D2CB=0.0
+        T1F=0.0
+        T2F=0.0
+        T1C=0.0
+        T2C=0.0
+      ENDIF
+*
+* RECOVER MACROSCOPIC X-SECTIONS
+      II=0
+      DO 901 I = IRMIN,IRMAX
+        II=II+1
+        RXCOEF=REAL(XCOF(II))
+        CPF2=CPF1(II)*CPF1(II)
+        DO 98 ISO=1,NISO
+         DO 99  ITY=1,NTYP
+           IF(ISO.EQ.1) THEN
+             ZZ=1.0
+             IF(ITY.EQ.1) THEN
+               VD2M=D2MB
+               VD2C=D2CB
+             ELSE IF(ITY.GE.5) THEN
+               VD2M=D2MB
+               VD2C=D2C
+             ELSE
+               VD2M=D2M
+               VD2C=D2C
+             ENDIF
+           ELSE
+             ZZ=0.0
+             VD2M=D2M
+             VD2C=D2C
+           ENDIF
+           DO 100 IGR=1,NG2
+             SMAC(IGR,ITY,1)=SMAC(IGR,ITY,1)+
+     1        SMACB(IGR,ITY,1,I,IDF)*RXCOEF*ZZ+
+     1       (XBORB(IGR,ITY,ISO,I,IDF)*RXCOEF*CB +
+     1       XPURB(IGR,ITY,ISO,I,IDF)*RXCOEF*PUR*ZZ +
+     1       XXENB(IGR,ITY,ISO,I,IDF)*RXCOEF*CX +
+     1       XT1FB(IGR,ITY,ISO,I,IDF)*RXCOEF*T1F*CQ +
+     1       XT1FB(IGR,ITY,ISO,1,IDF)*RXCOEF*T1F*RCQ +
+     1       XT2FB(IGR,ITY,ISO,I,IDF)*RXCOEF*T2F*CQ2 +
+     1       XT2FB(IGR,ITY,ISO,1,IDF)*RXCOEF*T2F*RCQ2 +
+     1       XT1CB(IGR,ITY,ISO,I,IDF)*RXCOEF*T1C +
+     1       XT2CB(IGR,ITY,ISO,I,IDF)*RXCOEF*T2C +
+     1       XT1MB(IGR,ITY,ISO,I,IDF)*RXCOEF*T1M +
+     1       XT2MB(IGR,ITY,ISO,I,IDF)*RXCOEF*T2M +
+     1       XD1CB(IGR,ITY,ISO,I,IDF)*RXCOEF*D1C +
+     1       XD2CB(IGR,ITY,ISO,I,IDF)*RXCOEF*VD2C +
+     1       XD1MB(IGR,ITY,ISO,I,IDF)*RXCOEF*D1M +
+     1       XD2MB(IGR,ITY,ISO,I,IDF)*RXCOEF*VD2M +
+     1       XSMB(IGR,ITY,ISO,I,IDF)*RXCOEF*CSM +
+     1       XNP9B(IGR,ITY,ISO,I,IDF)*RXCOEF*CNP9 +
+     1       XMFDB(IGR,ITY,ISO,I,IDF)*RXCOEF*T1F*D1C +
+     1       XMMDB(IGR,ITY,ISO,I,IDF)*RXCOEF*T1C*D1C +
+     1       XPF1B(IGR,ITY,ISO,I,IDF)*RXCOEF*CPF1(II)*(1.-YF) +
+     1       XPF2B(IGR,ITY,ISO,I,IDF)*RXCOEF*CPF2*(1.-YF)+
+     1       XPF1LB(IGR,ITY,ISO,I,IDF)*RXCOEF*CPF1(II)*YF +
+     1       XPF2LB(IGR,ITY,ISO,I,IDF)*RXCOEF*CPF2*YF)*DEL(ISO)
+*
+ 100       CONTINUE
+  99     CONTINUE
+  98    CONTINUE
+ 901   CONTINUE
+* STORE SCATTERING
+       IL= 1
+       ITY=5+2*IXYZ+IL
+       IGAR=0
+       DO 130 JGR=1,NGRP
+          DO 120 IGR=IJJ(JGR),IJJ(JGR)-NJJ(JGR)+1,-1
+            IGAR=IGAR+1
+            SCAT(NMIX,IL,IGR,JGR)=SMAC(IGAR,ITY,1)
+* TOTAL OR ABS
+            SMAC(IGR,2,1)=SMAC(IGR,2,1)+SCAT(NMIX,IL,IGR,JGR)
+ 120     CONTINUE
+ 130  CONTINUE
+* STORE X-SECTIONS
+      DO 261 ITY=1,NTYP
+        DO 260 IGR=1,NGRP
+          SIGMA(NMIX,IGR,ITY)=SMAC(IGR,ITY,1)
+ 260    CONTINUE
+ 261  CONTINUE
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(CPW2,CPW1,DEL,SMAC)
+      RETURN
+      END
diff --git a/Donjon/src/AFMDRV.f b/Donjon/src/AFMDRV.f
new file mode 100644
index 0000000..35b3ec7
--- /dev/null
+++ b/Donjon/src/AFMDRV.f
@@ -0,0 +1,1407 @@
+*DECK AFMDRV
+      SUBROUTINE AFMDRV (KENTRY,NENTRY,NPARM,ITYPE,NBURN,NGRP,NISO,ISC,
+     1 MNPS,NL,ILEAK,NTYP,NBCH,NCCO,NCZO,NUT,CTITRE,LMCR,IXYZ,MMIX,MSFT,
+     2 NISM)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Driver to generate a macrolib using fbm
+*
+*Copyright:
+* Copyright (C) 2002 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* M.T. Sissaoui
+*
+*Update(s):
+*  E. Varin 28/03/00, B. Dionne 26/02/01, 
+*  A. Lagarrigue 30/07/05
+*  A. Hebert 11/11/11 (remove table support)
+*
+*Parameters: input
+* KENTRY  address of the LCM objects
+* NENTRY  number of LCM objects
+* NPARM   number of parameters in L_MAP object
+* ITYPE   creation/modification flag for output macrolib
+* NBURN   number of burnup steps
+* NGRP    1+number of energy groups
+* NISO    number of extracted isotopes
+* ISC     type of cross-section calculation (=1: time average;
+*         =2: instantaneous; =3: homogeneous)
+* MNPS    number of shifts + 2
+* NL      number of legendre orders (=1 for isotropic scattering)
+* ILEAK   type of leakage
+* NTYP
+* NBCH    number of bundles per channel
+* NCCO    number of channels in the core
+* NCZO    number of combustion zones
+* NUT     number of fuel types
+* CTITRE  character*72 title
+* LMCR    if true, create a macrolib containing only one non-zero
+*         mixture
+* IXYZ    type of diffusion coefficient (=0: isotropic; =1: directional)
+* MMIX    number of mixtures in the output macrolib
+* MSFT    second dimension of BSFT and PSFT
+* NISM
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) KENTRY(NENTRY)
+      INTEGER NPARM,ITYPE,NBURN,NGRP,NISO,ISC,MNPS,NL,ILEAK,NTYP,NBCH,
+     1 NCCO,NCZO,NUT,IXYZ,MMIX,MSFT,NISM
+      CHARACTER*72 CTITRE
+      LOGICAL LMCR
+*----
+*  LOCAL VARIABLES
+*----
+      CHARACTER TEXTR*12,CM*2,TEXT4*5,HMICRO*12,TEXTB*12,TEXTD*12
+      TYPE(C_PTR) IPMACX,JPMAC,KPMAC,IPFBM,IPMAP,JPMAP,KPMAP
+      DOUBLE PRECISION DFLOTT,XCOF(3)
+      REAL  STORE,RLOC(7)
+      LOGICAL LNOMP,LTAV,LXENON,LSAM,LNEP,LXEREF,LNEREF,LTFUEL,LDRAH,
+     1 LTCOOL,LDCOOL,LPWF,LINI
+      CHARACTER PNAME*12,PARKEY*12
+      INTEGER, DIMENSION(:), ALLOCATABLE :: IPOS,IJ,IZONE,IWORK,NJ,
+     1 HISO,JTAB,INDEX,KTYP,ISFT,ITEXTR
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: IJJ,NJJ
+      REAL, DIMENSION(:), ALLOCATABLE :: VOL,ENER,WORK,BURBG,BURED,
+     1 POWER,PW,BRH,XSIGF,XSIGX,XFLUN,PDCOOL,PTCOOL,PTFUEL,SSCAT
+      REAL, DIMENSION(:,:), ALLOCATABLE :: XBURN,OVERV,SIGS,FLUX,CHI,
+     1 DIFFX,DIFFY,DIFFZ,FLUAV,BFLUX,BSFT,PSFT
+      REAL, DIMENSION(:,:,:), ALLOCATABLE :: SIGMA,SIGAV,DENSITB,HXEN1,
+     1 HXEN2,HSAM1,HSAM2,HNEP1,HNEP2,CPW1B,CPW2B,FLUXB,CHIB,OVERVB
+      REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: SCAT,SCATAV
+      REAL, DIMENSION(:,:,:,:,:), ALLOCATABLE :: SMACB,XBORB,XXENB,
+     1 XT1FB,XT2FB,XT1CB,XT2CB,XT1MB,XT2MB,XD1CB,XD2CB,XD1MB,XD2MB,
+     2 XSMB,XNP9B,XMFDB,XMMDB,XPF1B,XPF2B,XPF1LB,XPF2LB,XPURB
+      DOUBLE PRECISION XDRCST,EVJ
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(SIGMA(MMIX,NGRP,NTYP),IJJ(MMIX,NL,NGRP),VOL(MMIX),
+     1 NJJ(MMIX,NL,NGRP),XBURN(NBURN,NUT),OVERV(MMIX,NGRP),
+     2 SIGS(MMIX,NGRP),FLUX(MMIX,NGRP),CHI(MMIX,NGRP),ENER(NGRP+1),
+     3 IPOS(MMIX),SCAT(MMIX,NL,NGRP,NGRP),DIFFX(MMIX,NGRP),
+     4 DIFFY(MMIX,NGRP),DIFFZ(MMIX,NGRP),IJ(NGRP),WORK(MMIX*NGRP*NBURN),
+     5 IZONE(NCCO),BURBG(MMIX),BURED(MMIX),POWER(MMIX),
+     6 FLUAV(NBURN,NGRP),SIGAV(NBURN,NGRP,NTYP),IWORK(MMIX*NGRP),
+     7 SCATAV(NBURN,NL,NGRP,NGRP),PW(MNPS),BRH(MNPS),NJ(NGRP),
+     8 BFLUX(NGRP,MMIX),DENSITB(NISO,NBURN,NUT),HISO(3*NISM),
+     9 HXEN1(2,NBURN,NUT),HXEN2(2,NBURN,NUT),HSAM1(2,NBURN,NUT),
+     1 HSAM2(2,NBURN,NUT),HNEP1(2,NBURN,NUT),HNEP2(2,NBURN,NUT),
+     2 CPW1B(2,NBURN,NUT),CPW2B(2,NBURN,NUT),FLUXB(NGRP,NBURN,NUT),
+     3 JTAB(NISO),CHIB(NGRP,NBURN,NUT),OVERVB(NGRP,NBURN,NUT),
+     4 INDEX(MMIX),KTYP(NUT),XSIGF(NGRP),XSIGX(NGRP),XFLUN(NGRP),
+     5 BSFT(MMIX,MSFT),PSFT(MMIX,MSFT),ISFT(MMIX),PDCOOL(MMIX),
+     6 PTCOOL(MMIX),PTFUEL(MMIX),ITEXTR(3*NUT))
+       ALLOCATE(SMACB(NGRP*NGRP,NTYP,NISO,NBURN,NUT),
+     1          XBORB(NGRP*NGRP,NTYP,NISO,NBURN,NUT),
+     2          XXENB(NGRP*NGRP,NTYP,NISO,NBURN,NUT),
+     3          XT1FB(NGRP*NGRP,NTYP,NISO,NBURN,NUT),
+     4          XT2FB(NGRP*NGRP,NTYP,NISO,NBURN,NUT),
+     5          XT1CB(NGRP*NGRP,NTYP,NISO,NBURN,NUT),
+     6          XT2CB(NGRP*NGRP,NTYP,NISO,NBURN,NUT),
+     7          XT1MB(NGRP*NGRP,NTYP,NISO,NBURN,NUT),
+     8          XT2MB(NGRP*NGRP,NTYP,NISO,NBURN,NUT),
+     9          XD1CB(NGRP*NGRP,NTYP,NISO,NBURN,NUT),
+     1          XD2CB(NGRP*NGRP,NTYP,NISO,NBURN,NUT),
+     2          XD1MB(NGRP*NGRP,NTYP,NISO,NBURN,NUT),
+     3          XD2MB(NGRP*NGRP,NTYP,NISO,NBURN,NUT),
+     4          XSMB(NGRP*NGRP,NTYP,NISO,NBURN,NUT),
+     5          XNP9B(NGRP*NGRP,NTYP,NISO,NBURN,NUT),
+     6          XMFDB(NGRP*NGRP,NTYP,NISO,NBURN,NUT),
+     7          XMMDB(NGRP*NGRP,NTYP,NISO,NBURN,NUT),
+     8          XPF1B(NGRP*NGRP,NTYP,NISO,NBURN,NUT),
+     9          XPF2B(NGRP*NGRP,NTYP,NISO,NBURN,NUT),
+     1          XPF1LB(NGRP*NGRP,NTYP,NISO,NBURN,NUT),
+     2          XPF2LB(NGRP*NGRP,NTYP,NISO,NBURN,NUT),
+     3          XPURB(NGRP*NGRP,NTYP,NISO,NBURN,NUT))
+*
+      EVJ=XDRCST('eV','J')
+      IPMACX=KENTRY(1)
+      IPFBM=KENTRY(2)
+      IF( .NOT.LMCR )IPMAP=KENTRY(3)
+      CALL LCMLIB(IPMAP)
+*---------------------------------------------------------------*
+*      SET THE DEFAULT OPTIONS
+      LNOMP=.FALSE.
+      LTAV=.FALSE.
+      LXENON=.FALSE.
+      LSAM=.FALSE.
+      LNEP=.FALSE.
+      LXEREF=.FALSE.
+      LNEREF=.FALSE.
+      LTFUEL=.FALSE.
+      LDRAH =.FALSE.
+      LTCOOL=.FALSE.
+      LDCOOL=.FALSE.
+      LPWF=.TRUE.
+      ILBFLU=0
+      IMPX=0
+      IXENO=0
+      ISAMA=0
+      INEPT=0
+      IPROF2=0
+      LINI=.FALSE.
+      ILEAK=0
+      PWREF=0.0
+      DMR=0.0
+      DCR=0.0
+      NTM=0
+* Set burnup interpolation method 
+*   (default 0 for lagrangian interpolation)
+*   (1 for linear)
+      ILIN=0 
+*     SET  HERMITE INTERPOLATION FOR TIME-AVERAGE CALCULATION
+      ITM=3
+*---------------------------------------------------------------*
+*      MX IS THE MAXIMUN MIXTURE NUMBER
+      MX=NBCH*NCCO
+*---------------------------------------------------------------*
+*     CHECK THE PARAMETERS
+      IF(MX.EQ.0) CALL XABORT('AFMDRV: ZERO NUMBER OF MIXTURES.')
+      IF(NGRP.EQ.0) CALL XABORT('AFMDRV: ZERO NUMBER OF GROUPS.')
+      IF(NBURN.EQ.0) CALL XABORT('AFMDRV: ZERO NUMBER OF BURNUPS.')
+*---------------------------------------------------------------*
+*     INITIALISATION OF THE MATRICES
+      NG2=NGRP*NGRP
+      DO 50 IGR=1,NG2
+       DO 40 IN=1,NUT
+        DO 30 I=1,NBURN
+         DO 20 ITY=1,NTYP
+          DO 10 ISO=1,NISO
+            XBORB(IGR,ITY,ISO,I,IN)=0.0
+            XPURB(IGR,ITY,ISO,I,IN)=0.0
+            XXENB(IGR,ITY,ISO,I,IN)=0.0
+            XT1FB(IGR,ITY,ISO,I,IN)=0.0
+            XT2FB(IGR,ITY,ISO,I,IN)=0.0
+            XT1CB(IGR,ITY,ISO,I,IN)=0.0
+            XT2CB(IGR,ITY,ISO,I,IN)=0.0
+            XT1MB(IGR,ITY,ISO,I,IN)=0.0
+            XT2MB(IGR,ITY,ISO,I,IN)=0.0
+            XD1CB(IGR,ITY,ISO,I,IN)=0.0
+            XD2CB(IGR,ITY,ISO,I,IN)=0.0
+            XD1MB(IGR,ITY,ISO,I,IN)=0.0
+            XD2MB(IGR,ITY,ISO,I,IN)=0.0
+            XSMB(IGR,ITY,ISO,I,IN)=0.0
+            XNP9B(IGR,ITY,ISO,I,IN)=0.0
+            XMFDB(IGR,ITY,ISO,I,IN)=0.0
+            XMMDB(IGR,ITY,ISO,I,IN)=0.0
+            XPF1B(IGR,ITY,ISO,I,IN)=0.0
+            XPF2B(IGR,ITY,ISO,I,IN)=0.0
+            XPF1LB(IGR,ITY,ISO,I,IN)=0.0
+            XPF2LB(IGR,ITY,ISO,I,IN)=0.0
+            SMACB(IGR,ITY,ISO,I,IN)=0.0
+   10     CONTINUE
+   20    CONTINUE
+   30   CONTINUE
+   40  CONTINUE
+   50 CONTINUE
+*
+      DO 100 IGR=1,NGRP
+        DO 90 IMX=1,MX
+           DIFFX(IMX,IGR)=0.0
+           DIFFY(IMX,IGR)=0.0
+           DIFFZ(IMX,IGR)=0.0
+           FLUX(IMX,IGR)=0.0
+           OVERV(IMX,IGR)=0.0
+           CHI(IMX,IGR)=0.0
+           DO 70 IL=1,NL
+             DO 60 JGR=1,NGRP
+               SCAT(IMX,IL,IGR,JGR)=0.0
+   60        CONTINUE
+             IJJ(IMX,IL,IGR)=IGR
+             NJJ(IMX,IL,IGR)=1
+   70      CONTINUE
+           DO 80 ITYP=1,NTYP
+             SIGMA(IMX,IGR,ITYP)=0.0
+   80      CONTINUE
+   90   CONTINUE
+  100 CONTINUE
+C
+      DO 150 IBR=1,NBURN
+        DO 140 IGR=1,NGRP
+          FLUAV(IBR,IGR)=0.0
+          DO 110 ITYP=1,NTYP
+           SIGAV(IBR,IGR,ITYP)=0.0
+  110     CONTINUE
+          DO 130 JGR=1,NGRP
+            DO 120 IL=1,NL
+              SCATAV(IBR,IL,IGR,JGR)=0.0
+  120       CONTINUE
+  130     CONTINUE
+  140   CONTINUE
+  150 CONTINUE
+* INITIALISATION OF THE HISTORY COEFFICIENT
+      DO 180 IBR=1,NBURN
+       DO 170 IN=1,NUT
+         DO 160 I=1,2
+           CPW1B(I,IBR,IN)=0.0
+           CPW2B(I,IBR,IN)=0.0
+           HXEN1(I,IBR,IN)=0.0
+           HXEN2(I,IBR,IN)=0.0
+           HSAM1(I,IBR,IN)=0.0
+           HSAM2(I,IBR,IN)=0.0
+           HNEP1(I,IBR,IN)=0.0
+           HNEP2(I,IBR,IN)=0.0
+  160    CONTINUE
+  170  CONTINUE
+  180 CONTINUE
+*---------------------------------------------------------------*
+* READ AN OPTION KEY WORD
+  185 CALL REDGET (INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
+      IF(INDIC.NE.3) CALL XABORT('AFMDRV: CHARACTER DATA EXPECTED.')
+      IF(TEXT4.EQ.'EDIT') THEN
+* READ THE PRINT INDEX.
+         CALL REDGET(INDIC,IMPX,FLOTT,TEXT4,DFLOTT)
+         IF(INDIC.NE.1) CALL XABORT('AFMDRV: INTEGER DATA EXPECTED.')
+      ELSE IF(TEXT4.EQ.'REFT') THEN
+         DO 190 IN=1,NUT
+           CALL REDGET(INDIC,KTYP(IN),FLOTT,TEXT4,DFLOTT)
+           IF(INDIC.NE.1) CALL XABORT('AFMDRV: INTEGER DATA EXPECTED.')
+           CALL REDGET (INDIC,NITMA,FLOTT,TEXTR,DFLOTT)
+           IF(INDIC.NE.3)
+     1         CALL XABORT('AFMDRV: CHARACTER DATA EXPECTED.')
+           READ(TEXTR,'(3A4)') (ITEXTR((IN-1)*3+I),I=1,3)
+ 190     CONTINUE
+         IF(LMCR .AND. KTYP(1).GT.MX)
+     +            CALL XABORT('AFMDRV: INVALID INDEX NUMBER.')
+C
+* CHECK THE NAME OF THE DIRECTORY
+         WRITE(TEXTR,'(3A4)') (ITEXTR(I1),I1=1,3)
+         CALL LCMLEN(IPFBM,TEXTR,ILENGT,ITYLCM)
+         IF(ILENGT.EQ.0) THEN
+           CALL XABORT('AFMDRV: UNABLE TO FIND '//TEXTR//' .')
+         ENDIF
+* RECOVER THE REFERENCE LOCAL PARAMETERS VALUES
+         CALL LCMSIX(IPFBM,TEXTR,1)
+         CALL LCMSIX(IPFBM,'INFO-NOMINA',1)
+         CALL LCMLEN(IPFBM,'NOMINALP',ILP,ITYLCM)
+         IF(ILP.GT.0) THEN
+           CALL LCMGET(IPFBM,'NOMINALP',RLOC)
+           CALL LCMGET(IPFBM,'NOMINALN',HISO)
+           DO 200 I=1,ILP
+             WRITE(HMICRO,'(3A4)') (HISO((I-1)*3+IH),IH=1,3)
+             IF(HMICRO.EQ.'PW') PWREF=RLOC(I)
+             IF(HMICRO.EQ.'TCOOL') TCR=RLOC(I)
+             IF(HMICRO.EQ.'TMOD') TMR=RLOC(I)
+             IF(HMICRO.EQ.'TFUEL') TFR=RLOC(I)
+             IF(HMICRO.EQ.'RHOC') DCR=RLOC(I)
+             IF(HMICRO.EQ.'RHOM') DMR=RLOC(I)
+             IF(HMICRO.EQ.'PUR') XIR=RLOC(I)
+ 200       CONTINUE
+         ENDIF
+         CALL LCMSIX(IPFBM,' ',2)
+         CALL LCMSIX(IPFBM,' ',2)
+* REFERENCE PARAMETER VALUES
+         PFIX=PWREF
+         AW=15.9994 +2*(1-XIR)*1.0079 +2*XIR*2.014101
+         PH=2*1.0079/AW
+         PD=2*2.014101/AW
+* INITIALISATION OF PERTURBED PARAMETER
+         TF=TFR
+         TC=TCR
+         TM=TMR
+         DC=1.0
+         DM=1.0
+         XI=XIR
+         BOR=0.0
+         SM=0.0
+         RNP9=0.0
+         XEN=0.0
+*
+         DO 210 IMX=1,MX
+           POWER(IMX)=PWREF
+           ISFT(IMX)=0
+           BURBG(IMX)=0.0
+           BURED(IMX)=0.0
+           VOL(IMX)=0.0
+           PDCOOL(IMX)=DCR
+           PTCOOL(IMX)=TCR
+           PTFUEL(IMX)=TFR
+  210    CONTINUE
+*        RECOVER THE TEMERATURE AND DENSITY PROFILES
+         IF( (.NOT.LMCR).AND.(NPARM.GT.0) ) THEN
+            JPMAP=LCMGID(IPMAP,'PARAM')
+            DO 220 IPARM=1,NPARM
+            KPMAP=LCMGIL(JPMAP,IPARM)
+            CALL LCMGTC(KPMAP,'P-NAME',12,PNAME)
+            CALL LCMGTC(KPMAP,'PARKEY',12,PARKEY)
+            CALL LCMGET(KPMAP,'P-TYPE',IPTYPE)
+            IF(IPTYPE.EQ.1) THEN
+               CALL LCMGET(KPMAP,'P-VALUE',FLOTT)
+            ELSE IF(IPTYPE.EQ.2) THEN
+               CALL LCMLEN(KPMAP,'P-VALUE',NITMA,ITYLCM)
+               IF(NITMA.NE.MX) CALL XABORT('@AFMDRV: INVALID LENGTH FO'
+     1         //'R P-VALUE.')
+            ENDIF
+            IF(PNAME.EQ.'T-COOL') THEN
+               WRITE(6,716) PNAME,PARKEY
+               IF(IPTYPE.EQ.1) THEN
+                  PTCOOL(:MX)=FLOTT
+               ELSE IF(IPTYPE.EQ.2) THEN
+                  CALL LCMGET(KPMAP,'P-VALUE',PTCOOL)
+               ENDIF
+            ELSE IF(PNAME.EQ.'D-COOL') THEN
+               WRITE(6,716) PNAME,PARKEY
+               IF(IPTYPE.EQ.1) THEN
+                  PDCOOL(:MX)=FLOTT
+               ELSE IF(IPTYPE.EQ.2) THEN
+                  CALL LCMGET(KPMAP,'P-VALUE',PDCOOL)
+               ENDIF
+            ELSE IF(PNAME.EQ.'T-FUEL') THEN
+               WRITE(6,716) PNAME,PARKEY
+               IF(IPTYPE.EQ.1) THEN
+                  PTFUEL(:MX)=FLOTT
+               ELSE IF(IPTYPE.EQ.2) THEN
+                  CALL LCMGET(KPMAP,'P-VALUE',PTFUEL)
+               ENDIF
+            ENDIF
+  220       CONTINUE
+         ENDIF
+*
+         PW(:MNPS)=PWREF
+         BRH(:MNPS)=0.0
+         POWER(:MX)=PWREF
+*
+      ELSE IF(TEXT4.EQ.'TFUEL') THEN
+        CALL REDGET (INDIC,NITMA,TFU,TEXT4,DFLOTT)
+        LTFUEL = .TRUE.
+        IF(INDIC.NE.2) CALL XABORT('AFMDRV: REAL DATA EXPECTED.')
+*
+      ELSE IF(TEXT4.EQ.'TCOOL') THEN
+         CALL REDGET (INDIC,NITMA,TCU,TEXT4,DFLOTT)
+         IF(INDIC.NE.2) CALL XABORT('AFMDRV: REAL DATA EXPECTED.')
+          LTCOOL = .TRUE.
+          PTCOOL(:MX)=TCU
+*
+      ELSE IF(TEXT4.EQ.'TMOD') THEN
+        CALL REDGET (INDIC,NITMA,TM,TEXT4,DFLOTT)
+        IF(INDIC.NE.2) CALL XABORT('AFMDRV: REAL DATA EXPECTED.')
+*
+      ELSE IF(TEXT4.EQ.'RDCL') THEN
+        CALL REDGET (INDIC,NITMA,DCU,TEXT4,DFLOTT)
+        IF(INDIC.NE.2) CALL XABORT('AFMDRV: REAL DATA EXPECTED.')
+          LDCOOL = .TRUE.
+          PDCOOL(:MX)=DCU
+*
+      ELSE IF(TEXT4.EQ.'RDMD') THEN
+        CALL REDGET (INDIC,NITMA,DM,TEXT4,DFLOTT)
+        IF(INDIC.NE.2) CALL XABORT('AFMDRV: REAL DATA EXPECTED.')
+        DM=DM/DMR
+*
+      ELSE IF(TEXT4.EQ.'BORON') THEN
+        CALL REDGET (INDIC,NITMA,BOR,TEXT4,DFLOTT)
+        IF(INDIC.NE.2) CALL XABORT('AFMDRV: REAL DATA EXPECTED.')
+*
+*  ppm eq 10**-6, NO CONSISTENCY WITH CFC CONCENTRATIONS
+*  NEED TO ADD A COEFFICIENT TO FIT THE DATA (BREF should be 0.0ppm)
+*
+        BOR=BOR*1.E-6
+*
+      ELSE IF(TEXT4.EQ.'PUR') THEN
+        CALL REDGET (INDIC,NITMA,XI,TEXT4,DFLOTT)
+        IF(INDIC.NE.2) CALL XABORT('AFMDRV: REAL DATA EXPECTED.')
+        XI=XI*1.0E-02
+*
+      ELSE IF(TEXT4.EQ.'FIXP') THEN
+        CALL REDGET (INDIC,NITMA,PFIX,TEXT4,DFLOTT)
+        IF(INDIC.EQ.2) THEN
+          LNOMP=.TRUE.
+        ELSE IF(TEXT4.EQ.'INIT') THEN
+          LINI=.TRUE.
+        ELSE
+          CALL XABORT('AFMDRV: "INIT" or REAL DATA EXPECTED.')
+        ENDIF
+*
+      ELSE IF(TEXT4.EQ.'IMET') THEN
+        CALL REDGET(INDIC,ITM,FLOTT,TEXT4,DFLOTT)
+        IF(INDIC.NE.1) CALL XABORT('AFMDRV: INTEGER DATA EXPECTED.')
+*
+      ELSE IF(TEXT4.EQ.'XENON') THEN
+        LXENON=.TRUE.
+        CALL REDGET (INDIC,NITMA,FXEN,TEXT4,DFLOTT)
+        IF(INDIC.NE.2) CALL XABORT('AFMDRV: REAL DATA EXPECTED.')
+*
+      ELSE IF(TEXT4.EQ.'XEREF') THEN
+        LXEREF=.TRUE.
+*
+      ELSE IF(TEXT4.EQ.'DRAH') THEN
+         LDRAH=.TRUE.
+*
+      ELSE IF(TEXT4.EQ.'SAM') THEN
+        LSAM=.TRUE.
+        CALL REDGET (INDIC,NITMA,FSAM,TEXT4,DFLOTT)
+        IF(INDIC.NE.2) CALL XABORT('AFMDRV: REAL DATA EXPECTED.')
+*
+      ELSE IF(TEXT4.EQ.'NEP') THEN
+        LNEP=.TRUE.
+        CALL REDGET (INDIC,NITMA,FNEP,TEXT4,DFLOTT)
+        IF(INDIC.NE.2) CALL XABORT('AFMDRV: REAL DATA EXPECTED.')
+*
+      ELSE IF(TEXT4.EQ.'NREF') THEN
+        LNEREF=.TRUE.
+*
+      ELSE IF(TEXT4.EQ.'BURN') THEN
+        IF(LMCR) THEN
+          CALL REDGET (INDIC,NITMA,FBUR,TEXT4,DFLOTT)
+          IF(INDIC.NE.2) CALL XABORT('AFMDRV: REAL DATA EXPECTED.')
+        ELSE
+          CALL XABORT('AFMDRV: INVALID KEYWORD BURN.')
+        ENDIF
+*
+      ELSE IF(TEXT4.EQ.'NPWF') THEN
+         LPWF=.FALSE.
+      ELSE IF(TEXT4.EQ.'PWF') THEN
+         LPWF=.TRUE.
+      ELSE IF(TEXT4.EQ.'BLIN') THEN
+         ILIN=1
+      ELSE IF(TEXT4.EQ.';') THEN
+         GO TO 230
+      ELSE
+        CALL XABORT('AFMDRV: '//TEXT4//' IS AN INVALID KEY-WORD.')
+      ENDIF
+      GO TO 185
+*     EQUIVALENT MODERATOR DENSITY FOR THE REFERENCE PURITY
+  230 DXI = XI - XIR
+* pas de modification de densite selon la purete D2O
+*      DM=DM/(1.0+DXI*(PD-PH))
+*---------------------------------------------------------------*
+* RECOVER NEUTRONICS PARAMETRES
+      WRITE(TEXTR,'(3A4)') (ITEXTR(I1),I1=1,3)
+      CALL LCMSIX(IPFBM,TEXTR,1)
+      CALL LCMGET(IPFBM,'VOLUME',VOL(1))
+      CALL LCMGET(IPFBM,'ENERGY',ENER)
+      CALL LCMGET(IPFBM,'HITAB',HISO)
+      CALL LCMGET(IPFBM,'JTAB',JTAB)
+      CALL LCMSIX(IPFBM,' ',2)
+      DO 280 IN=1,NUT
+        WRITE(TEXTR,'(3A4)') (ITEXTR((IN-1)*3+I1),I1=1,3)
+        CALL LCMSIX(IPFBM,TEXTR,1)
+        CALL LCMGET(IPFBM,'BURNUP',XBURN(1,IN))
+*     RECOVER THE EXISTING DATABASE.
+* RECOVER THE HISTORY COEFFICIENTS
+        DO 270 I = 1,NBURN
+          WRITE(TEXTB,'(4HBURN,4X,I4)') I
+          CALL LCMSIX(IPFBM,TEXTB,1)
+*
+          IF(JTAB(1).EQ.1) THEN
+            CALL LCMSIX(IPFBM,'HISTORY',1)
+            CALL LCMGET(IPFBM,'PHIL1',CPW1B(1,I,IN))
+            CALL LCMGET(IPFBM,'PHIS1',CPW1B(2,I,IN))
+            CALL LCMGET(IPFBM,'PHIL2',CPW2B(1,I,IN))
+            CALL LCMGET(IPFBM,'PHIS2',CPW2B(2,I,IN))
+            CALL LCMLEN(IPFBM,'PHISX1',IHISTO,ITYLCM)
+            IF(IHISTO.GT.0) THEN
+              CALL LCMGET(IPFBM,'PHILX1',HXEN1(1,I,IN))
+              CALL LCMGET(IPFBM,'PHISX1',HXEN1(2,I,IN))
+              CALL LCMGET(IPFBM,'PHILX2',HXEN2(1,I,IN))
+              CALL LCMGET(IPFBM,'PHISX2',HXEN2(2,I,IN))
+C
+              CALL LCMGET(IPFBM,'PHILS1',HSAM1(1,I,IN))
+              CALL LCMGET(IPFBM,'PHISS1',HSAM1(2,I,IN))
+              CALL LCMGET(IPFBM,'PHILS2',HSAM2(1,I,IN))
+              CALL LCMGET(IPFBM,'PHISS2',HSAM2(2,I,IN))
+C
+              CALL LCMGET(IPFBM,'PHILN1',HNEP1(1,I,IN))
+              CALL LCMGET(IPFBM,'PHISN1',HNEP1(2,I,IN))
+              CALL LCMGET(IPFBM,'PHILN2',HNEP2(1,I,IN))
+              CALL LCMGET(IPFBM,'PHISN2',HNEP2(2,I,IN))
+            ENDIF
+            CALL LCMSIX(IPFBM,' ',2)
+          ENDIF
+*
+          CALL LCMGET(IPFBM,'FLUX-INTG',FLUXB(1,I,IN))
+          CALL LCMGET(IPFBM,'OVERV',OVERVB(1,I,IN))
+          CALL LCMGET(IPFBM,'ISOTOPESDENS',DENSITB(1,I,IN))
+* COMPUTE DELTA-CONCENTRATION
+          DO 250 ISO=1,NISO
+            WRITE(HMICRO,'(3A4)') (HISO((ISO-1)*3+IH),IH=1,3)
+            CALL LCMSIX(IPFBM,HMICRO,1)
+            IF(JTAB(1).EQ.1) THEN
+              IF((HMICRO.EQ.'XE135').OR.(HMICRO.EQ.'Xe135')) IXENO=ISO
+              IF((HMICRO.EQ.'SM149').OR.(HMICRO.EQ.'Sm149')) ISAMA=ISO
+              IF((HMICRO.EQ.'NP239').OR.(HMICRO.EQ.'Np239')) INEPT=ISO
+              IF(HMICRO.EQ.'MACR ')
+     1             CALL LCMGET(IPFBM,'CHI',CHIB(1,I,IN))
+            ENDIF
+* RECOVER MACROSCOPIC X-SECTIONS
+            NTM=4+2*IXYZ
+            DO 240 ITY=1,NTM
+              IF(ITY.EQ.1) THEN
+                IF(IXYZ.EQ.0)  THEN
+                  TEXTD = 'STRD'
+                ELSE IF(IXYZ.EQ.1) THEN
+                  TEXTD = 'STRD X'
+                ENDIF
+              ENDIF
+              IF(ITY.EQ.2) TEXTD = 'ABS'
+              IF(ITY.EQ.3) TEXTD = 'NUSIGF'
+              IF(ITY.EQ.4) TEXTD = 'H-FACTORS'
+              IF(ITY.EQ.5) TEXTD = 'STRD Y'
+              IF(ITY.EQ.6) TEXTD = 'STRD Z'
+              CALL LCMLEN(IPFBM,TEXTD,ILENG,ITYXSM)
+*
+              IF(ILENG.NE.0) THEN
+                CALL LCMSIX(IPFBM,TEXTD,1)
+                CALL LCMGET(IPFBM,'REF',SMACB(1,ITY,ISO,I,IN))
+                CALL LCMGET(IPFBM,'BOR',XBORB(1,ITY,ISO,I,IN))
+                CALL LCMGET(IPFBM,'PUR',XPURB(1,ITY,ISO,I,IN))
+                CALL LCMGET(IPFBM,'T1M',XT1MB(1,ITY,ISO,I,IN))
+                CALL LCMGET(IPFBM,'T2M',XT2MB(1,ITY,ISO,I,IN))
+                CALL LCMGET(IPFBM,'D1M',XD1MB(1,ITY,ISO,I,IN))
+                CALL LCMGET(IPFBM,'D2M',XD2MB(1,ITY,ISO,I,IN))
+                IF(JTAB(1).EQ.1) THEN
+                  CALL LCMLEN(IPFBM,'XEN',ILENGX,ITYXSM)
+                  IF(ILENGX.GT.0)
+     +               CALL LCMGET(IPFBM,'XEN',XXENB(1,ITY,ISO,I,IN))
+                  CALL LCMGET(IPFBM,'T1F',XT1FB(1,ITY,ISO,I,IN))
+                  CALL LCMGET(IPFBM,'T2F',XT2FB(1,ITY,ISO,I,IN))
+                  CALL LCMGET(IPFBM,'T1C',XT1CB(1,ITY,ISO,I,IN))
+                  CALL LCMGET(IPFBM,'T2C',XT2CB(1,ITY,ISO,I,IN))
+                  CALL LCMGET(IPFBM,'D1C',XD1CB(1,ITY,ISO,I,IN))
+                  CALL LCMGET(IPFBM,'D2C',XD2CB(1,ITY,ISO,I,IN))
+                  CALL LCMGET(IPFBM,'SM149',XSMB(1,ITY,ISO,I,IN))
+                  CALL LCMGET(IPFBM,'NP239',XNP9B(1,ITY,ISO,I,IN))
+                  CALL LCMGET(IPFBM,'MIXFD',XMFDB(1,ITY,ISO,I,IN))
+                  CALL LCMGET(IPFBM,'MIXMD',XMMDB(1,ITY,ISO,I,IN))
+                  CALL LCMGET(IPFBM,'FPCH1',XPF1B(1,ITY,ISO,I,IN))
+                  CALL LCMGET(IPFBM,'FPCL1',XPF1LB(1,ITY,ISO,I,IN))
+                  CALL LCMGET(IPFBM,'FPCH2',XPF2B(1,ITY,ISO,I,IN))
+                  CALL LCMGET(IPFBM,'FPCL2',XPF2LB(1,ITY,ISO,I,IN))
+                ENDIF
+*
+                CALL LCMSIX(IPFBM,' ',2)
+              ENDIF
+ 240        CONTINUE
+*
+            CALL LCMLEN(IPFBM,'NFTOT',ILNF,ITYXSM)
+            IF(ILNF.NE.0) THEN
+              CALL LCMGET(IPFBM,'NFTOT',SMACB(1,NTM+1,ISO,I,IN))
+            ENDIF
+            CALL LCMSIX(IPFBM,' ',2)
+ 250      CONTINUE
+*     SCATTERING CROSS-SECTIONS
+          DO 260 ISO=1,NISO
+            WRITE(HMICRO,'(3A4)') (HISO((ISO-1)*3+IH),IH=1,3)
+            CALL LCMLEN(IPFBM,HMICRO,ILENG,ITYLCM)
+            IF(ILENG.EQ.0) GO TO 230
+            CALL LCMSIX(IPFBM,HMICRO,1)
+C            DO 150 IL=1,NL
+              IL=1
+              ITY=NTM+1+IL
+              LTST=0
+              WRITE (CM,'(I2.2)') IL-1
+              CALL LCMLEN(IPFBM,'SCAT'//CM,ILENG,ITYXSM)
+              IF(ILENG.NE.0) THEN
+                LTST=1
+              ELSE
+                WRITE (CM,'(I2)') IL-1
+                CALL LCMLEN(IPFBM,'SCAT'//CM,ILENG,ITYXSM)
+                IF(ILENG.NE.0) THEN
+                  LTST=2
+                ENDIF
+              ENDIF
+              IF (LTST.GE.1) THEN
+                CALL LCMSIX(IPFBM,'SCAT'//CM,1)
+                IF(HMICRO.EQ.'MACR') THEN
+                  IF (LTST.EQ.1) THEN
+                    CALL LCMGET(IPFBM,'NJJS',NJ)
+                    CALL LCMGET(IPFBM,'IJJS',IJ)
+                  ELSE
+                    CALL LCMGET(IPFBM,'NJJ',NJ)
+                    CALL LCMGET(IPFBM,'IJJ',IJ)
+                  ENDIF
+                ENDIF
+                CALL LCMGET(IPFBM,'REF',SMACB(1,ITY,ISO,I,IN))
+                CALL LCMGET(IPFBM,'BOR',XBORB(1,ITY,ISO,I,IN))
+                CALL LCMGET(IPFBM,'PUR',XPURB(1,ITY,ISO,I,IN))
+                CALL LCMGET(IPFBM,'T1M',XT1MB(1,ITY,ISO,I,IN))
+                CALL LCMGET(IPFBM,'T2M',XT2MB(1,ITY,ISO,I,IN))
+                CALL LCMGET(IPFBM,'D1M',XD1MB(1,ITY,ISO,I,IN))
+                CALL LCMGET(IPFBM,'D2M',XD2MB(1,ITY,ISO,I,IN))
+                IF(JTAB(1).EQ.1) THEN
+                  CALL LCMLEN(IPFBM,'XEN',ILENG,ITYXSM)
+                  IF(ILENG.GT.0) THEN
+                    CALL LCMGET(IPFBM,'XEN',XXENB(1,ITY,ISO,I,IN))
+                  ENDIF
+                  CALL LCMGET(IPFBM,'T1F',XT1FB(1,ITY,ISO,I,IN))
+                  CALL LCMGET(IPFBM,'T2F',XT2FB(1,ITY,ISO,I,IN))
+                  CALL LCMGET(IPFBM,'T1C',XT1CB(1,ITY,ISO,I,IN))
+                  CALL LCMGET(IPFBM,'T2C',XT2CB(1,ITY,ISO,I,IN))
+                  CALL LCMGET(IPFBM,'D1C',XD1CB(1,ITY,ISO,I,IN))
+                  CALL LCMGET(IPFBM,'D2C',XD2CB(1,ITY,ISO,I,IN))
+*
+                  CALL LCMGET(IPFBM,'SM149',XSMB(1,ITY,ISO,I,IN))
+                  CALL LCMGET(IPFBM,'NP239',XNP9B(1,ITY,ISO,I,IN))
+                  CALL LCMGET(IPFBM,'MIXFD',XMFDB(1,ITY,ISO,I,IN))
+                  CALL LCMGET(IPFBM,'MIXMD',XMMDB(1,ITY,ISO,I,IN))
+                  CALL LCMGET(IPFBM,'FPCH1',XPF1B(1,ITY,ISO,I,IN))
+                  CALL LCMGET(IPFBM,'FPCL1',XPF1LB(1,ITY,ISO,I,IN))
+                  CALL LCMGET(IPFBM,'FPCH2',XPF2B(1,ITY,ISO,I,IN))
+                  CALL LCMGET(IPFBM,'FPCL2',XPF2LB(1,ITY,ISO,I,IN))
+                ENDIF
+*
+                CALL LCMSIX(IPFBM,' ',2)
+              ENDIF
+            CALL LCMSIX(IPFBM,' ',2)
+  260     CONTINUE
+C
+          CALL LCMSIX(IPFBM,' ',2)
+  270   CONTINUE
+        CALL LCMSIX(IPFBM,' ',2)
+  280 CONTINUE
+      IF(JTAB(1).EQ.1) THEN
+        IF(IXENO.EQ.0) CALL XABORT('NO XE135 FOUND ')
+        IF(ISAMA.EQ.0) CALL XABORT('NO SM149 FOUND ')
+        IF(INEPT.EQ.0) CALL XABORT('NO NP239 FOUND ')
+      ENDIF
+*     END OF THE RECOVERING PROCESS
+*---------------------------------------------------------------*
+*        ISC INDICATE THE TYPE OF CROSS-SECTION CALCULATION
+*        ISC=1 ; TIME AVERAGE CALCULATION
+*        ISC=2 ; INSTANTANEOUS CALCULATION
+*        ISC=3 ; HOMOGENEOUS CALCULATION
+*---------------------------------------------------------------*
+*
+      IF(ISC.EQ.0) THEN
+        CALL XABORT('AFMDRV: TIMAV/INSTANT BURNUP TREATMENT NOT SET')
+      ELSE IF(ISC.EQ.1) THEN
+*       Time-averaged calculation
+        WRITE(6,699)
+        MMIX=NBCH*NCCO
+        LTAV=.TRUE.
+        CALL LCMGET(IPMAP,'FLMIX',INDEX)
+        CALL LCMGET(IPMAP,'BURN-BEG',BURBG)
+        CALL LCMGET(IPMAP,'BURN-END',BURED)
+        CALL LCMLEN(IPMAP,'BUND-PW',ILPW,ITYLCM)
+          IF((ILPW.NE.0).AND.LPWF) THEN
+            IF(IMPX.GE.1) WRITE(6,702)
+            IF(.NOT.LINI) THEN
+              CALL LCMGET(IPMAP,'BUND-PW',POWER)
+            ELSE 
+              CALL LCMLEN(IPMAP,'BUND-PW-INI',ILPW,ITYLCM)
+              IF(ILPW.NE.0) THEN
+                CALL LCMGET(IPMAP,'BUND-PW-INI',POWER)
+              ELSE
+                CALL XABORT('AFMDRV: NO INITIAL POWER IN L_MAP')
+              ENDIF
+            ENDIF
+          ELSE
+            POWER(:MMIX)=PWREF
+          ENDIF
+        CALL LCMLEN(IPMAP,'FLUX-AV',ILBFLU,ITYLCM)
+        IF(ILBFLU.NE.0) THEN
+          IF(IMPX.GE.1) WRITE(6,703)
+          CALL LCMGET(IPMAP,'FLUX-AV',WORK)
+          DO 300 IGR=1,NGRP
+           DO 290 IBF=1,MMIX
+             IIBF=MMIX*(IGR-1)+IBF
+             BFLUX(IGR,IBF)=WORK(IIBF)
+ 290      CONTINUE
+ 300      CONTINUE
+        ENDIF
+      ELSE IF(ISC.EQ.2) THEN
+*       Instantaneous calculation
+        IF(LMCR) THEN
+          MMIX=NBCH*NCCO
+          POWER(:MMIX)=PWREF
+        ELSE
+          WRITE(6,701)
+          MMIX=NBCH*NCCO
+          CALL LCMGET(IPMAP,'FLMIX',INDEX)
+          CALL LCMGET(IPMAP,'BURN-INST',BURBG)
+          CALL LCMLEN(IPMAP,'BUND-PW',ILPW,ITYLCM)
+          IF((ILPW.NE.0).AND.LPWF) THEN
+            IF(IMPX.GE.1) WRITE(6,702)
+            IF(.NOT.LINI) THEN
+              CALL LCMGET(IPMAP,'BUND-PW',POWER)
+            ELSE 
+              CALL LCMLEN(IPMAP,'BUND-PW-INI',ILPW,ITYLCM)
+              IF(ILPW.NE.0) THEN
+                CALL LCMGET(IPMAP,'BUND-PW-INI',POWER)
+              ELSE
+                CALL XABORT('AFMDRV: NO INITIAL POWER IN L_MAP')
+              ENDIF
+            ENDIF
+          ELSE
+            POWER(:MMIX)=PWREF
+          ENDIF
+          CALL LCMLEN(IPMAP,'FLUX-AV',ILBFLU,ITYLCM)
+          IF(ILBFLU.NE.0) THEN
+            IF(IMPX.GE.1) WRITE(6,703)
+            CALL LCMGET(IPMAP,'FLUX-AV',WORK)
+            DO 320 IGR=1,NGRP
+             DO 310 IBF=1,MMIX
+               IIBF=MMIX*(IGR-1)+IBF
+               BFLUX(IGR,IBF)=WORK(IIBF)
+ 310        CONTINUE
+ 320        CONTINUE
+          ENDIF
+* RECOVER THE SHIFT INFORMATION
+          IF(MNPS.GT.2) THEN
+            IF(IMPX.GE.1) WRITE(6,704)
+            CALL LCMGET(IPMAP,'ISHIFT',ISFT)
+            DO 330 IS=1,MNPS-2
+              WRITE (CM,'(I2)') IS
+              CALL LCMGET(IPMAP,'BSHIFT'//CM,BSFT(1,IS))
+              CALL LCMGET(IPMAP,'PSHIFT'//CM,PSFT(1,IS))
+ 330        CONTINUE
+          ENDIF
+        ENDIF
+      ELSE IF(ISC.EQ.3) THEN
+*       Homogeneous calculation
+        MMIX=NCZO
+        LTAV=.TRUE.
+        CALL LCMGET(IPMAP,'B-ZONE',IZONE)
+        CALL LCMGET(IPMAP,'FLMIX',INDEX)
+        CALL LCMGET(IPMAP,'BURN-AVG',BURED)
+      ENDIF
+*---------------------------------------------------------------*
+      IF(IMPX.GE.1) THEN
+         IF(LNOMP) WRITE(6,705) PFIX
+         IF(LXENON) WRITE(6,706) FXEN
+         IF(LSAM) WRITE(6,719) FSAM
+         IF(LNEP) WRITE(6,711) FNEP
+         IF(LXEREF) WRITE(6,712)
+         IF(LNEREF) WRITE(6,713)
+         IF(LTFUEL) WRITE(6,714) TFU
+         IF(IHISTO.GT.0.AND.LDRAH) WRITE(6,715)
+         IF(LTCOOL) WRITE(6,717) TCU
+         IF(LDCOOL) WRITE(6,718) DCU
+      ENDIF
+*---------------------------------------------------------------*
+* MIXTURE SHIFT
+      IF(LMCR) THEN
+        MXSH=MMIX
+        VOL(:MMIX)=VOL(1)
+      ELSE
+        MXSH=1
+      ENDIF
+*---------------------------------------------------------------*
+*        LOOP OVER THE MIXTURES
+      DO 540 NMIX=MXSH,MMIX
+        TC=PTCOOL(NMIX)
+        DC=PDCOOL(NMIX)/DCR
+        IF(LMCR) THEN
+          NPS=2
+          IDF=1
+        ELSE
+          VOL(NMIX)=VOL(1)
+          NPS=ISFT(NMIX)+2
+          KDF=0
+          DO 340 IN=1,NUT
+            IF(INDEX(NMIX).EQ.KTYP(IN)) THEN
+              IDF=IN
+              KDF=1
+            ENDIF
+  340     CONTINUE
+          IF(KDF.EQ.0) CALL XABORT('AFMDRV: WRONG NUMBER OF INDEX')
+        ENDIF
+* IF TIME AVERAGE CALCULATION:
+* EVALUATION OF THE BURNUPS STEPS EMBEDED IN THE INTEGRATION
+        IF(LTAV) THEN
+          XBMIN=BURBG(NMIX)
+          XBMAX=BURED(NMIX)
+* TIME AVERAGE BURNUP LOCALISATION
+          CALL AFMLOC(NBURN,NTP,XBMAX,XBMIN,XBURN(1,IDF),
+     1                IMAX,IMIN,XCOF,ILIN)
+*       LAGRANGE METHOD (TIME-AVERAGE)
+          IMINR=IMIN
+          IMAXR=ABS(IMAX)
+*       SPLINE OR HERMITE METHOD (TIME-AVERAGE)
+          IF(ITM.EQ.2.OR.ITM.EQ.3) THEN
+            IMINR=1
+            IMAXR=NBURN
+          ENDIF
+*
+        ELSE
+          IMINR=1
+          IMAXR=1
+        ENDIF
+C
+        DO 450 JR=IMINR,IMAXR
+         IF(LTAV) THEN
+           IRAV=JR
+           NPS=2
+         ELSE
+           IF(NPS.GT.2) THEN
+             DO 350 K=2,NPS-1
+               IS=K-1
+               BRH(K)=BSFT(NMIX,IS)
+ 350         CONTINUE
+           ENDIF
+           IF(LMCR) THEN
+             BRH(NPS)=FBUR
+             IF(JTAB(1).EQ.0) BRH(NPS)=0.0
+           ELSE
+             BRH(NPS)=BURBG(NMIX)
+           ENDIF
+         ENDIF
+*
+         IF(LNOMP) THEN
+           DO 360 K=2,NPS
+             PW(K)=PFIX
+ 360       CONTINUE
+         ELSE
+           IF(NPS.GT.2) THEN
+             DO 370 K=2,NPS-1
+               IS=K-1
+               PW(K)=PSFT(NMIX,IS)
+ 370         CONTINUE
+           ENDIF
+           PW(NPS)=POWER(NMIX)
+         ENDIF
+*        D. Rozon 'Introduction a la Cinetique des Reacteur Nucleaires'
+*        Edition E.P., 1992. (p.217) or 1998 (p.185)
+*        PW is assumed to be in kW.
+         IF(IPROF2.GT.0) THEN
+           TF = PTFUEL(NMIX)
+         ELSE
+           TF= TC + 0.476*PW(NPS) + 2.267*PW(NPS)*PW(NPS)*1.0E-04
+         ENDIF
+C INITIAL CONCENTRATIONS
+         ZXREF=0.0
+         SM=0.0
+         ZRNP9=0.0
+*      IF FUEL
+         IF(JTAB(1).EQ.1) THEN
+* BURNUP LOCALISATION FOR XENON AND FISSION X-SECTION INTERPOLATION
+           IF(LTAV) THEN
+             XIFL=XBURN(IRAV,IDF)
+             IMAXX=IRAV
+             IMINX=IRAV
+             XCOF(1)=1.0D0
+             XCOF(2)=0.0D0
+             XCOF(3)=0.0D0
+           ELSE
+             XIFL=BRH(NPS)
+             CALL AFMLOC(NBURN,NTP,BRH(NPS),BRH(NPS),XBURN(1,IDF),
+     1                 IMAXX,IMINX,XCOF,ILIN)
+           ENDIF
+*
+           DO 380 IGR = 1,NGRP
+             XSIGX(IGR)=0.0
+             XFLUN(IGR)=0.0
+             XSIGF(IGR)=0.0
+  380       CONTINUE
+*       INTERPOLATION OF THE CONCENTRATION
+*
+           IIX=0
+           DO 395 I = IMINX,IMAXX
+             IIX=IIX+1
+             RXCOF=REAL(XCOF(IIX))
+             ZXREF=DENSITB(IXENO,I,IDF)*RXCOF  +ZXREF
+             XEN=ZXREF
+             SM=DENSITB(ISAMA,I,IDF)*RXCOF     +SM
+             ZRNP9=DENSITB(INEPT,I,IDF)*RXCOF  +ZRNP9
+             RNP9=ZRNP9
+*
+             DO 390 IGR=1,NGRP
+               XSIGX(IGR)=SMACB(IGR,2,IXENO,I,IDF)*RXCOF
+     1                    + XSIGX(IGR)
+               XFLUN(IGR)=FLUXB(IGR,I,IDF)*RXCOF     + XFLUN(IGR)
+               XSIGF(IGR)=SMACB(IGR,5,1,I,IDF)*RXCOF + XSIGF(IGR)
+  390        CONTINUE
+  395       CONTINUE
+           IF(LDRAH.AND.IHISTO.GT.0) THEN
+             IF(PW(NPS).GT.PWREF) THEN
+               XPW=ALOG(PW(NPS)/PW(1))
+               XPWM=1.0/PW(NPS)-1.0/PW(1)
+               IFH=1
+             ELSE
+               XPW=PW(NPS)-PW(1)
+               XPWM=(PW(NPS)-PW(1))**2
+               IFH=2
+             ENDIF
+C
+             XEN  =ZXREF
+             RNP9 =ZRNP9
+             IIX=0
+             DO 400 I = IMINX,IMAXX
+               IIX=IIX+1
+               RXCOF=REAL(XCOF(IIX))
+*            COMPUTE XENON-SAMRIUM-NEPTUNIUM CONCENTRATION USING DRAGON
+               XEN  =XEN   +HXEN1(IFH,I,IDF)*XPW*RXCOF+
+     1                      HXEN2(IFH,I,IDF)*XPWM*RXCOF
+               SM  =SM     +HSAM1(IFH,I,IDF)*XPW*RXCOF+
+     1                      HSAM2(IFH,I,IDF)*XPWM*RXCOF
+               RNP9 =RNP9  +HNEP1(IFH,I,IDF)*XPW*RXCOF+
+     1                      HNEP2(IFH,I,IDF)*XPWM*RXCOF
+ 400         CONTINUE
+           ELSE IF(ILBFLU.NE.0.AND.XIFL.NE.0.0) THEN
+*          COMPUTE THE XENON AND NEPTUNIUM CONCENTRATIONS
+              CALL AFMXNC(NGRP,XSIGX,XSIGF,BFLUX(1,NMIX),
+     1                   XEN,RNP9,XFLUN)
+           ENDIF
+* COMPUTE THE XENON AND NEPTUNIUM CONCENTRATIONS
+           IF(LXENON) XEN=FXEN
+           IF(LSAM) SM=FSAM
+           IF(LNEP) RNP9=FNEP
+           IF(LXEREF) XEN=ZXREF
+           IF(LNEREF) RNP9=ZRNP9
+           IF(LTFUEL) THEN
+!       fuel temperature as input
+             TF=TFU
+!       reference fuel temperature 
+           ELSEIF(LMCR) THEN
+             TF=TFR
+           ENDIF
+         ENDIF
+*---------------------------------------------------------------*
+* XSECTION CALCULATION
+*---------------------------------------------------------------*
+         CALL AFMCPT(KENTRY,NBURN,NGRP,NISO,
+     1   NL,IMPX,SMACB,XBORB,XPURB,XXENB,XT1FB,XT2FB,XT1CB,
+     1   XT2CB,XT1MB,XT2MB,XD1CB,XD2CB,XD1MB,XD2MB,
+     1   XSMB,XNP9B,XMFDB,XMMDB,XPF1B,XPF2B,XPF1LB,XPF2LB,
+     1   DENSITB,CPW1B,CPW2B,FLUXB,OVERVB,CHIB,
+     1   IJ,NJ,HISO,CTITRE,
+     1   NMIX,SIGMA,NTYP,TF,TC,TM,DC,DM,BOR,XEN,SM,RNP9,XI,
+     1   TFR,TCR,TMR,XIR,OVERV,FLUX,CHI,SCAT,MX,NPS,PW,BRH,
+     1   XBURN,LTAV,IRAV,IDF,JTAB,IXYZ,ILIN)
+*---------------------------------------------------------------*
+*
+         DO 420 IGR=1,NGRP
+          FLUAV(JR,IGR)=FLUX(NMIX,IGR)
+          DO 410 ITY=1,NTM+1
+            SIGAV(JR,IGR,ITY)=SIGMA(NMIX,IGR,ITY)
+ 410     CONTINUE
+ 420     CONTINUE
+         IL =1
+         DO 440 IGR=1,NGRP
+            DO 430 JGR=1,NGRP
+              SCATAV(JR,IL,JGR,IGR)=SCAT(NMIX,IL,JGR,IGR)
+ 430        CONTINUE
+ 440     CONTINUE
+ 450    CONTINUE
+        IF(LTAV) THEN
+* COMPUTE  TIME AVERAGED X-SECTIONS
+          DO 470 IGR=1,NGRP
+            CALL AFMTAV(NBURN,ITM,XBMAX,XBMIN,FLUAV(1,IGR),IMIN,IMAX,
+     1      XBURN,FLUX(NMIX,IGR))
+            DO 460 ITY=1,NTM+1
+              CALL AFMTAV(NBURN,ITM,XBMAX,XBMIN,SIGAV(1,IGR,ITY),IMIN,
+     1        IMAX,XBURN,SIGMA(NMIX,IGR,ITY))
+ 460      CONTINUE
+ 470      CONTINUE
+*
+          DO 490 IGR=1,NGRP
+           DO 480 JGR=1,NGRP
+               IL=1
+               CALL AFMTAV(NBURN,ITM,XBMAX,XBMIN,SCATAV(1,IL,IGR,JGR),
+     1         IMIN,IMAX,XBURN,SCAT(NMIX,IL,IGR,JGR))
+ 480      CONTINUE
+ 490      CONTINUE
+*
+        ENDIF
+* COMPUTE DIRECTIONAL DIFFUSION COEFFICIENTS FROM STRD
+*  X-SECTIONS.
+        IF(IXYZ.EQ.0) THEN
+          DO 500 IGR=1,NGRP
+            DIFFX(NMIX,IGR)=1.0/(3.0*SIGMA(NMIX,IGR,1))
+ 500      CONTINUE
+          ILEAK=1
+        ELSE IF(IXYZ.EQ.1) THEN
+          DO 510 IGR=1,NGRP
+            DIFFX(NMIX,IGR)=1.0/(3.0*SIGMA(NMIX,IGR,1))
+            DIFFY(NMIX,IGR)=1.0/(3.0*SIGMA(NMIX,IGR,5))
+            DIFFZ(NMIX,IGR)=1.0/(3.0*SIGMA(NMIX,IGR,6))
+            ILEAK=2
+ 510      CONTINUE
+        ENDIF
+*
+        IL=1
+        DO 530 IGR=1,NGRP
+            NJJ(NMIX,IL,IGR)=NJ(IGR)
+            IJJ(NMIX,IL,IGR)=IJ(IGR)
+            IF(LMCR) THEN
+              DO 520 NI=1,MMIX
+                NJJ(NI,IL,IGR)=NJ(IGR)
+                IJJ(NI,IL,IGR)=IJ(IGR)
+ 520          CONTINUE
+            ENDIF
+ 530    CONTINUE
+* MIX LOOP
+ 540  CONTINUE
+*
+      IF(LTAV) THEN
+        IF(IMPX.GE.1.AND.ITM.EQ.1) WRITE(6,707)
+        IF(IMPX.GE.1.AND.ITM.EQ.2) WRITE(6,708)
+        IF(IMPX.GE.1.AND.ITM.EQ.3) WRITE(6,709)
+      ENDIF
+*---------------------------------------------------------------*
+*        DECOMPRESS BURN ZONE FOR ALL THE BUNDLES
+      IF(ISC.EQ.3) THEN
+       MMIX=NBCH*NCCO
+       DO 870 IGR=1,NGRP
+        DO 550 IZ=1,NCZO
+            WORK(IZ)=DIFFX(IZ,IGR)
+ 550    CONTINUE
+        DO 570 IC=1,NCCO
+          DO 560 IB=1,NBCH
+            ICB=NBCH*(IC-1)+IB
+            DIFFX(ICB,IGR)=WORK(IZONE(IC))
+ 560      CONTINUE
+ 570    CONTINUE
+*
+        IF(ILEAK.EQ.2) THEN
+          DO 580 IZ=1,NCZO
+            WORK(IZ)=DIFFY(IZ,IGR)
+ 580      CONTINUE
+          DO 600 IC=1,NCCO
+           DO 590 IB=1,NBCH
+             ICB=NBCH*(IC-1)+IB
+             DIFFY(ICB,IGR)=WORK(IZONE(IC))
+ 590       CONTINUE
+ 600      CONTINUE
+*
+          DO 610 IZ=1,NCZO
+            WORK(IZ)=DIFFZ(IZ,IGR)
+ 610      CONTINUE
+          DO 630 IC=1,NCCO
+           DO 620 IB=1,NBCH
+             ICB=NBCH*(IC-1)+IB
+             DIFFZ(ICB,IGR)=WORK(IZONE(IC))
+ 620       CONTINUE
+ 630      CONTINUE
+        ENDIF
+*
+        DO 670 ITY=2,NTM+1
+         DO 640 IZ=1,NCZO
+           WORK(IZ)=SIGMA(IZ,IGR,ITY)
+ 640     CONTINUE
+         DO 660 IC=1,NCCO
+          DO 650 IB=1,NBCH
+            ICB=NBCH*(IC-1)+IB
+            SIGMA(ICB,IGR,ITY)=WORK(IZONE(IC))
+ 650      CONTINUE
+ 660     CONTINUE
+ 670    CONTINUE
+*
+        DO 680 IZ=1,NCZO
+          WORK(IZ)=FLUX(IZ,IGR)
+ 680    CONTINUE
+        DO 700 IC=1,NCCO
+         DO 690 IB=1,NBCH
+           ICB=NBCH*(IC-1)+IB
+           FLUX(ICB,IGR)=WORK(IZONE(IC))
+ 690     CONTINUE
+ 700    CONTINUE
+*
+        DO 710 IZ=1,NCZO
+          WORK(IZ)=OVERV(IZ,IGR)
+ 710    CONTINUE
+        DO 730 IC=1,NCCO
+         DO 720 IB=1,NBCH
+           ICB=NBCH*(IC-1)+IB
+           OVERV(ICB,IGR)=WORK(IZONE(IC))
+ 720     CONTINUE
+ 730    CONTINUE
+*
+        DO 740 IZ=1,NCZO
+          WORK(IZ)=CHI(IZ,IGR)
+ 740    CONTINUE
+        DO 760 IC=1,NCCO
+         DO 750 IB=1,NBCH
+           ICB=NBCH*(IC-1)+IB
+           CHI(ICB,IGR)=WORK(IZONE(IC))
+ 750     CONTINUE
+ 760    CONTINUE
+*
+        IL=1
+        DO 800 JGR=1,NGRP
+           DO 770 IZ=1,NCZO
+             WORK(IZ)=SCAT(IZ,IL,IGR,JGR)
+ 770       CONTINUE
+           DO 790 IC=1,NCCO
+            DO 780 IB=1,NBCH
+              ICB=NBCH*(IC-1)+IB
+              SCAT(ICB,IL,IGR,JGR)=WORK(IZONE(IC))
+ 780        CONTINUE
+ 790       CONTINUE
+ 800     CONTINUE
+*
+         DO 810 IZ=1,NCZO
+           IWORK(IZ)=NJJ(IZ,IL,IGR)
+ 810     CONTINUE
+         DO 830 IC=1,NCCO
+          DO 820 IB=1,NBCH
+            ICB=NBCH*(IC-1)+IB
+            NJJ(ICB,IL,IGR)=IWORK(IZONE(IC))
+ 820      CONTINUE
+ 830     CONTINUE
+*
+         DO 840 IZ=1,NCZO
+           IWORK(IZ)=IJJ(IZ,IL,IGR)
+ 840     CONTINUE
+         DO 860 IC=1,NCCO
+          DO 850 IB=1,NBCH
+            ICB=NBCH*(IC-1)+IB
+            IJJ(ICB,IL,IGR)=IWORK(IZONE(IC))
+ 850      CONTINUE
+ 860     CONTINUE
+*
+ 870   CONTINUE
+*
+       DO 880 IZ=1,NCZO
+         WORK(IZ)=VOL(IZ)
+ 880   CONTINUE
+       DO 900 IC=1,NCCO
+        DO 890 IB=1,NBCH
+          ICB=NBCH*(IC-1)+IB
+          VOL(ICB)=WORK(IZONE(IC))
+ 890    CONTINUE
+ 900   CONTINUE
+*
+      ENDIF
+*---
+* STORE MACROLIB INFORMATIONS
+*---
+      IF(ITYPE.EQ.0)THEN
+        CALL LCMPUT(IPMACX,'VOLUME',MMIX,2,VOL)
+        CALL LCMPUT(IPMACX,'ENERGY',NGRP+1,2,ENER)
+      ENDIF
+*
+      IF(LMCR) THEN
+        STORE=VOL(MMIX)
+        VOL(MMIX)= 0.0
+*  MACROLIB EN MODIFICATION
+        IF(ITYPE.NE.0) THEN
+           CALL LCMGET(IPMACX,'VOLUME',VOL)
+        ENDIF
+        VOL(KTYP(1)) = STORE
+        CALL LCMPUT(IPMACX,'VOLUME',MMIX,2,VOL)
+        JPMAC=LCMLID(IPMACX,'GROUP',NGRP)
+        DO 950 JGR=1,NGRP
+          KPMAC=LCMDIL(JPMAC,JGR)
+          STORE=SIGMA(MMIX,JGR,2)
+          SIGMA(MMIX,JGR,2) = 0.0
+*  MACROLIB EN MODIFICATION
+          IF(ITYPE.NE.0) THEN
+            CALL LCMGET(KPMAC,'NTOT0',SIGMA(1,JGR,2))
+          ENDIF
+          SIGMA(KTYP(1),JGR,2) = STORE
+*
+          STORE=OVERV(MMIX,JGR)
+          OVERV(MMIX,JGR) = 0.0
+*  MACROLIB EN MODIFICATION
+          IF(ITYPE.NE.0) THEN
+            CALL LCMGET(KPMAC,'OVERV',OVERV(1,JGR))
+          ENDIF
+          OVERV(KTYP(1),JGR) = STORE
+*
+          STORE=DIFFX(MMIX,JGR)
+          DIFFX(MMIX,JGR) = 0.0
+*  MACROLIB EN MODIFICATION
+          IF(ITYPE.NE.0) THEN
+             CALL LCMGET(KPMAC,'DIFFX',DIFFX(1,JGR))
+          ENDIF
+          DIFFX(KTYP(1),JGR) = STORE
+*
+          IF(ILEAK.EQ.2) THEN
+            STORE=DIFFY(MMIX,JGR)
+            DIFFY(MMIX,JGR) = 0.0
+            IF(ITYPE.NE.0) THEN
+               CALL LCMGET(KPMAC,'DIFFY',DIFFY(1,JGR))
+            ENDIF
+            DIFFY(KTYP(1),JGR) = STORE
+*
+            STORE=DIFFZ(MMIX,JGR)
+            DIFFZ(MMIX,JGR) = 0.0
+            IF(ITYPE.NE.0) THEN
+               CALL LCMGET(KPMAC,'DIFFZ',DIFFZ(1,JGR))
+            ENDIF
+            DIFFZ(KTYP(1),JGR) = STORE
+          ENDIF
+*
+          STORE = FLUX(MMIX,JGR)
+          FLUX(MMIX,JGR) = 0.0
+          IF(ITYPE.NE.0) THEN
+             CALL LCMGET(KPMAC,'FLUX-INTG',FLUX(1,JGR))
+          ENDIF
+          FLUX(KTYP(1),JGR) = STORE
+*
+          IF(JTAB(1).EQ.1 .OR. ITYPE.NE.0) THEN
+            STORE = CHI(MMIX,JGR)
+            CHI(MMIX,JGR) = 0.0
+            IF(ITYPE.NE.0) THEN
+              CALL LCMGET(KPMAC,'CHI',CHI(1,JGR))
+            ENDIF
+            CHI(KTYP(1),JGR) = STORE
+*
+            STORE=SIGMA(MMIX,JGR,3)
+            SIGMA(MMIX,JGR,3) = 0.0
+            IF(ITYPE.NE.0) THEN
+              CALL LCMGET(KPMAC,'NUSIGF',SIGMA(1,JGR,3))
+            ENDIF
+            SIGMA(KTYP(1),JGR,3) = STORE
+*
+            STORE=SIGMA(MMIX,JGR,5)
+            SIGMA(MMIX,JGR,5) = 0.0
+            IF(ITYPE.NE.0) THEN
+              CALL LCMGET(KPMAC,'NFTOT',SIGMA(1,JGR,5))
+            ENDIF
+            SIGMA(KTYP(1),JGR,5) = STORE
+*
+            STORE=SIGMA(MMIX,JGR,4)
+            SIGMA(MMIX,JGR,4) = 0.0
+            IF(ITYPE.NE.0) THEN
+              CALL LCMGET(KPMAC,'H-FACTOR',SIGMA(1,JGR,4))
+            ENDIF
+            SIGMA(KTYP(1),JGR,4) = STORE
+*
+          ENDIF
+*
+          IL=1
+          ALLOCATE(SSCAT(NGRP))
+          DO 910 IGR=1,NGRP
+            SSCAT(IGR)= SCAT(MMIX,IL,IGR,JGR)
+            SCAT(MMIX,IL,IGR,JGR) = 0.0
+ 910      CONTINUE
+          IF(ITYPE.NE.0) THEN
+!!  ATTENTION isotropy is supposed
+!!
+            IL=1
+            WRITE (CM,'(I2.2)') IL-1
+            CALL LCMGET(KPMAC,'SCAT'//CM,WORK)
+            CALL LCMGET(KPMAC,'NJJS'//CM,NJJ(1,IL,JGR))
+            CALL LCMGET(KPMAC,'IJJS'//CM,IJJ(1,IL,JGR))
+            CALL LCMGET(KPMAC,'IPOS'//CM,IPOS)
+            DO 930 IBM=1,MMIX
+               IJJ0=IJJ(IBM,IL,JGR)
+               IPOSDE = IPOS(IBM)
+               DO 920 IGR=IJJ0,IJJ0-NJJ(IBM,IL,JGR)+1,-1
+                SCAT(IBM,IL,IGR,JGR)=WORK(IPOSDE)
+                IPOSDE=IPOSDE+1
+ 920           CONTINUE
+ 930        CONTINUE
+          ENDIF
+*
+          DO 940 IGR=1,NGRP
+            SCAT(KTYP(1),IL,IGR,JGR) = SSCAT(IGR)
+ 940      CONTINUE
+          DEALLOCATE(SSCAT)
+ 950    CONTINUE
+      ENDIF
+*
+      DO 990 IX=1,MMIX
+       DO 980 JGR=1,NGRP
+        DO 970 IL=1,NL
+          IGMIN=JGR
+          IGMAX=JGR
+          DO 960 IGR=NGRP,1,-1
+           IF (SCAT(IX,IL,IGR,JGR).NE.0.0) THEN
+             IGMIN=MIN(IGMIN,IGR)
+             IGMAX=MAX(IGMAX,IGR)
+           ENDIF
+  960     CONTINUE
+          IJJ(IX,IL,JGR)=IGMAX
+          NJJ(IX,IL,JGR)=IGMAX-IGMIN+1
+  970   CONTINUE
+  980  CONTINUE
+  990 CONTINUE
+*
+      SIGS(:MMIX,:NGRP)=0.0
+      JPMAC=LCMLID(IPMACX,'GROUP',NGRP)
+      DO 1002 JGR=1,NGRP
+        KPMAC=LCMDIL(JPMAC,JGR)
+        CALL LCMPUT(KPMAC,'NTOT0',MMIX,2,SIGMA(1,JGR,2))
+        CALL LCMPUT(KPMAC,'OVERV',MMIX,2,OVERV(1,JGR))
+        IF(ILEAK.EQ.1) THEN
+          CALL LCMPUT(KPMAC,'DIFF',MMIX,2,DIFFX(1,JGR))
+        ELSE IF(ILEAK.EQ.2) THEN
+          CALL LCMPUT(KPMAC,'DIFFX',MMIX,2,DIFFX(1,JGR))
+          CALL LCMPUT(KPMAC,'DIFFY',MMIX,2,DIFFY(1,JGR))
+          CALL LCMPUT(KPMAC,'DIFFZ',MMIX,2,DIFFZ(1,JGR))
+        ENDIF
+        CALL LCMPUT(KPMAC,'FLUX-INTG',MMIX,2,FLUX(1,JGR))
+        IF(JTAB(1).EQ.1 .OR. ITYPE.NE.0) THEN
+          CALL LCMPUT(KPMAC,'CHI   ',MMIX,2,CHI(1,JGR))
+          CALL LCMPUT(KPMAC,'NUSIGF   ',MMIX,2,SIGMA(1,JGR,3))
+          ! Caution: H-FACTORS are J-barn. Convert them to eV-barn
+          SIGMA(:MMIX,JGR,4)=SIGMA(:MMIX,JGR,4)/REAL(EVJ)
+          CALL LCMPUT(KPMAC,'H-FACTOR',MMIX,2,SIGMA(1,JGR,4))
+          CALL LCMPUT(KPMAC,'NFTOT',MMIX,2,SIGMA(1,JGR,5))
+        ENDIF
+*
+        IL=1
+        WRITE (CM,'(I2.2)') IL-1
+        IPOSDE=0
+        DO 1001 IX=1,MMIX
+          IPOS(IX)=IPOSDE+1
+          DO 1000 IGR=IJJ(IX,IL,JGR),IJJ(IX,IL,JGR)-NJJ(IX,IL,JGR)+1,-1
+             IPOSDE=IPOSDE+1
+             WORK(IPOSDE)=SCAT(IX,IL,IGR,JGR)
+             SIGS(IX,IGR)=SIGS(IX,IGR)+ SCAT(IX,IL,IGR,JGR)
+ 1000   CONTINUE
+ 1001   CONTINUE
+*
+        CALL LCMPUT(KPMAC,'SCAT'//CM,IPOSDE,2,WORK)
+        CALL LCMPUT(KPMAC,'IPOS'//CM,MMIX,1,IPOS)
+        CALL LCMPUT(KPMAC,'NJJS'//CM,MMIX,1,NJJ(1,IL,JGR))
+        CALL LCMPUT(KPMAC,'IJJS'//CM,MMIX,1,IJJ(1,IL,JGR))
+        CALL LCMPUT(KPMAC,'SIGW'//CM,MMIX,2,SCAT(1,IL,JGR,JGR))
+ 1002 CONTINUE
+      DO 1003 JGR=1,NGRP
+        KPMAC=LCMDIL(JPMAC,JGR)
+        IL=1
+        WRITE (CM,'(I2.2)') IL-1
+        CALL LCMPUT(KPMAC,'SIGS'//CM,MMIX,2,SIGS(1,JGR))
+ 1003 CONTINUE
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(XPURB,XPF2LB,XPF1LB,XPF2B,XPF1B,XMMDB,XMFDB,XNP9B,
+     1 XSMB,XD2MB,XD1MB,XD2CB,XD1CB,XT2MB,XT1MB,XT2CB,XT1CB,XT2FB,XT1FB,
+     2 XXENB,XBORB,SMACB)
+      DEALLOCATE(ITEXTR,PTFUEL,PTCOOL,PDCOOL,ISFT,PSFT,BSFT,XFLUN,XSIGX,
+     1 XSIGF,KTYP,INDEX,OVERVB,CHIB,JTAB,FLUXB,CPW2B,CPW1B,HNEP2,HNEP1,
+     2 HSAM2,HSAM1,HXEN2,HXEN1,HISO,DENSITB,BFLUX,NJ,BRH,PW,SCATAV,
+     3 IWORK,SIGAV,FLUAV,POWER,BURED,BURBG,IZONE,WORK,IJ,DIFFZ,DIFFY,
+     4 DIFFX,SCAT,IPOS,ENER,CHI,FLUX,SIGS,OVERV,XBURN,NJJ,VOL,IJJ,SIGMA)
+      RETURN
+*
+  699 FORMAT(/' AFMDRV: THE CROSS SECTIONS ARE GENERATED FOR A',
+     1 ' TIME AVERAGE CALCULATION.')
+  701 FORMAT(/' AFMDRV: THE CROSS SECTIONS ARE GENERATED FOR A',
+     1 ' SNAPSHOT CALCULATION.')
+  702 FORMAT(/' AFMDRV: POWER ARE RECOVERED FROM L_MAP.')
+  703 FORMAT(/' AFMDRV: FLUX  ARE RECOVERED FROM L_MAP.')
+  704 FORMAT(/' AFMDRV: BUNDLES POWER SHIFT ARE CORRECTED.')
+  705 FORMAT(/' AFMDRV: BUNDLES POWER = ',F12.2,1X,'KW IS FIXED',
+     1 ' BY THE USER.')
+  706 FORMAT(/' AFMDRV: BUNDLES XENON = ',E15.8,1X,'IS FIXED',
+     1 ' BY THE USER.')
+  707 FORMAT(/' AFMDRV: LAGRANGE INTERPOLATION IS USED TO COMPUTE',
+     1 ' TIME AVERAGED CROSS SECTIONS.')
+  708 FORMAT(/' AFMDRV: SPLINE 3 INTERPOLATION IS USED TO COMPUTE',
+     1 ' TIME AVERAGED CROSS SECTIONS.')
+  709 FORMAT(/' AFMDRV: HERMITE 3 INTERPOLATION IS USED TO COMPUT',
+     1 'E TIME AVERAGED CROSS SECTIONS.')
+  711 FORMAT(/' AFMDRV: BUNDLES NEPTUNIUM = ',E15.8,1X,'IS FIXED',
+     1 ' BY THE USER.')
+  712 FORMAT(/' AFMDRV: NOMINAL XENON IS USED.')
+  713 FORMAT(/' AFMDRV: NOMINAL NEPTUNIUM IS USED.')
+  714 FORMAT(/' AFMDRV: BUNDLES TFUEL = ',F12.2,1X,'K IS FIXED',
+     1 ' BY THE USER.')
+  715 FORMAT(/' AFMDRV: DRAGON CONCENTRATIONS ARE USED (XE135'
+     1 //' NP239, SM149).')
+  716 FORMAT(/' AFMDRV: ',A12,' PROFILES ARE RECOVERED FROM L_MAP.',
+     1 ' PARKEY=',A12)
+  717 FORMAT(/' AFMDRV: BUNDLES COOL. TEMP. TCOOL = ',F12.2,1X,
+     1 'K IS FIXED BY THE USER.')
+  718 FORMAT(/' AFMDRV: BUNDLES COOL. DENSITY RDCL = ',F12.9,1X,
+     1 'K IS FIXED BY THE USER.')
+  719 FORMAT(/' AFMDRV: BUNDLES SAMARIUM = ',E15.8,1X,'IS FIXED',
+     1 ' BY THE USER.')
+      END
diff --git a/Donjon/src/AFMLOC.f b/Donjon/src/AFMLOC.f
new file mode 100644
index 0000000..746eb0d
--- /dev/null
+++ b/Donjon/src/AFMLOC.f
@@ -0,0 +1,120 @@
+*DECK AFMLOC
+      SUBROUTINE AFMLOC(NBURN,NTP,XBMAX,XBMIN,XBURN,MAX,MIN,COF,ILIN)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Burnup localisation and interpolation
+*
+*Copyright:
+* Copyright (C) 1996 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* M.T. Sissaoui
+*
+*Parameters: input
+*  NBURN  total number of burnup steps.
+*  XBURN  burnup steps dimemsion (NBURN).
+*  XBMAX  higher burnup value.
+*  XBMIN  lower burnup value.
+*
+*Parameters: output
+*  MAX    maximum burnup number
+*  MIN    minimum burnup number
+*  COF    interpolation coefficient (Lagrange)
+*
+*Parameters: 
+* NTP     
+* MAX     
+* MIN     
+* ILIN    
+*
+*---------------------------------------------------------------*
+*
+      DIMENSION XBURN(NBURN),ELMT(3)
+      DOUBLE PRECISION COF(3),XCOF(1)
+      NTP=2
+      COF(1)=0.0D0
+      COF(2)=0.0D0
+      COF(3)=0.0D0
+      IF(XBMAX.EQ.XBMIN) NTP=1
+      IF(XBMAX.GT.XBURN(NBURN)) THEN
+         WRITE(6,100) XBMAX,XBURN(NBURN)
+         CALL XABORT('AFMLOC: THE HIGHER BURNUP VALUE IS BEYOND'
+     1   //' THE MAXIMUM BURNUP IN THE DATABASE')
+      ELSE IF(NBURN.EQ.1.AND.NTP.EQ.2) THEN
+         CALL XABORT('AFMLOC: TIME AVERAGE CALCULATION REQUIRE'
+     1    //' AT LEAST TWO IRRADIATIONS STEPS')
+      ELSE IF(NBURN.EQ.1.AND.NTP.EQ.1) THEN
+         COF(1)=1.0D0
+         MIN=1
+         MAX=1
+      ELSE IF(NBURN.EQ.2) THEN
+         MIN=1
+         MAX=2
+         IF(NTP.EQ.1) THEN
+           XIRAD=XBMIN
+           IF(ILIN.EQ.1) THEN
+             NTOX=-1
+           ELSE
+             NTOX=2
+           ENDIF
+           NELE=2
+           ELMT(1)=XBURN(1)
+           ELMT(2)=XBURN(2)
+           CALL LIBLEX(NELE,XIRAD,ELMT,NTOX,XCOF(1))
+         ENDIF
+      ELSE IF(NBURN.GE.3) THEN
+         DO 85 IV=1,NTP
+           IF(IV.EQ.1) THEN
+             XIRAD=XBMIN
+           ELSE
+             XIRAD=XBMAX
+           ENDIF
+*
+           DO 80 I=2,NBURN
+             IF(XIRAD.GE.XBURN(I-1).AND.XIRAD.LE.XBURN(I)) THEN
+               IF(NTP.EQ.2) THEN
+                 IF(IV.EQ.1) THEN
+                   MIN=I-1
+                 ELSE
+                   IF(I+1.LE.NBURN) THEN
+                     MAX=I+1
+                   ELSE
+                    MAX=I
+                   ENDIF
+                 ENDIF
+               ELSE
+                 IF(I+1.LE.NBURN) THEN
+                   MIN=I-1
+                   MAX=I+1
+                 ELSE
+                   MIN=I-2
+                   MAX=I
+                 ENDIF
+               ENDIF
+             ENDIF
+ 80        CONTINUE
+ 85      CONTINUE
+         IF(NTP.EQ.1) THEN
+           IF(ILIN.EQ.1) THEN
+             NTOX=-1
+           ELSE
+             NTOX=3
+           ENDIF
+           NELE=3
+           ELMT(1)=XBURN(MAX-2)
+           ELMT(2)=XBURN(MAX-1)
+           ELMT(3)=XBURN(MAX)
+           CALL LIBLEX(NELE,XIRAD,ELMT,NTOX,COF(1))
+         ENDIF
+      ENDIF
+      RETURN
+*
+  100 FORMAT(/30H AFMLOC: MAXIMUM BURNUP VALUE=,1P,E12.4/
+     1  9X,25HMAXIMUM TABULATED BURNUP=,E12.4)
+      END
diff --git a/Donjon/src/AFMTAV.f b/Donjon/src/AFMTAV.f
new file mode 100644
index 0000000..481280f
--- /dev/null
+++ b/Donjon/src/AFMTAV.f
@@ -0,0 +1,173 @@
+*DECK AFMTAV
+      SUBROUTINE AFMTAV (NBURN,ITM,XBMAX,XBMIN,YS,NBMIN,NBMAX,XB,SIGAV)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Time average calculation using different approximation.
+*
+*Copyright:
+* Copyright (C) 1996 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* M.T. Sissaoui
+*
+*Parameters: input
+* NBURN  total number of steps.
+* ITM    type of the approximation (1-Lagrange;  2-spline; 3-Hermite)
+* XBMAX  highest value.
+* XBMIN  lower value.
+* YS     parameter to be integrated
+* NBMIN   
+* NBMAX   
+* XB     steps
+*
+*Parameters: output
+* SIGAV  average value of YS
+*
+*-----------------------------------------------------------------------
+*
+      REAL YS(NBURN),XB(NBURN),SIGAV
+      REAL UU(2)
+      DOUBLE PRECISION DD
+      REAL, ALLOCATABLE, DIMENSION(:) :: Y,U
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(Y(NBURN),U(NBURN))
+*
+      IF(NBMAX.GT.0) THEN
+        INMAX=NBMAX-2
+        INMIN=NBMIN
+      ELSE
+        INMAX=ABS(NBMAX)-1
+        INMIN=NBMIN
+        IF(ITM.EQ.1)
+     1  CALL XABORT('AFMTAV: MORE BURNUP STEPS ARE REQUIRED TO USE '
+     1 //' LAGRANGE METHOD, CHOOSE HERMIT OR SPLINE METHOD')
+      ENDIF
+      IF(ABS(NBMAX).GT.NBMIN) THEN
+        SIGAV=0.0
+*
+        IF(ITM.EQ.1) THEN
+* TIME AVERAGE CALCULATION USING LAGRANGE APPROXIMATION.
+*
+          DO 113 IR=INMIN,INMAX
+            I1=IR
+            I2=IR+1
+            I3=IR+2
+            XBI=MAX(XBMIN,XB(IR))
+            XBF=MIN(XBMAX,XB(IR+1))
+            TX=XBF-XBI
+            TX2=XBF**2-XBI**2
+            TX3=XBF**3-XBI**3
+            X12=XB(I1)-XB(I2)
+            X13=XB(I1)-XB(I3)
+            X23=XB(I2)-XB(I3)
+            XA12=XB(I1)+XB(I2)
+            XA13=XB(I1)+XB(I3)
+            XA23=XB(I2)+XB(I3)
+            XM12=XB(I1)*XB(I2)
+            XM13=XB(I1)*XB(I3)
+            XM23=XB(I2)*XB(I3)
+            Y1=YS(I1)/(X12*X13)
+            Y2=-YS(I2)/(X12*X23)
+            Y3=YS(I3)/(X13*X23)
+*
+            SIGAV=SIGAV +
+     1               Y1*(TX3/3.0-XA23*TX2/2.0+XM23*TX)+
+     1               Y2*(TX3/3.0-XA13*TX2/2.0+XM13*TX)+
+     1               Y3*(TX3/3.0-XA12*TX2/2.0+XM12*TX)
+ 113      CONTINUE
+*
+        ELSE IF(ITM.EQ.2) THEN
+* TIME AVERAGE CALCULATION USING SPLINE APPROXIMATION.
+*     THE LOWER BOUNDARY CONDITION IS SET TO BE NATURAL
+          Y(1)=0.0
+          U(1)=0.0
+*     THE UPPER BOUNDARY CONDITION IS SET EITHER TO BE NATURAL
+          QN=0.0
+          UN=0.0
+*
+          DO 103 IR=2,NBURN-1
+            SIG=(XB(IR)-XB(IR-1))/(XB(IR+1)-XB(IR-1))
+            P=SIG*Y(IR-1)+2.0
+            Y(IR)=(SIG-1.0)/P
+            U(IR)=(6.*((YS(IR+1)-YS(IR))/(XB(IR+1)-XB(IR))-
+     1            (YS(IR)-YS(IR-1))/(XB(IR)-XB(IR-1)))/(XB(IR+1)-
+     1            XB(IR-1))-SIG*U(IR-1))/P
+ 103      CONTINUE
+*
+          Y(NBURN)=(UN-QN*U(NBURN-1))/(QN*Y(NBURN-1)+1.0)
+*
+          DO 104 K=NBURN-1,1,-1
+            Y(K)=Y(K)*Y(K+1)+U(K)
+ 104      CONTINUE
+*
+*  COMPUTE THE INTEGRAL OF THE X-SECTION
+          INMAX=NBMAX-2
+          INMIN=NBMIN
+          DO 300 IR=INMIN,INMAX
+            H=XB(IR+1)-XB(IR)
+            XBI=MAX(XBMIN,XB(IR))
+            XBF=MIN(XBMAX,XB(IR+1))
+*
+            DB=XBF-XBI
+            HF=XB(IR+1)-XBF
+            HI=XB(IR+1)-XBI
+*
+            AI=-0.5*(HF**2-HI**2)/H
+            BI=DB-AI
+            CI=-(AI/6)*H**2-(HF**4-HI**4)/(24*H)
+            DI=-(BI/6)*H**2-(HF**4-HI**4)/(24*H)
+*
+            SIGAV=SIGAV+AI*YS(IR)+BI*YS(IR+1)+
+     1               CI*Y(IR)+DI*Y(IR+1)
+  300     CONTINUE
+        ELSE IF(ITM.EQ.3) THEN
+* TIME AVERAGE CALCULATION USING HERMIT APPROXIMATION.
+          DO 101 I=1,NBURN
+            Y(I)=YS(I)
+  101     CONTINUE
+* TAKE THE DERIVATIVE WITH RESPECT TO BURNUP OR NEUTRON EXPOSURE AT
+* TABULATION POINTS.
+          CALL ALDERV(NBURN,XB,Y)
+*
+*  COMPUTE THE INTEGRAL OF THE X-SECTION
+          DD=0.0D0
+          DO 200 IR=1,NBURN-1
+          IF((XBMIN.LT.XB(IR+1)).AND.(XBMAX.GT.XB(IR))) THEN
+            DX=XB(IR+1)-XB(IR)
+            XBI=MAX(XBMIN,XB(IR))
+            XBF=MIN(XBMAX,XB(IR+1))
+            CC=0.5*(XBF-XBI)
+            U1=(XBI-0.5*(XB(IR)+XB(IR+1)))/DX
+            U2=(XBF-0.5*(XB(IR)+XB(IR+1)))/DX
+            UU(1)=0.5*(-(U2-U1)*0.577350269189626+U1+U2)
+            UU(2)=0.5*((U2-U1)*0.577350269189626+U1+U2)
+            DO 190 J=1,2
+            H1=3.0*(0.5-UU(J))**2-2.0*(0.5-UU(J))**3
+            H2=(0.5-UU(J))**2-(0.5-UU(J))**3
+            H3=3.0*(0.5+UU(J))**2-2.0*(0.5+UU(J))**3
+            H4=-(0.5+UU(J))**2+(0.5+UU(J))**3
+            DD=DD+(H1*YS(IR)+H2*Y(IR)*DX+H3*YS(IR+1)+
+     1      H4*Y(IR+1)*DX)*CC
+  190       CONTINUE
+          ENDIF
+  200     CONTINUE
+          SIGAV=REAL(DD)
+        ENDIF
+        SIGAV=SIGAV/(XBMAX-XBMIN)
+      ELSE
+        SIGAV=YS(NBMIN)
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(U,Y)
+      RETURN
+      END
diff --git a/Donjon/src/AFMXNC.f b/Donjon/src/AFMXNC.f
new file mode 100644
index 0000000..62986eb
--- /dev/null
+++ b/Donjon/src/AFMXNC.f
@@ -0,0 +1,59 @@
+*DECK AFMXNC
+          SUBROUTINE AFMXNC (NGRP,SIGX,SIGF,FLUX,XXE,XNP,FLUR)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Computation of Xenon and Neptunium concentrations.
+*
+*Copyright:
+* Copyright (C) 1996 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* M.T. Sissaoui
+*
+*Parameters: input
+* NGRP
+* SIGX  Xenon absorption micro-x-section dimension (ngrp).
+* SIGF  fission macro-x-section dimension (ngrp).
+* FLUX  flux dimension (ngrp)
+*
+*Parameters: output
+* XXE   Xenon concentration
+* XNP   Neptunium concentration
+* FLUR
+*
+*-----------------------------------------------------------------------
+*
+      DIMENSION FLUX(NGRP),SIGF(NGRP),SIGX(NGRP),FLUR(NGRP)
+      REAL      CF
+* SET THE YIELD AND THE DECAY CONSTANTE FOR XENON AND NEPTUNIUM
+      XLAMBDAX = 2.09E-5
+      XLAMBDAI = 2.85E-5
+      GAMMAI = 0.0631
+      GAMMAX = 0.0045
+* CF=1.E-24(barn)
+      CF=1.0E-24
+      CINTG=1.0E+13
+*  CALCUL DES TAUX DE FISSION
+      TAUF=0.0
+      TAUAX=0.0
+      FLR=0.0
+      FLX=0.0
+      DO 10 IGR = 1,NGRP
+        TAUF = TAUF+FLUX(IGR)*SIGF(IGR)
+        TAUAX = TAUAX+FLUX(IGR)*SIGX(IGR)
+        FLR=FLR+FLUR(IGR)*CINTG
+        FLX=FLX+FLUX(IGR)
+ 10   CONTINUE
+*  COMPUTE THE XENON CONCENTRATION
+      XXE=CF*(GAMMAX+GAMMAI)*TAUF/(XLAMBDAX+TAUAX*CF)
+*  COMPUTE THE NEPTUNIUM CONCENTRATION
+      XNP=XNP*FLX/FLR
+*
+      RETURN
+      END
diff --git a/Donjon/src/CRE.f b/Donjon/src/CRE.f
new file mode 100644
index 0000000..f6a53d7
--- /dev/null
+++ b/Donjon/src/CRE.f
@@ -0,0 +1,186 @@
+*DECK CRE

+      SUBROUTINE CRE(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Recover and interpolate a macrolib from one or many compo objects;

+* generate a fuel-map macrolib.

+*

+*Copyright:

+* Copyright (C) 2007 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* A. Hebert

+*

+*Parameters: input/output

+* NENTRY  number of data structures transfered to this module.

+* HENTRY  name of the data structures.

+* IENTRY  data structure type where:

+*         IENTRY=1 for LCM memory object;

+*         IENTRY=2 for XSM file;

+*         IENTRY=3 for sequential binary file;

+*         IENTRY=4 for sequential ASCII file.

+* JENTRY  access permission for the data structure where:

+*         JENTRY=0 for a data structure in creation mode;

+*         JENTRY=1 for a data structure in modifications mode;

+*         JENTRY=2 for a data structure in read-only mode.

+* KENTRY  data structure pointer.

+*

+*Comments:

+* The CRE: module specifications are:

+* Option 1: 

+* MACRO := CRE: [ MACRO ] [[ CPO ]]  :: (desccre1) ;

+* Option 2

+* MACFL := CRE: [[ CPO ]] FMAP :: (desccre2) ;

+* where

+*   MACRO : name of the \emph{macrolib}

+*     object to be created or updated for the few reactor material properties.

+*     Note that if MACRO appears on the RHS, the information previously

+*     stored in MACRO is kept.

+*   CPO   : name of the \emph{compo} 

+*     object containing the mono-parameter database from transport calculations.

+*   MACFL : name of the fuel-map \emph{macrolib}

+*     that will be created only for the fuel properties over the fuel lattice.

+*   FMAP  : name of the \emph{fmap} 

+*     object containing the fuel-map specification and burnup informations.

+*   (desccre1) : structure describing the input data to the CRE:

+*     module when the \emph{fmap} object is not specified.

+*   (desccre2) : structure describing the input data to the CRE:

+*     module for the fuel-map \emph{macrolib} construction.

+*

+*-----------------------------------------------------------------------

+*

+      USE GANLIB

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)

+      TYPE(C_PTR)  KENTRY(NENTRY)

+      CHARACTER    HENTRY(NENTRY)*12

+*----

+*  LOCAL VARIABLES

+*----

+      PARAMETER(NSTATE=40)

+      TYPE(C_PTR) IPMAC,IPMAP

+      CHARACTER TEXT*12,HSMG*131,HSIGN*12

+      INTEGER ISTATE(NSTATE)

+      LOGICAL LMAC

+      DOUBLE PRECISION DFLOT

+*----

+*  PARAMETER VALIDATION

+*----

+      IF(NENTRY.LE.1)CALL XABORT('@CRE: TWO PARAMETERS EXPECTED.')

+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2))CALL XABORT('@CRE'

+     1 //': LCM OBJECT EXPECTED AT LHS.')

+      IF(JENTRY(1).EQ.0)THEN

+        HSIGN='L_MACROLIB'

+        CALL LCMPTC(KENTRY(1),'SIGNATURE',12,HSIGN)

+        LMAC=.FALSE.

+      ELSEIF(JENTRY(1).EQ.1)THEN

+        CALL LCMGTC(KENTRY(1),'SIGNATURE',12,HSIGN)

+        IF(HSIGN.NE.'L_MACROLIB')THEN

+          TEXT=HENTRY(1)

+          CALL XABORT('@CRE: SIGNATURE OF '//TEXT//' IS '//HSIGN//

+     1  '. L_MACROLIB EXPECTED.')

+        ENDIF

+        LMAC=.TRUE.

+      ELSE

+        CALL XABORT('@CRE: MACROLIB IN CREATE OR MODIFICATION MOD'

+     1   //'E EXPECTED.')

+      ENDIF

+      IPMAC=KENTRY(1)

+      IF((IENTRY(2).NE.1).AND.(IENTRY(2).NE.2))CALL XABORT('@CRE:'

+     1 //' LCM OBJECT EXPECTED AT RHS.')

+      IF(JENTRY(2).NE.2)CALL XABORT('@CRE: COMPO IN READ-ONLY MOD'

+     1 //'E EXPECTED AT RHS.')

+      CALL LCMGTC(KENTRY(2),'SIGNATURE',12,HSIGN)

+      IF(HSIGN.NE.'L_COMPO')THEN

+        TEXT=HENTRY(2)

+        CALL XABORT('@CRE: SIGNATURE OF '//TEXT//' IS '//HSIGN//

+     1  '. L_COMPO EXPECTED.')

+      ENDIF

+      IPMAP=C_NULL_PTR

+      IF(NENTRY.EQ.2)GOTO 10

+      DO 5 IEN=3,NENTRY

+      IF((IENTRY(IEN).NE.1).AND.(IENTRY(IEN).NE.2))CALL XABORT('@C'

+     1 //'RE: LCM OBJECT EXPECTED AT RHS.')

+      IF(JENTRY(IEN).NE.2)CALL XABORT('@CRE: LCM OBJECT IN READ-ON'

+     1 //'LY MODE EXPECTED AT RHS.')

+      CALL LCMGTC(KENTRY(IEN),'SIGNATURE',12,HSIGN)

+      IF(HSIGN.NE.'L_COMPO')THEN

+        IF(HSIGN.EQ.'L_MAP')THEN

+          IF(LMAC)CALL XABORT('@CRE: MACROLIB IN CREATE MODE EXPEC'

+     1     //'TED WITH FUEL-MAP OBJECT.')

+          IF(IEN.EQ.NENTRY)THEN

+            IPMAP=KENTRY(IEN)

+          ELSE

+            CALL XABORT('@CRE: FUEL-MAP OBJECT EXPECTED TO BE THE '

+     1       //'LAST PARAMETER.')

+          ENDIF

+        ELSE

+          TEXT=HENTRY(IEN)

+          CALL XABORT('@CRE: SIGNATURE OF '//TEXT//' IS '//HSIGN//

+     1    '. L_COMPO EXPECTED.')

+        ENDIF

+      ENDIF

+    5 CONTINUE

+*----

+*  RECOVER INFORMATION

+*----

+   10 ISTATE(:NSTATE)=0

+      CALL LCMGET(KENTRY(2),'STATE-VECTOR',ISTATE)

+      NGRP=ISTATE(2)

+      NL=ISTATE(4)

+      NMIXT=0

+      IF(C_ASSOCIATED(IPMAP)) CALL LCMLEN(IPMAP,'FLMIX',NMIXT,ITYP)

+      IF(LMAC)THEN

+        ISTATE(:NSTATE)=0

+        CALL LCMGET(IPMAC,'STATE-VECTOR',ISTATE)

+        IF(ISTATE(1).NE.NGRP)THEN

+          WRITE(HSMG,'(40HCRE: INCONSISTENT NB OF GROUPS. IN MACRO,

+     1    5HLIB =,I5,11H IN COMPO =,I5)') ISTATE(1),NGRP

+          CALL XABORT(HSMG)

+        ENDIF

+        IF(ISTATE(3).NE.NL)THEN

+          WRITE(HSMG,'(40HCRE: INCONSISTENT NB OF LEGENDRE ORDERS.,

+     1    14H IN MACROLIB =,I5,11H IN COMPO =,I5)') ISTATE(3),NL

+          CALL XABORT(HSMG)

+        ENDIF

+        NMIXT=ISTATE(2)

+      ENDIF

+*----

+* READ THE INPUT DATA

+*----

+      IMPX=0

+   20 CALL REDGET(INDIC,NITMA,FLOT,TEXT,DFLOT)

+      IF(INDIC.NE.3)CALL XABORT('@CRE: CHARACTER DATA EXPECTED.')

+      IF(TEXT.EQ.'EDIT')THEN

+*       READ THE PRINT INDEX.

+        CALL REDGET(INDIC,IMPX,FLOT,TEXT,DFLOT)

+        IF(INDIC.NE.1)CALL XABORT('@CRE: INTEGER DATA EXPECTED(1).')

+      ELSEIF(TEXT.EQ.'NMIX')THEN

+*       READ THE MAXIMUM NUMBER OF MATERIAL MIXTURES.

+        IF(NMIXT.NE.0)CALL XABORT('@CRE: NMIX IS ALREADY DEFINED.')

+        CALL REDGET(INDIC,NMIXT,FLOT,TEXT,DFLOT)

+        IF(INDIC.NE.1)CALL XABORT('@CRE: INTEGER DATA EXPECTED(2).')

+      ELSEIF(TEXT.EQ.'READ')THEN

+        IF(NMIXT.EQ.0)CALL XABORT('@CRE: ZERO NUMBER OF MIXTURES.')

+        IF(NGRP.EQ.0)CALL XABORT('@CRE: ZERO NUMBER OF GROUPS.')

+        CALL CREDRV(IPMAC,IPMAP,NENTRY,HENTRY,KENTRY,LMAC,NMIXT,NGRP,

+     1  NL,ILEAK,IMPX)

+        GOTO 30

+      ELSE

+        CALL XABORT('@CRE: '//TEXT//' IS AN INVALID KEYWORD.')

+      ENDIF

+      GOTO 20

+   30 ISTATE(:NSTATE)=0

+      ISTATE(1)=NGRP

+      ISTATE(2)=NMIXT

+      ISTATE(3)=NL

+      ISTATE(4)=1

+      ISTATE(9)=ILEAK

+      CALL LCMPUT(IPMAC,'STATE-VECTOR',NSTATE,1,ISTATE)

+      IF(IMPX.GT.1)CALL LCMLIB(IPMAC)

+      RETURN

+      END

diff --git a/Donjon/src/CREBUR.f b/Donjon/src/CREBUR.f
new file mode 100644
index 0000000..a46ba15
--- /dev/null
+++ b/Donjon/src/CREBUR.f
@@ -0,0 +1,110 @@
+*DECK CREBUR

+      SUBROUTINE CREBUR(IPCPO,NISO,NGRP,NL,IMPX,HISO,DERIV,NBURN,BURN0,

+     1 BURN1,BURNUP,ITY,CONC,ILEAK,TOTAL,ZNUG,SNUGF,CHI,OVERV,DIFFX,

+     2 DIFFY,DIFFZ,H,SCAT,FLUX,UPS)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Interpolate l_compo for a given burnup value.

+*

+*Copyright:

+* Copyright (C) 2007 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* A. Hebert

+*

+*Parameters: input

+* IPCPO   pointer to l_compo information.

+* NISO    1+number of extracted isotopes.

+* NGRP    number of energy groups.

+* NL      number of legendre orders (=1 for isotropic scattering).

+* IMPX    printing index (=0 for no print).

+* HISO    hollerith name information for extracted isotopes.

+* DERIV   =.true.: derivative of macrolib info is computed with

+*         respect to burn1.

+* NBURN   number of tabulated burnup steps.

+* BURN0   user defined initial burnup.

+* BURN1   user defined final burnup:

+*          if burn0=burn1, a simple interpolation is performed;

+*          if burn0<burn1, a time-average calculation is performed.

+* BURNUP  burnup tabulation points.

+* ITY     =0: do not process the isotope; =1: use number density

+*         stored in conc(i); =2: use number density stored in compo.

+* CONC    user defined number density.

+*

+*Parameters: output

+* ILEAK   diffusion coefficient flag (=1: isotropic; =2: anisotropic).

+* TOTAL   total macroscopic x-sections.

+* ZNUG    nu*fission macroscopic x-sections.

+* SNUGF   fission macroscopic x-sections.

+* CHI     fission spectrum.

+* OVERV   reciprocal neutron velocities.

+* DIFFX   x-directed diffusion coefficients.

+* DIFFY   y-directed diffusion coefficients.

+* DIFFZ   z-directed diffusion coefficients.

+* H       h-factors (kappa*fission macroscopic x-sections).

+* SCAT    scattering macroscopic x-sections.

+* FLUX    integrated flux.

+* UPS

+*

+*-----------------------------------------------------------------------

+*

+      USE GANLIB

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      TYPE(C_PTR) IPCPO

+      INTEGER NISO,NGRP,NL,IMPX,NBURN,HISO(3*NISO),ITY(NISO),ILEAK

+      REAL BURNUP(NBURN),CONC(NISO),TOTAL(NGRP),ZNUG(NGRP),

+     1 CHI(NGRP),OVERV(NGRP),DIFFX(NGRP),DIFFY(NGRP),DIFFZ(NGRP),

+     2 H(NGRP),SCAT(NL,NGRP,NGRP),SNUGF(NGRP),FLUX(NGRP),BURN0,BURN1

+      LOGICAL DERIV,UPS

+*----

+*  LOCAL VARIABLES

+*----

+      LOGICAL LCUBIC

+      PARAMETER(LCUBIC=.TRUE.)

+      REAL, ALLOCATABLE, DIMENSION(:) :: TERP

+      REAL, ALLOCATABLE, DIMENSION(:,:) :: ZTOTAL,ZZNUG,ZNUGF,ZCHI,

+     1 ZOVERV,ZDIFFX,ZDIFFY,ZDIFFZ,ZH,ZFLUX

+      REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: ZSCAT

+*----

+*  SCRATCH STORAGE ALLOCATION

+*----

+      ALLOCATE(ZTOTAL(NBURN,NGRP),ZZNUG(NBURN,NGRP),ZNUGF(NBURN,NGRP),

+     1 ZCHI(NBURN,NGRP),ZOVERV(NBURN,NGRP),ZDIFFX(NBURN,NGRP),

+     2 ZDIFFY(NBURN,NGRP),ZDIFFZ(NBURN,NGRP),ZH(NBURN,NGRP),

+     3 ZFLUX(NBURN,NGRP),ZSCAT(NBURN,NL,NGRP,NGRP),TERP(NBURN))

+*----

+*  RECOVER MACROSCOPIC X-SECTION INFO FROM BURNUP DIRECTORIES

+*----

+      IF(NBURN.LE.1)CALL XABORT('@CREBUR: NO BURNUP INFORMATION.')

+      CALL CRETAB(IPCPO,NISO,NGRP,NL,IMPX,HISO,NBURN,ITY,CONC,ILEAK,

+     1 ZTOTAL,ZZNUG,ZNUGF,ZCHI,ZOVERV,ZDIFFX,ZDIFFY,ZDIFFZ,ZH,ZSCAT,

+     2 ZFLUX,UPS)

+*----

+*  PERFORM INTERPOLATION OR TIME AVERAGING

+*----

+      IF(BURN0.LT.BURN1)THEN

+*       TIME-AVERAGED

+        CALL ALTERI(LCUBIC,NBURN,BURNUP,BURN0,BURN1,TERP)

+        DO 100 I=1,NBURN

+        TERP(I)=TERP(I)/(BURN1-BURN0)

+  100   CONTINUE

+      ELSE IF(BURN0.EQ.BURN1)THEN

+*       INSTANTANEOUS

+        CALL ALTERP(LCUBIC,NBURN,BURNUP,BURN0,DERIV,TERP)

+      ELSE

+        CALL XABORT('@CREBUR: ILLEGAL BURN1 VALUE.')

+      ENDIF

+      CALL CREITP(NGRP,NL,NBURN,TERP,TOTAL,ZNUG,SNUGF,CHI,OVERV,DIFFX,

+     1 DIFFY,DIFFZ,H,SCAT,FLUX,ZTOTAL,ZZNUG,ZNUGF,ZCHI,ZOVERV,ZDIFFX,

+     2 ZDIFFY,ZDIFFZ,ZH,ZSCAT,ZFLUX)

+*----

+*  SCRATCH STORAGE DEALLOCATION

+*----

+      DEALLOCATE(TERP,ZFLUX,ZSCAT,ZH,ZDIFFZ,ZDIFFY,ZDIFFX,ZOVERV,ZCHI,

+     1 ZNUGF,ZZNUG,ZTOTAL)

+      RETURN

+      END

diff --git a/Donjon/src/CREDRV.f b/Donjon/src/CREDRV.f
new file mode 100644
index 0000000..71091e4
--- /dev/null
+++ b/Donjon/src/CREDRV.f
@@ -0,0 +1,210 @@
+*DECK CREDRV

+      SUBROUTINE CREDRV(IPMAC,IPMAP,NENTRY,HENTRY,KENTRY,LMAC,NMIX,

+     1 NGRP,NL,ILEAK,IMPX)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Recover and/or interpolate l_compo information, store properties

+* in a new or existing macrolib.

+*

+*Copyright:

+* Copyright (C) 2007 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* A. Hebert, M. Guyot

+*

+*Parameters: input/output

+* IPMAC   pointer to the macrolib information.

+* IPMAP   pointer to fuel-map information (=0 if no l_fmap).

+* NENTRY  number of lcm or xsm objects used by the module.

+* HENTRY  character*12 name of each lcm or xsm objects.

+* KENTRY  pointers to the lcm or xsm objects.

+* LMAC    flag for macrolib object type: =.false. in create mode;

+*          =.true. in modification mode.

+* NMIX    maximum number of material mixtures.

+* NGRP    number of energy groups.

+* NL      number of legendre orders (=1 for isotropic scattering).

+* ILEAK   diffusion coefficient flag (=1: isotropic; =2: anisotropic).

+* IMPX    printing index (=0 for no print).

+*

+*NOTE: a cross section not read is set to zero.

+*

+*-----------------------------------------------------------------------

+*

+      USE GANLIB

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      INTEGER NENTRY,NMIX,NGRP,NL,ILEAK,IMPX

+      TYPE(C_PTR) IPMAC,IPMAP,KENTRY(NENTRY)

+      CHARACTER HENTRY(NENTRY)*12

+      LOGICAL LMAC

+*----

+*  LOCAL VARIABLES

+*----

+      CHARACTER CM*2

+      TYPE(C_PTR) JPMAC,KPMAC

+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IPOS

+      INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: IJJ,NJJ

+      REAL, ALLOCATABLE, DIMENSION(:) :: WORK

+      REAL, ALLOCATABLE, DIMENSION(:,:) :: TOTAL,ZNUG,SNUGF,CHI,OVERV,

+     1 DIFFX,DIFFY,DIFFZ

+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: H

+      REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: SCAT

+*----

+*  SCRATCH STORAGE ALLOCATION

+*----

+      ALLOCATE(IPOS(NMIX),IJJ(NMIX,NL,NGRP),NJJ(NMIX,NL,NGRP))

+      ALLOCATE(TOTAL(NMIX,NGRP),ZNUG(NMIX,NGRP),SNUGF(NMIX,NGRP),

+     1        CHI(NMIX,NGRP),OVERV(NMIX,NGRP),DIFFX(NMIX,NGRP),

+     2        DIFFY(NMIX,NGRP),DIFFZ(NMIX,NGRP),WORK(NMIX*NGRP),

+     3        SCAT(NMIX,NL,NGRP,NGRP),H(NMIX,NGRP,NL))

+*

+      TOTAL(:NMIX,:NGRP)=0.0

+      ZNUG(:NMIX,:NGRP)=0.0

+      SNUGF(:NMIX,:NGRP)=0.0

+      CHI(:NMIX,:NGRP)=0.0

+      OVERV(:NMIX,:NGRP)=0.0

+      DIFFX(:NMIX,:NGRP)=0.0

+      DIFFY(:NMIX,:NGRP)=0.0

+      DIFFZ(:NMIX,:NGRP)=0.0

+      WORK(:NMIX*NGRP)=0.0

+      SCAT(:NMIX,:NL,:NGRP,:NGRP)=0.0

+      H(:NMIX,:NGRP,:NL)=0.0

+      IPOS(:NMIX)=0

+      DO 12 IGR=1,NGRP

+      DO 11 IBM=1,NMIX

+      DO 10 IL=1,NL

+      IJJ(IBM,IL,IGR)=IGR

+      NJJ(IBM,IL,IGR)=1

+   10 CONTINUE

+   11 CONTINUE

+   12 CONTINUE

+      IF((IMPX.GT.1).AND.LMAC) CALL LCMLIB(IPMAC)

+*----

+*  RECOVER THE EXISTING MACROLIB DATA

+*----

+      ILEAK=0

+      IF(LMAC)THEN

+        JPMAC=LCMGID(IPMAC,'GROUP')

+        DO 40 JGR=1,NGRP

+        KPMAC=LCMGIL(JPMAC,JGR)

+        CALL LCMLEN(KPMAC,'NTOT0',ILENGT,ITYLCM)

+        IF(ILENGT.EQ.NMIX)THEN

+          CALL LCMGET(KPMAC,'NTOT0',TOTAL(1,JGR))

+        ELSEIF(ILENGT.NE.0)THEN

+          CALL XABORT('@CREDRV: INVALID INPUT MACROLIB(1).')

+        ENDIF

+        CALL LCMLEN(KPMAC,'NUSIGF',ILENGT,ITYLCM)

+        IF(ILENGT.EQ.NMIX)CALL LCMGET(KPMAC,'NUSIGF',ZNUG(1,JGR))

+        CALL LCMLEN(KPMAC,'NFTOT',ILENGT,ITYLCM)

+        IF(ILENGT.EQ.NMIX)CALL LCMGET(KPMAC,'NFTOT',SNUGF(1,JGR))

+        CALL LCMLEN(KPMAC,'CHI',ILENGT,ITYLCM)

+        IF(ILENGT.EQ.NMIX)CALL LCMGET(KPMAC,'CHI',CHI(1,JGR))

+        CALL LCMLEN(KPMAC,'OVERV',ILENGT,ITYLCM)

+        IF(ILENGT.EQ.NMIX)CALL LCMGET(KPMAC,'OVERV',OVERV(1,JGR))

+        CALL LCMLEN(KPMAC,'DIFF',ILENGT,ITYLCM)

+        IF(ILENGT.EQ.NMIX)THEN

+          ILEAK=1

+          CALL LCMGET(KPMAC,'DIFF',DIFFX(1,JGR))

+        ENDIF

+        CALL LCMLEN(KPMAC,'DIFFX',ILENGT,ITYLCM)

+        IF(ILENGT.EQ.NMIX)THEN

+          ILEAK=2

+          CALL LCMGET(KPMAC,'DIFFX',DIFFX(1,JGR))

+          CALL LCMGET(KPMAC,'DIFFY',DIFFY(1,JGR))

+          CALL LCMGET(KPMAC,'DIFFZ',DIFFZ(1,JGR))

+        ENDIF

+        CALL LCMLEN(KPMAC,'H-FACTOR',ILENGT,ITYLCM)

+        IF(ILENGT.EQ.NMIX)CALL LCMGET(KPMAC,'H-FACTOR',H(1,JGR,1))

+        DO IL=1,NL

+          WRITE (CM,'(I2.2)') IL-1

+          CALL LCMLEN(KPMAC,'SCAT'//CM,ILENGT,ITYLCM)

+          IF(ILENGT.GT.NMIX*NL*NGRP*NGRP)THEN

+            CALL XABORT('@CREDRV: INVALID INPUT MACROLIB(2).')

+          ELSEIF(ILENGT.GT.0)THEN

+            CALL LCMGET(KPMAC,'SCAT'//CM,WORK)

+            CALL LCMGET(KPMAC,'NJJS'//CM,NJJ(1,IL,JGR))

+            CALL LCMGET(KPMAC,'IJJS'//CM,IJJ(1,IL,JGR))

+            IPOSDE=0

+            DO 25 IBM=1,NMIX

+            IJJ0=IJJ(IBM,IL,JGR)

+            DO 20 IGR=IJJ0,IJJ0-NJJ(IBM,IL,JGR)+1,-1

+            IPOSDE=IPOSDE+1

+            SCAT(IBM,IL,IGR,JGR)=WORK(IPOSDE)

+   20       CONTINUE

+   25       CONTINUE

+          ELSE

+            CALL XABORT('@CREDRV: OLD FORMAT OF THE MACROLIB.')

+          ENDIF

+        ENDDO

+   40   CONTINUE

+      ENDIF

+*----

+*  READ INPUT DATA

+*----

+      CALL CREXSI(IPMAP,NENTRY,HENTRY,KENTRY,NMIX,NGRP,NL,ILEAK,IMPX,

+     1 TOTAL,ZNUG,SNUGF,CHI,OVERV,DIFFX,DIFFY,DIFFZ,H,IJJ,NJJ,SCAT)

+*----

+*  MACROLIB DATA STORAGE

+*----

+      JPMAC=LCMLID(IPMAC,'GROUP',NGRP)

+      DO 190 JGR=1,NGRP

+      KPMAC=LCMDIL(JPMAC,JGR)

+      CALL LCMPUT(KPMAC,'NTOT0',NMIX,2,TOTAL(1,JGR))

+      CALL LCMPUT(KPMAC,'NUSIGF',NMIX,2,ZNUG(1,JGR))

+      CALL LCMPUT(KPMAC,'NFTOT',NMIX,2,SNUGF(1,JGR))

+      CALL LCMPUT(KPMAC,'CHI',NMIX,2,CHI(1,JGR))

+      CALL LCMPUT(KPMAC,'OVERV',NMIX,2,OVERV(1,JGR))

+      IF(ILEAK.EQ.1)THEN

+        CALL LCMPUT(KPMAC,'DIFF',NMIX,2,DIFFX(1,JGR))

+      ELSEIF(ILEAK.EQ.2)THEN

+        CALL LCMPUT(KPMAC,'DIFFX',NMIX,2,DIFFX(1,JGR))

+        CALL LCMPUT(KPMAC,'DIFFY',NMIX,2,DIFFY(1,JGR))

+        CALL LCMPUT(KPMAC,'DIFFZ',NMIX,2,DIFFZ(1,JGR))

+      ENDIF

+      CALL LCMPUT(KPMAC,'H-FACTOR',NMIX,2,H(1,JGR,1))

+  190 CONTINUE

+*----

+*  SCATTERING DATA

+*----

+      H(:NMIX,:NGRP,:NL)=0.0

+      DO 215 JGR=1,NGRP

+      KPMAC=LCMDIL(JPMAC,JGR)

+      DO 210 IL=1,NL

+        WRITE (CM,'(I2.2)') IL-1

+        IPOSDE=0

+        DO 205 IBM=1,NMIX

+        IPOS(IBM)=IPOSDE+1

+        DO 200 IGR=IJJ(IBM,IL,JGR),IJJ(IBM,IL,JGR)-NJJ(IBM,IL,JGR)+1,-1

+        IPOSDE=IPOSDE+1

+        WORK(IPOSDE)=SCAT(IBM,IL,IGR,JGR)

+        H(IBM,IGR,IL)=H(IBM,IGR,IL)+SCAT(IBM,IL,IGR,JGR)

+  200   CONTINUE

+  205   CONTINUE

+        CALL LCMPUT(KPMAC,'SCAT'//CM,IPOSDE,2,WORK)

+        CALL LCMPUT(KPMAC,'IPOS'//CM,NMIX,1,IPOS)

+        CALL LCMPUT(KPMAC,'NJJS'//CM,NMIX,1,NJJ(1,IL,JGR))

+        CALL LCMPUT(KPMAC,'IJJS'//CM,NMIX,1,IJJ(1,IL,JGR))

+        CALL LCMPUT(KPMAC,'SIGW'//CM,NMIX,2,SCAT(1,IL,JGR,JGR))

+  210 CONTINUE

+  215 CONTINUE

+      DO 225 IGR=1,NGRP

+      KPMAC=LCMDIL(JPMAC,IGR)

+      DO 220 IL=1,NL

+      WRITE (CM,'(I2.2)') IL-1

+      CALL LCMPUT(KPMAC,'SIGS'//CM,NMIX,2,H(1,IGR,IL))

+      IF(IMPX.GT.2)CALL LCMLIB(KPMAC)

+  220 CONTINUE

+  225 CONTINUE

+*

+      IF(IMPX.GT.1)CALL LCMLIB(IPMAC)

+*----

+*  SCRATCH STORAGE DEALLOCATION

+*----

+      DEALLOCATE(H,SCAT,WORK,DIFFZ,DIFFY,DIFFX,OVERV,CHI,SNUGF,ZNUG,

+     1 TOTAL)

+      DEALLOCATE(NJJ,IJJ,IPOS)

+      RETURN

+      END

diff --git a/Donjon/src/CREGET.f b/Donjon/src/CREGET.f
new file mode 100644
index 0000000..974da1e
--- /dev/null
+++ b/Donjon/src/CREGET.f
@@ -0,0 +1,135 @@
+*DECK CREGET

+      SUBROUTINE CREGET(IPMAP,NCH,NB,IBTYP,IMPX,BRN0,BRN1,FMIX,ZONEDP,

+     1 IVARTY,VARVAL)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* recover the necessary information from the fuel-map object.

+*

+*Copyright:

+* Copyright (C) 2007 Ecole Polytechnique de Montreal.

+*

+*Author(s): D. Sekki, A. Hebert

+*

+*Parameters: input

+* IPMAP   pointer to the fuel-map information.

+* NCH     number of reactor channels.

+* NB      number of fuel bundles per channel.

+* IBTYP   type of interpolation:

+*         =0 not provided;

+*         =1 time-average;

+*         =2 instantaneous;

+*         =3 derivative with respect to a single exit burnup.

+* IMPX    printing index (=0 for no print).

+* IVARTY  index of the exit burnup used to compute derivatives;

+*         used if IBTYP=3.

+*

+*Parameters: output

+* FMIX    fuel mixture indices per fuel bundle.

+* BRN0    contains either low burnup integration limits or 

+*         instantaneous burnups per fuel bundle.

+* BRN1    upper burnup integration limits per fuel bundle.

+* VARVAL  single exit burnup; used if IBTYP=3.

+* ZONEDP  switch related to Chambon formula.

+*

+*-----------------------------------------------------------------------

+*

+      USE GANLIB

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      TYPE(C_PTR) IPMAP

+      INTEGER NCH,NB,IBTYP,IMPX,FMIX(NCH,NB),ZONEDP(NCH,NB),IVARTY

+      REAL BRN0(NCH,NB),BRN1(NCH,NB),VARVAL

+*----

+*  LOCAL VARIABLES

+*----

+      PARAMETER(IOUT=6,NSTATE=40)

+      INTEGER ISTATE(NSTATE)

+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IZONE

+      REAL, ALLOCATABLE, DIMENSION(:) :: VARC

+*----

+*  SCRATCH STORAGE ALLOCATION

+*----

+      ALLOCATE(IZONE(NCH))

+*

+      FMIX(:NCH,:NB)=0

+      BRN0(:NCH,:NB)=0.0

+      BRN1(:NCH,:NB)=0.0

+      CALL LCMGET(IPMAP,'FLMIX',FMIX)

+      IF(IBTYP.EQ.0) THEN

+         CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)

+         IBTYP=ISTATE(5)

+      ENDIF

+*----

+*  TIME-AVERAGE

+*----

+      IF(IBTYP.EQ.1)THEN

+*       LOW BURNUP LIMITS

+        CALL LCMLEN(IPMAP,'BURN-BEG',LENGT,ITYP)

+        IF(LENGT.EQ.0)CALL XABORT('@CREGET: MISSI'

+     1   //'NG BURN-BEG VALUES IN FUEL MAP.')

+        CALL LCMGET(IPMAP,'BURN-BEG',BRN0)

+*       UPPER BURNUP LIMITS

+        CALL LCMLEN(IPMAP,'BURN-END',LENGT,ITYP)

+        IF(LENGT.EQ.0)CALL XABORT('@CREGET: MISSI'

+     1   //'NG BURN-END VALUES IN FUEL MAP.')

+        CALL LCMGET(IPMAP,'BURN-END',BRN1)

+        IF(IMPX.GT.0)WRITE(IOUT,1000)

+*----

+*  INSTANTANEOUS

+*----

+      ELSEIF(IBTYP.EQ.2)THEN

+        CALL LCMLEN(IPMAP,'BURN-INST',LENGT,ITYP)

+        IF(LENGT.EQ.0)CALL XABORT('@CREGET: MISSI'

+     1   //'NG BURN-INST VALUES IN FUEL MAP.')

+        CALL LCMGET(IPMAP,'BURN-INST',BRN0)

+        IF(IMPX.GT.0)WRITE(IOUT,1001)

+*----

+*  SINGLE EXIT BURNUP

+*----

+      ELSEIF(IBTYP.EQ.3)THEN

+        IF(IVARTY.EQ.0)CALL XABORT('@CREGET: IVARTY NOT SET.')

+*       LOW BURNUP LIMITS

+        CALL LCMLEN(IPMAP,'BURN-BEG',LENGT,ITYP)

+        IF(LENGT.EQ.0)CALL XABORT('@CREGET: MISSI'

+     1   //'NG BRN0 VALUES IN FUEL MAP.')

+        CALL LCMGET(IPMAP,'BURN-BEG',BRN0)

+*       UPPER BURNUP LIMITS

+        CALL LCMLEN(IPMAP,'BURN-END',LENGT,ITYP)

+        IF(LENGT.EQ.0)CALL XABORT('@CREGET: MISSI'

+     1   //'NG BRN1 VALUES IN FUEL MAP.')

+        CALL LCMGET(IPMAP,'BURN-END',BRN1)

+        IF(IMPX.GT.0)WRITE(IOUT,1000)

+        CALL LCMGET(IPMAP,'B-ZONE',IZONE)

+        DO 35 ICH=1,NCH

+        DO 30 IB=1,NB

+        IF(IZONE(ICH).EQ.IVARTY)THEN

+          ZONEDP(ICH,IB)=1

+        ELSE

+          ZONEDP(ICH,IB)=0

+        ENDIF

+   30   CONTINUE

+   35   CONTINUE

+        CALL LCMLEN(IPMAP,'BURN-AVG',ILONG,ITYP)

+        IF (ILONG.EQ.0)CALL XABORT('@CREGET: NO SAVED VA'

+     1  //'LUES FOR THIS TYPE OF VARIABLE IN FUEL MAP')

+        ALLOCATE(VARC(ILONG))

+        CALL LCMGET(IPMAP,'BURN-AVG',VARC)

+        VARVAL=VARC(IVARTY)

+        DEALLOCATE(VARC)

+      ELSE

+        CALL XABORT('@CREGET: INVALID OPTION IBTYP.')

+      ENDIF

+*----

+*  SCRATCH STORAGE DEALLOCATION

+*----

+      DEALLOCATE(IZONE)

+      RETURN

+*

+ 1000 FORMAT(/1X,'** PERFORMING THE TIME-AVERAGE',

+     1 1X,'INTEGRATION OVER THE FUEL LATTICE **'/)

+ 1001 FORMAT(/1X,'** PERFORMING THE INSTANTANEOU',

+     1'S INTERPOLATION OVER THE FUEL LATTICE **'/)

+      END

diff --git a/Donjon/src/CREINT.f b/Donjon/src/CREINT.f
new file mode 100644
index 0000000..76d3d43
--- /dev/null
+++ b/Donjon/src/CREINT.f
@@ -0,0 +1,136 @@
+*DECK CREINT
+      SUBROUTINE CREINT(IPCPO,NISO,DERIV,NBURN,KBURN,BURN0,BURN1,NGRP,
+     1   NL,IMPX,HISO,ITY,CONC,ILEAK,TOTAL,ZNUG,SNUGF,CHI,OVERV,DIFFX,
+     2   DIFFY,DIFFZ,H,SCAT,FLUX,UPS)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover and interpolate l_compo information according to burnup and
+* extracted isotope density.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPCPO   pointer to l_compo information.
+* NISO    1+number of extracted isotopes.
+* DERIV   =.true.: derivative of macrolib info is computed with
+*         respect to burn1.
+* UPS     =.true.: no upscatering cross sections will be stored.
+* NBURN   number of tabulated burnup steps.
+* KBURN   =0: no burnup parameters; =1: use mw day/tonne of initial
+*         heavy elements).
+* BURN0   user defined initial burnup.
+* BURN1   user defined final burnup:
+*          if burn0=burn1, a simple interpolation is performed;
+*          if burn0<burn1, a time-average calculation is performed.
+* NGRP    number of energy groups.
+* NL      number of legendre orders (=1 for isotropic scattering).
+* IMPX    print parameter (=0 for no print).
+* HISO    hollerith name information for extracted isotopes.
+* ITY     =0: do not process the isotope; =1: use number density
+*         stored in conc(i); =2: use number density stored in compo.
+* CONC    user defined number density.
+* ILEAK
+*
+*Parameters: output
+* TOTAL   total macroscopic x-sections.
+* ZNUG    nu*fission macroscopic x-sections.
+* SNUGF   fission macroscopic x-sections.
+* CHI     fission spectrum.
+* OVERV   reciprocal neutron velocities.
+* DIFFX   x-directed diffusion coefficients.
+* DIFFY   y-directed diffusion coefficients.
+* DIFFZ   z-directed diffusion coefficients.
+* H       h-factors (kappa*fission macroscopic x-sections).
+* SCAT    scattering macroscopic x-sections.
+* FLUX    integrated fluxes.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPCPO
+      INTEGER NISO,NGRP,IMPX,NBURN,KBURN,HISO(3*NISO),ITY(NISO),ILEAK
+      REAL CONC(NISO),TOTAL(NGRP),ZNUG(NGRP),SNUGF(NGRP),CHI(NGRP),
+     1 OVERV(NGRP),DIFFX(NGRP),DIFFY(NGRP),DIFFZ(NGRP),H(NGRP),
+     2 SCAT(NL,NGRP,NGRP),FLUX(NGRP),BURN0,BURN1
+      LOGICAL DERIV,UPS
+*----
+*  LOCAL VARIABLES
+*----
+      CHARACTER TEXT12*12
+      REAL, ALLOCATABLE, DIMENSION(:) :: BURNUP,DENSIT
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(BURNUP(NBURN),DENSIT(NISO))
+*----
+*  CASE WITH NO BURNUP
+*----
+      IF(KBURN.EQ.0)THEN
+        CALL LCMSIX(IPCPO,'BURN       1',1)
+        CALL LCMGET(IPCPO,'ISOTOPESDENS',DENSIT)
+        IF(DENSIT(1).NE.1.)CALL XABORT('@CREINT: DENSIT(1).NE.1.')
+        DO I=2,NISO
+          IF(ITY(I).EQ.0)THEN
+            DENSIT(I)=0.
+          ELSEIF(ITY(I).EQ.1)THEN
+            DENSIT(I)=CONC(I)
+          ELSEIF(ITY(I).NE.2)THEN
+            CALL XABORT('@CREINT: INVALID VALUE OF ITY.')
+          ENDIF
+        ENDDO
+        CALL CREMAC(IPCPO,NISO,NGRP,NL,IMPX,HISO,DENSIT,ILEAK,TOTAL,
+     1       ZNUG,SNUGF,CHI,OVERV,DIFFX,DIFFY,DIFFZ,H,SCAT,FLUX,UPS)
+        CALL LCMSIX(IPCPO,' ',2)
+      ELSE
+*----
+*  CASE WITH BURNUP
+*----
+        CALL LCMGET(IPCPO,'BURNUP',BURNUP)
+        TEXT12=' '
+        IF(BURN0.EQ.BURN1)THEN
+          DO I=1,NBURN
+            IF(BURN0.EQ.BURNUP(I))THEN
+              WRITE(TEXT12,'(4HBURN,4X,I4)') I
+              GOTO 30
+            ENDIF
+          ENDDO
+        ENDIF
+   30   IF((TEXT12.NE.' ').AND.(.NOT.DERIV))THEN
+*         BURN0=BURN1 IS A TABULATION POINT.
+          CALL LCMSIX(IPCPO,TEXT12,1)
+          CALL LCMGET(IPCPO,'ISOTOPESDENS',DENSIT)
+          IF(DENSIT(1).NE.1.)CALL XABORT('@CREINT: DENSIT(1).NE.1.')
+          DO I=2,NISO
+            IF(ITY(I).EQ.0)THEN
+              DENSIT(I)=0.
+            ELSEIF(ITY(I).EQ.1)THEN
+              DENSIT(I)=CONC(I)
+            ELSEIF(ITY(I).NE.2)THEN
+              CALL XABORT('@CREINT: INVALID VALUE OF ITY.')
+            ENDIF
+          ENDDO
+          CALL CREMAC(IPCPO,NISO,NGRP,NL,IMPX,HISO,DENSIT,ILEAK,TOTAL,
+     1         ZNUG,SNUGF,CHI,OVERV,DIFFX,DIFFY,DIFFZ,H,SCAT,FLUX,UPS)
+          CALL LCMSIX(IPCPO,' ',2)
+        ELSE
+*         INTERPOLATION IS REQUIRED.
+          CALL CREBUR(IPCPO,NISO,NGRP,NL,IMPX,HISO,DERIV,NBURN,BURN0,
+     1         BURN1,BURNUP,ITY,CONC,ILEAK,TOTAL,ZNUG,SNUGF,CHI,OVERV,
+     2         DIFFX,DIFFY,DIFFZ,H,SCAT,FLUX,UPS)
+        ENDIF
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(DENSIT,BURNUP)
+      RETURN
+      END
diff --git a/Donjon/src/CREITP.f b/Donjon/src/CREITP.f
new file mode 100644
index 0000000..95200e4
--- /dev/null
+++ b/Donjon/src/CREITP.f
@@ -0,0 +1,94 @@
+*DECK CREITP

+      SUBROUTINE CREITP(NGRP,NL,NBURN,TERP,TOTAL,ZNUG,SNUGF,CHI,

+     1    OVERV,DIFFX,DIFFY,DIFFZ,H,SCAT,FLUX,ZTOTAL,ZZNUG,ZNUGF,

+     2    ZCHI,ZOVERV,ZDIFFX,ZDIFFY,ZDIFFZ,ZH,ZSCAT,ZFLUX)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Interpolate burnup dependent table for a given burnup value or

+* time-average or derivatives.

+*

+*Copyright:

+* Copyright (C) 2007 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* A. Hebert

+*

+*Parameters: input

+* NGRP    number of energy groups.

+* NL      number of legendre orders (=1 for isotropic scattering).

+* NBURN   number of tabulated burnup steps.

+* TERP    interpolation factors.

+* ZTOTAL  burnup dependent total macroscopic x-sections

+* ZZNUG   burnup dependent nu*fission macroscopic x-sections.

+* ZNUGF   burnup dependent fission macroscopic x-sections.

+* ZCHI    burnup dependent fission spectrum.

+* ZOVERV  burnup dependent reciprocal neutron velocities.

+* ZDIFFX  burnup dependent x-directed diffusion coefficients.

+* ZDIFFY  burnup dependent y-directed diffusion coefficients.

+* ZDIFFZ  burnup dependent z-directed diffusion coefficients.

+* ZH      burnup dependent h-factors.

+* ZSCAT   burnup dependent scattering macroscopic x-sections.

+* ZFLUX   burnup dependent integrated flux.

+*

+*Parameters: output

+* TOTAL   total macroscopic x-sections.

+* ZNUG    nu*fission macroscopic x-sections.

+* SNUGF   fission macroscopic x-sections.

+* CHI     fission spectrum.

+* OVERV   reciprocal neutron velocities.

+* DIFFX   x-directed diffusion coefficients.

+* DIFFY   y-directed diffusion coefficients.

+* DIFFZ   z-directed diffusion coefficients.

+* H       h-factors (kappa*fission macroscopic x-sections).

+* SCAT    scattering macroscopic x-sections.

+* FLUX    integrated flux.

+*

+*-----------------------------------------------------------------------

+*

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      INTEGER NGRP,NL,NBURN

+      REAL TERP(NBURN),TOTAL(NGRP),ZNUG(NGRP),CHI(NGRP),OVERV(NGRP),

+     1 DIFFX(NGRP),DIFFY(NGRP),DIFFZ(NGRP),H(NGRP),SCAT(NL,NGRP,NGRP),

+     2 SNUGF(NGRP),FLUX(NGRP),ZTOTAL(NBURN,NGRP),ZZNUG(NBURN,NGRP),

+     3 ZCHI(NBURN,NGRP),ZOVERV(NBURN,NGRP),ZDIFFX(NBURN,NGRP),

+     4 ZDIFFY(NBURN,NGRP),ZDIFFZ(NBURN,NGRP),ZH(NBURN,NGRP),

+     5 ZSCAT(NBURN,NL,NGRP,NGRP),ZFLUX(NBURN,NGRP),ZNUGF(NBURN,NGRP)

+*----

+*  PERFORM INTERPOLATION OR TIME AVERAGING

+*----

+      TOTAL(:NGRP)=0.0

+      ZNUG(:NGRP)=0.0

+      CHI(:NGRP)=0.0

+      OVERV(:NGRP)=0.0

+      DIFFX(:NGRP)=0.0

+      DIFFY(:NGRP)=0.0

+      DIFFZ(:NGRP)=0.0

+      H(:NGRP)=0.0

+      SCAT(:NL,:NGRP,:NGRP)=0.0

+      DO 100 IBURN=1,NBURN

+      WEIGHT=TERP(IBURN)

+      IF(WEIGHT.EQ.0.0) GO TO 100

+      DO 92 JGR=1,NGRP

+      TOTAL(JGR)=TOTAL(JGR)+WEIGHT*ZTOTAL(IBURN,JGR)

+      ZNUG(JGR)=ZNUG(JGR)+WEIGHT*ZZNUG(IBURN,JGR)

+      SNUGF(JGR)=SNUGF(JGR)+WEIGHT*ZNUGF(IBURN,JGR)

+      CHI(JGR)=CHI(JGR)+WEIGHT*ZCHI(IBURN,JGR)

+      OVERV(JGR)=OVERV(JGR)+WEIGHT*ZOVERV(IBURN,JGR)

+      DIFFX(JGR)=DIFFX(JGR)+WEIGHT*ZDIFFX(IBURN,JGR)

+      DIFFY(JGR)=DIFFY(JGR)+WEIGHT*ZDIFFY(IBURN,JGR)

+      DIFFZ(JGR)=DIFFZ(JGR)+WEIGHT*ZDIFFZ(IBURN,JGR)

+      H(JGR)=H(JGR)+WEIGHT*ZH(IBURN,JGR)

+      FLUX(JGR)=FLUX(JGR)+WEIGHT*ZFLUX(IBURN,JGR)

+      DO 91 IGR=1,NGRP

+      DO 90 IL=1,NL

+      SCAT(IL,IGR,JGR)=SCAT(IL,IGR,JGR)+WEIGHT*ZSCAT(IBURN,IL,IGR,JGR)

+   90 CONTINUE

+   91 CONTINUE

+   92 CONTINUE

+  100 CONTINUE

+      RETURN

+      END

diff --git a/Donjon/src/CREMAC.f b/Donjon/src/CREMAC.f
new file mode 100644
index 0000000..6f063db
--- /dev/null
+++ b/Donjon/src/CREMAC.f
@@ -0,0 +1,327 @@
+*DECK CREMAC
+      SUBROUTINE CREMAC(IPCPO,NISO,NGRP,NL,IMPX,HISO,DENSIT,ILEAK,TOTAL,
+     1           ZNUG,SNUGF,CHI,OVERV,DIFFX,DIFFY,DIFFZ,H,SCAT,FLUX,UPS)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Add the microscopic x-sections of the extracted isotopes to the
+* macroscopic residual.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* A. Hebert
+*
+*Update(s):
+* E. Varin (2010/01/26)
+*
+*Parameters: input
+* IPCPO   pointer to l_compo information.
+* NISO    1+number of extracted isotopes.
+* NGRP    number of energy groups.
+* NL      number of legendre orders (=1 for isotropic scattering).
+* IMPX    print parameter (=0 for no print).
+* HISO    hollerith name information for extracted isotopes.
+* DENSIT  number densities.
+* UPS     =.true.: no upscatering cross sections will be stored.
+*
+*Parameters: output
+* ILEAK   diffusion coefficient flag (=1: isotropic; =2: anisotropic).
+* TOTAL   total macroscopic x-sections.
+* ZNUG    nu*fission macroscopic x-sections.
+* SNUGF   fission macroscopic x-sections.
+* CHI     fission spectrum.
+* OVERV   reciprocal neutron velocities.
+* DIFFX   x-directed diffusion coefficients.
+* DIFFY   y-directed diffusion coefficients.
+* DIFFZ   z-directed diffusion coefficients.
+* H       h-factors (kappa*fission macroscopic x-sections).
+* SCAT    scattering macroscopic x-sections.
+* FLUX    integrated fluxes.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPCPO
+      INTEGER NISO,NGRP,NL,IMPX,ILEAK,HISO(3*NISO)
+      REAL    DENSIT(NISO),TOTAL(NGRP),ZNUG(NGRP),SNUGF(NGRP),CHI(NGRP),
+     1        OVERV(NGRP),DIFFX(NGRP),DIFFY(NGRP),DIFFZ(NGRP),H(NGRP),
+     2        SCAT(NL,NGRP,NGRP),FLUX(NGRP)
+      LOGICAL UPS
+*----
+*  LOCAL VARIABLES
+*----
+      CHARACTER HMICRO*12,CM*2
+      LOGICAL   LFISS
+      DOUBLE PRECISION XDRCST,EVJ
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IJJ,NJJ,INDXS
+      REAL, ALLOCATABLE, DIMENSION(:) :: WORK2,ENGFIS
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: WORK1
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(IJJ(NGRP),NJJ(NGRP),WORK1(NGRP,3),WORK2(NGRP*NGRP),
+     1 INDXS(21+NL),ENGFIS(NISO))
+*----
+*  RECOVER MACROSCOPIC RESIDUAL OF VECTORIAL X-SECTIONS
+*----
+      EVJ=XDRCST('eV','J')
+      DO 10 IGR=1,NGRP
+      TOTAL(IGR)=0.0
+      DIFFX(IGR)=0.0
+      DIFFY(IGR)=0.0
+      DIFFZ(IGR)=0.0
+      ZNUG(IGR)=0.0
+      SNUGF(IGR)=0.0
+      CHI(IGR)=0.0
+   10 CONTINUE
+      CALL LCMGET(IPCPO,'FLUX-INTG',FLUX)
+      CALL LCMGET(IPCPO,'OVERV',OVERV)
+      CALL LCMGET(IPCPO,'ISOTOPES-EFJ',ENGFIS)
+      CALL LCMSIX(IPCPO,'MACR',1)
+      CALL LCMGET(IPCPO,'XS-SAVED',INDXS)
+      IF(INDXS(1).EQ.1)CALL LCMGET(IPCPO,'TOTAL',TOTAL)
+      ILEAK=0
+      IF(INDXS(17).EQ.1)THEN
+         ILEAK=1
+         CALL LCMGET(IPCPO,'STRD',DIFFX)
+      ELSE IF(INDXS(18).EQ.1)THEN
+         ILEAK=2
+         CALL LCMGET(IPCPO,'STRD X',DIFFX)
+         CALL LCMGET(IPCPO,'STRD Y',DIFFY)
+         CALL LCMGET(IPCPO,'STRD Z',DIFFZ)
+      ENDIF
+      IF(INDXS(3).EQ.1)THEN
+        CALL LCMGET(IPCPO,'NUSIGF',ZNUG)
+        CALL LCMGET(IPCPO,'NFTOT',SNUGF)
+        CALL LCMGET(IPCPO,'CHI',CHI)
+      ENDIF
+      DO 11 IGR=1,NGRP
+      H(IGR)=ENGFIS(1)*SNUGF(IGR)/REAL(EVJ)
+   11 CONTINUE
+      CALL LCMSIX(IPCPO,' ',2)
+*----
+*  RECOVER MICROSCOPIC CONTRIBUTIONS OF VECTORIAL X-SECTIONS
+*----
+      LFISS=.FALSE.
+      DO 40 ISO=2,NISO
+      IF(DENSIT(ISO).EQ.0.)GOTO 40
+      WRITE(HMICRO,'(3A4)') (HISO((ISO-1)*3+I),I=1,3)
+      CALL LCMLEN(IPCPO,HMICRO,ILENG,ITYLCM)
+      IF(ILENG.EQ.0)GOTO 40
+      IF(IMPX.GT.1)WRITE(6,'(/29H CREMAC: PROCESSING ISOTOPE '',A12,
+     1   16H'' WITH DENSITY =,1P,E13.5,2H .)') HMICRO,DENSIT(ISO)
+      CALL LCMSIX(IPCPO,HMICRO,1)
+      CALL LCMGET(IPCPO,'XS-SAVED',INDXS)
+      IF(INDXS(1).EQ.1)THEN
+        CALL LCMGET(IPCPO,'TOTAL',WORK1(1,1))
+        DO 20 IGR=1,NGRP
+        TOTAL(IGR)=TOTAL(IGR)+DENSIT(ISO)*WORK1(IGR,1)
+   20   CONTINUE
+      ENDIF
+      IF(INDXS(17).EQ.1)THEN
+        CALL LCMGET(IPCPO,'STRD',WORK1(1,1))
+        DO 21 IGR=1,NGRP
+        DIFFX(IGR)=DIFFX(IGR)+DENSIT(ISO)*WORK1(IGR,1)
+   21   CONTINUE
+      ELSE IF(INDXS(18).EQ.1)THEN
+        CALL LCMGET(IPCPO,'STRD X',WORK1(1,1))
+        CALL LCMGET(IPCPO,'STRD Y',WORK1(1,2))
+        CALL LCMGET(IPCPO,'STRD Z',WORK1(1,3))
+        DO 22 IGR=1,NGRP
+        DIFFX(IGR)=DIFFX(IGR)+DENSIT(ISO)*WORK1(IGR,1)
+        DIFFY(IGR)=DIFFY(IGR)+DENSIT(ISO)*WORK1(IGR,2)
+        DIFFZ(IGR)=DIFFZ(IGR)+DENSIT(ISO)*WORK1(IGR,3)
+   22   CONTINUE
+      ENDIF
+      IF(INDXS(3).EQ.1)THEN
+        CALL LCMGET(IPCPO,'NUSIGF',WORK1(1,1))
+        CALL LCMGET(IPCPO,'NFTOT',WORK1(1,2))
+        CALL LCMGET(IPCPO,'CHI',WORK1(1,3))
+        DO 30 IGR=1,NGRP
+        LFISS=LFISS.OR.(CHI(IGR).NE.WORK1(IGR,3))
+        ZNUG(IGR)=ZNUG(IGR)+DENSIT(ISO)*WORK1(IGR,1)
+        SNUGF(IGR)=SNUGF(IGR)+DENSIT(ISO)*WORK1(IGR,2)
+        H(IGR)=H(IGR)+DENSIT(ISO)*WORK1(IGR,2)*ENGFIS(ISO)/REAL(EVJ)
+   30   CONTINUE
+      ENDIF
+      CALL LCMSIX(IPCPO,' ',2)
+   40 CONTINUE
+*----
+*  COMPUTE AN AVERAGE FISSION SPECTRUM
+*----
+      IF(LFISS)THEN
+        CALL LCMGET(IPCPO,'FLUX-INTG',WORK1(1,1))
+        CALL LCMSIX(IPCPO,'MACR',1)
+        CALL LCMGET(IPCPO,'XS-SAVED',INDXS)
+        IF(INDXS(3).EQ.1)THEN
+          CALL LCMGET(IPCPO,'NUSIGF',WORK1(1,2))
+          CALL LCMGET(IPCPO,'CHI',WORK1(1,3))
+          DO 55 JGR=1,NGRP
+          DO 50 IGR=1,NGRP
+          SCAT(1,IGR,JGR)=WORK1(IGR,1)*WORK1(IGR,2)*WORK1(JGR,3)
+   50     CONTINUE
+   55     CONTINUE
+        ELSE
+          DO 65 JGR=1,NGRP
+          DO 60 IGR=1,NGRP
+          SCAT(1,IGR,JGR)=0.
+   60     CONTINUE
+   65     CONTINUE
+        ENDIF
+        CALL LCMSIX(IPCPO,' ',2)
+        DO 80 ISO=2,NISO
+        IF(DENSIT(ISO).EQ.0.)GOTO 80
+        WRITE(HMICRO,'(3A4)') (HISO((ISO-1)*3+I),I=1,3)
+        CALL LCMLEN(IPCPO,HMICRO,ILENG,ITYLCM)
+        IF(ILENG.EQ.0)GOTO 80
+        CALL LCMSIX(IPCPO,HMICRO,1)
+        CALL LCMGET(IPCPO,'XS-SAVED',INDXS)
+        IF(INDXS(3).EQ.1)THEN
+          CALL LCMGET(IPCPO,'NUSIGF',WORK1(1,2))
+          CALL LCMGET(IPCPO,'CHI',WORK1(1,3))
+          DO 75 JGR=1,NGRP
+          DO 70 IGR=1,NGRP
+          SCAT(1,IGR,JGR)=SCAT(1,IGR,JGR)+DENSIT(ISO)*
+     1         WORK1(IGR,1)*WORK1(IGR,2)*WORK1(JGR,3)
+   70     CONTINUE
+   75     CONTINUE
+        ENDIF
+        CALL LCMSIX(IPCPO,' ',2)
+   80   CONTINUE
+        SSUM=0.
+        DO 95 JGR=1,NGRP
+        CHI(JGR)=0.
+        DO 90 IGR=1,NGRP
+          SSUM=SSUM+SCAT(1,IGR,JGR)
+          CHI(JGR)=CHI(JGR)+SCAT(1,IGR,JGR)
+   90   CONTINUE
+   95   CONTINUE
+        DO 100 JGR=1,NGRP
+        CHI(JGR)=CHI(JGR)/SSUM
+  100   CONTINUE
+      ENDIF
+*----
+*  RECOVER MACROSCOPIC RESIDUAL OF SCATTERING X-SECTIONS
+*----
+      CALL LCMSIX(IPCPO,'MACR',1)
+      CALL LCMLEN(IPCPO,'SCAT-SAVED',ILONG,ITYP)
+      IF(ILONG.EQ.0)THEN
+        CALL LCMGET(IPCPO,'XS-SAVED',INDXS)
+      ELSE
+        CALL LCMGET(IPCPO,'SCAT-SAVED',INDXS(21))
+      ENDIF
+      DO 130 IL=1,NL
+      DO 115 JGR=1,NGRP
+      DO 110 IGR=1,NGRP
+      SCAT(IL,IGR,JGR)=0.
+  110 CONTINUE
+  115 CONTINUE
+      WRITE (CM,'(I2.2)') IL-1
+      IF(INDXS(20+IL).EQ.1)THEN
+*     OLD COMPO DEFINITION  
+        CALL LCMLEN(IPCPO,'SCAT'//CM,ILONG,ITYP)
+        IF(ILONG.EQ.0)THEN
+          WRITE (CM,'(I2)') IL-1
+          CALL LCMGET(IPCPO,'SCAT'//CM,WORK2)
+          CALL LCMGET(IPCPO,'NJJ '//CM,NJJ)
+          CALL LCMGET(IPCPO,'IJJ '//CM,IJJ)
+        ELSE
+          CALL LCMGET(IPCPO,'SCAT'//CM,WORK2)
+          CALL LCMGET(IPCPO,'NJJS'//CM,NJJ)
+          CALL LCMGET(IPCPO,'IJJS'//CM,IJJ)
+        ENDIF
+        IGAR=0
+        DO 125 JGR=1,NGRP
+        DO 120 IGR=IJJ(JGR),IJJ(JGR)-NJJ(JGR)+1,-1
+          IGAR=IGAR+1
+          SCAT(IL,IGR,JGR)=WORK2(IGAR)
+  120   CONTINUE
+  125   CONTINUE
+      ENDIF
+  130 CONTINUE
+      CALL LCMSIX(IPCPO,' ',2)
+*----
+*  RECOVER MICROSCOPIC CONTRIBUTIONS OF SCATTERING X-SECTIONS
+*----
+      DO 160 ISO=2,NISO
+      IF(DENSIT(ISO).EQ.0.)GOTO 160
+        WRITE(HMICRO,'(3A4)') (HISO((ISO-1)*3+I),I=1,3)
+        CALL LCMLEN(IPCPO,HMICRO,ILENG,ITYLCM)
+        IF(ILENG.EQ.0)GOTO 160
+        CALL LCMSIX(IPCPO,HMICRO,1)
+        CALL LCMLEN(IPCPO,'SCAT-SAVED',ILONG,ITYP)
+*EV
+        IF(ILONG.EQ.0)THEN
+          CALL LCMGET(IPCPO,'XS-SAVED',INDXS)
+        ELSE
+          CALL LCMGET(IPCPO,'SCAT-SAVED',INDXS(21))
+        ENDIF
+*EV
+        DO 150 IL=1,NL
+        WRITE (CM,'(I2.2)') IL-1
+        IF(INDXS(20+IL).EQ.1)THEN
+*       OLD COMPO DEFINITION  
+          CALL LCMLEN(IPCPO,'SCAT'//CM,ILONG,ITYP)
+          IF(ILONG.EQ.0)THEN
+            WRITE (CM,'(I2)') IL-1
+            CALL LCMGET(IPCPO,'SCAT'//CM,WORK2)
+            CALL LCMGET(IPCPO,'NJJ '//CM,NJJ)
+            CALL LCMGET(IPCPO,'IJJ '//CM,IJJ)
+          ELSE
+            CALL LCMGET(IPCPO,'SCAT'//CM,WORK2)
+            CALL LCMGET(IPCPO,'NJJS'//CM,NJJ)
+            CALL LCMGET(IPCPO,'IJJS'//CM,IJJ)
+          ENDIF
+          IGAR=0
+          DO 145 JGR=1,NGRP
+          DO 140 IGR=IJJ(JGR),IJJ(JGR)-NJJ(JGR)+1,-1
+          IGAR=IGAR+1
+          SCAT(IL,IGR,JGR)=SCAT(IL,IGR,JGR)
+     1                    +DENSIT(ISO)*WORK2(IGAR)
+  140     CONTINUE
+  145     CONTINUE
+        ENDIF
+  150   CONTINUE
+        CALL LCMSIX(IPCPO,' ',2)
+  160 CONTINUE
+*----
+*  COMPUTE DIFFUSION COEFFICIENTS FROM STRD X-SECTIONS
+*----
+      CALL LCMSIX(IPCPO,'MACR',1)
+      CALL LCMGET(IPCPO,'XS-SAVED',INDXS)
+      CALL LCMSIX(IPCPO,' ',2)
+      IF(INDXS(17).EQ.1)THEN
+        DO 170 IGR=1,NGRP
+        DIFFX(IGR)=1.0/(3.0*DIFFX(IGR))
+  170   CONTINUE
+      ELSE IF(INDXS(18).EQ.1)THEN
+        DO 180 IGR=1,NGRP
+        DIFFX(IGR)=1.0/(3.0*DIFFX(IGR))
+        DIFFY(IGR)=1.0/(3.0*DIFFY(IGR))
+        DIFFZ(IGR)=1.0/(3.0*DIFFZ(IGR))
+  180   CONTINUE
+      ENDIF
+*----
+*  COMPUTE TOTAL CROSS SECTION FOR UPSCATERING CORRECTION
+*----
+      IF((UPS).AND.(NGRP.EQ.2))THEN
+        DO 200 IL=1,NL
+        TOTAL(2)=TOTAL(2)-SCAT(IL,2,1)
+        SCAT(IL,2,1)=0.
+  200   CONTINUE
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(ENGFIS,INDXS,WORK2,WORK1,NJJ,IJJ)
+      RETURN
+      END
diff --git a/Donjon/src/CRERGR.f b/Donjon/src/CRERGR.f
new file mode 100644
index 0000000..0e12c37
--- /dev/null
+++ b/Donjon/src/CRERGR.f
@@ -0,0 +1,261 @@
+*DECK CRERGR

+      SUBROUTINE CRERGR(IPCPO,IPMAP,NISO,NGRP,NMIXT,NL,IBM,IMPX,IBTYP,

+     1 DERIV,UPS,NBURN,BURNUP,ILEAK,TOTAL,ZNUG,SNUGF,CHI,OVERV,DIFFX,

+     2 DIFFY,DIFFZ,H,SCAT,IJJ,NJJ,HISO,ITY,CONC,FMIX,BRN0,BRN1,NCH,NB,

+     3 IVARTY)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Perform interpolation of fuel properties over the fuel lattice.

+*

+*Copyright:

+* Copyright (C) 2007 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* A. Hebert, D. Sekki

+*

+*Parameters: input

+* IPCPO   pointer to L_COMPO information.

+* IPMAP   pointer to L_MAP information.

+* NISO    1+number of extracted isotopes.

+* NGRP    number of energy groups.

+* NMIXT   number of material mixtures in the fuel-map macrolib.

+* NL      number of legendre orders (=1 for isotropic scattering).

+* IBM     mixture number to be treat.

+* IMPX    printing index (=0 for no print).

+* IBTYP   type of interpolation: =1 time-average; =2 instantaneous;

+*         derivative with respect to a single exit burnup.

+* DERIV   =.true.: derivative of macrolib info is computed with

+*         respect to burn1.

+* UPS     =.true.: no upscatering cross sections will be stored.

+* NBURN   number of tabulated burnup steps.

+* BURNUP  burnup tabulated values from compo file.

+* HISO    hollerith name information for extracted isotopes.

+* ITY     =0: do not process the isotope; =1: use number density

+*         stored in conc(i); =2: use number density stored in compo.

+* CONC    user defined number density.

+* NCH     number of reactor channels.

+* NB      number of fuel bundles per channel.

+* FMIX    fuel mixture indices per fuel bundle.

+* BRN0    contains either low burnup integration limits or 

+*         instantaneous burnups per fuel bundle.

+* BRN1    upper burnup integration limits per fuel bundle.

+* IVARTY  index of the exit burnup used to compute derivatives. Used

+*         if IBTYP=3.

+*

+*Parameters: output

+* ILEAK   diffusion coefficient flag (=1: isotropic; =2: anisotropic).

+* TOTAL   total macroscopic x-sections.

+* ZNUG    nu*fission macroscopic x-sections.

+* SNUGF   fission macroscopic x-sections.

+* CHI     fission spectrum.

+* OVERV   reciprocal neutron velocities.

+* DIFFX   x-directed diffusion coefficients.

+* DIFFY   y-directed diffusion coefficients.

+* DIFFZ   z-directed diffusion coefficients.

+* H       h-factors (kappa*fission macroscopic x-sections).

+* SCAT    scattering macroscopic x-sections.

+*

+*Parameters: 

+* IJJ

+* NJJ

+*

+*-----------------------------------------------------------------------

+*

+      USE GANLIB

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      TYPE(C_PTR) IPCPO,IPMAP

+      INTEGER NISO,IBTYP,IBM,NMIXT,NBURN,NGRP,NL,IMPX,NCH,NB,ILEAK,

+     1     IJJ(NMIXT,NL,NGRP),NJJ(NMIXT,NL,NGRP),FMIX(NCH*NB),

+     2     HISO(3*NISO),ITY(NISO),IVARTY

+      REAL CONC(NISO),TOTAL(NMIXT,NGRP),BURNUP(NBURN),SNUGF(NMIXT,NGRP),

+     1     CHI(NMIXT,NGRP),OVERV(NMIXT,NGRP),DIFFX(NMIXT,NGRP),

+     2     DIFFY(NMIXT,NGRP),DIFFZ(NMIXT,NGRP),BRN0(NCH*NB),

+     3     BRN1(NCH*NB),H(NMIXT,NGRP),SCAT(NMIXT,NL,NGRP,NGRP),

+     4     ZNUG(NMIXT,NGRP)

+      LOGICAL DERIV,UPS

+*----

+*  LOCAL VARIABLES

+*----

+      LOGICAL LCUBIC

+      PARAMETER(LCUBIC=.TRUE.)

+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ZONEDP

+      REAL, ALLOCATABLE, DIMENSION(:) :: TERP,TERPW

+      REAL, ALLOCATABLE, DIMENSION(:) :: YTOTAL,YZNUG,YNUGF,YCHI,YOVERV,

+     1 YDIFX,YDIFY,YDIFZ,YH,YSCAT,YFLUX

+      REAL, ALLOCATABLE, DIMENSION(:,:) :: ZTOTAL,ZZNUG,ZNUGF,ZCHI,

+     1 ZOVERV,ZDIFX,ZDIFY,ZDIFZ,ZH,ZSCAT,ZFLUX

+*----

+*  SCRATCH STORAGE ALLOCATION

+*----

+      ALLOCATE(TERP(NBURN),ZONEDP(NCH,NB),TERPW(NBURN))

+*

+      BURNUP(:NBURN)=0.0

+      CALL LCMGET(IPCPO,'BURNUP',BURNUP)

+*----

+*  FUEL-MAP INFORMATION

+*----

+      CALL CREGET(IPMAP,NCH,NB,IBTYP,IMPX,BRN0,BRN1,FMIX,ZONEDP,

+     1 IVARTY,VARVAL)

+*----

+*  CREATE BURNUP-DEPENDENT TABLE

+*----

+      ALLOCATE(YTOTAL(NGRP),YZNUG(NGRP),YNUGF(NGRP),YCHI(NGRP),

+     1 YOVERV(NGRP),YDIFX(NGRP),YDIFY(NGRP),YDIFZ(NGRP),YH(NGRP),

+     2 YSCAT(NL*NGRP*NGRP),YFLUX(NGRP))

+*

+      YTOTAL(:NGRP)=0.0

+      YZNUG(:NGRP)=0.0

+      YNUGF(:NGRP)=0.0

+      YCHI(:NGRP)=0.0

+      YOVERV(:NGRP)=0.0

+      YDIFX(:NGRP)=0.0

+      YDIFY(:NGRP)=0.0

+      YDIFZ(:NGRP)=0.0

+      YH(:NGRP)=0.0

+      YSCAT(:NL*NGRP*NGRP)=0.0

+      YFLUX(:NGRP)=0.0

+*

+      ALLOCATE(ZTOTAL(NGRP,NBURN),ZZNUG(NGRP,NBURN),ZNUGF(NGRP,NBURN),

+     1 ZCHI(NGRP,NBURN),ZOVERV(NGRP,NBURN),ZDIFX(NGRP,NBURN),

+     2 ZDIFY(NGRP,NBURN),ZDIFZ(NGRP,NBURN),ZH(NGRP,NBURN),

+     3 ZSCAT(NL*NGRP*NGRP,NBURN),ZFLUX(NGRP,NBURN))

+*

+      ZTOTAL(:NGRP,:NBURN)=0.0

+      ZZNUG(:NGRP,:NBURN)=0.0

+      ZNUGF(:NGRP,:NBURN)=0.0

+      ZCHI(:NGRP,:NBURN)=0.0

+      ZOVERV(:NGRP,:NBURN)=0.0

+      ZDIFX(:NGRP,:NBURN)=0.0

+      ZDIFY(:NGRP,:NBURN)=0.0

+      ZDIFZ(:NGRP,:NBURN)=0.0

+      ZH(:NGRP,:NBURN)=0.0

+      ZSCAT(:NL*NGRP*NGRP,:NBURN)=0.0

+      ZFLUX(:NGRP,:NBURN)=0.0

+*

+      CALL CRETAB(IPCPO,NISO,NGRP,NL,IMPX,HISO,NBURN,ITY,CONC,ILEAK,

+     1 ZTOTAL,ZZNUG,ZNUGF,ZCHI,ZOVERV,ZDIFX,ZDIFY,ZDIFZ,ZH,ZSCAT,ZFLUX,

+     2 UPS)

+*----

+*  PERFORM INTERPOLATION

+*----

+      DO 105 ICH=1,NCH

+      DO 100 J=1,NB

+      IB=(J-1)*NCH+ICH

+      IF(FMIX(IB).EQ.IBM)THEN

+        IF(IBTYP.EQ.1)THEN

+*         TIME-AVERAGE

+          BURN0=BRN0(IB)

+          BURN1=BRN1(IB)

+          IF(BURN0.GE.BURN1) CALL XABORT('@CRERGR: INVALID BURNUP LIMI'

+     1    //'TS(1).')

+          CALL ALTERI(LCUBIC,NBURN,BURNUP,BURN0,BURN1,TERP)

+          DO 20 I=1,NBURN

+          TERP(I)=TERP(I)/(BURN1-BURN0)

+   20     CONTINUE

+        ELSEIF(IBTYP.EQ.2)THEN

+*         INSTANTANEOUS

+          BURN0=BRN0(IB)

+          BURN1=BURN0

+          IF(NBURN.EQ.1) THEN

+            TERP(1)=1.0

+          ELSE

+            CALL ALTERP(LCUBIC,NBURN,BURNUP,BURN0,DERIV,TERP)

+          ENDIF

+        ELSEIF(IBTYP.EQ.3)THEN

+*         DERIVATIVE WITH RESPECT TO A SINGLE EXIT BURNUP. USE EQ.(3.3)

+*         OF RICHARD CHAMBON'S THESIS.

+          IF(ZONEDP(ICH,J).NE.0) THEN

+            BURN0=BRN0(IB)

+            BURN1=BRN1(IB)

+            IF(BURN0.GE.BURN1) CALL XABORT('@CRERGR: INVALID BURNUP LI'

+     1      //'MITS(2).')

+            CALL ALTERI(LCUBIC,NBURN,BURNUP,BURN0,BURN1,TERPW)

+            DO 30 I=1,NBURN

+            TERP(I)=-TERPW(I)

+   30       CONTINUE

+            CALL ALTERP(LCUBIC,NBURN,BURNUP,BURN0,.FALSE.,TERPW)

+            DO 40 I=1,NBURN

+            TERP(I)=TERP(I)-TERPW(I)*BURN0

+   40       CONTINUE

+            CALL ALTERP(LCUBIC,NBURN,BURNUP,BURN1,.FALSE.,TERPW)

+            DO 50 I=1,NBURN

+            TERP(I)=(TERP(I)+TERPW(I)*BURN1)/(VARVAL*(BURN1-BURN0))

+   50       CONTINUE

+          ELSE

+            TERP(:NBURN)=0.0

+          ENDIF

+        ENDIF

+        IF(BURN1.GT.BURNUP(NBURN))THEN

+          WRITE(*,*)'@CRERGR: BURN1 VALUE  :',BURN1

+          WRITE(*,*)'@CRERGR: BURNUP LIMIT :',BURNUP(NBURN)

+          CALL XABORT('@CRERGR: INTERPOLATION IS OUT OF BURNUP LIMIT.')

+        ENDIF

+*

+        IF((IBTYP.EQ.3).AND.(ZONEDP(ICH,J).EQ.0)) THEN

+           YTOTAL(:NGRP)=0.0

+           YZNUG(:NGRP)=0.0

+           YNUGF(:NGRP)=0.0

+           YCHI(:NGRP)=0.0

+           YOVERV(:NGRP)=0.0

+           YDIFX(:NGRP)=0.0

+           YDIFY(:NGRP)=0.0

+           YDIFZ(:NGRP)=0.0

+           YH(:NGRP)=0.0

+           YSCAT(:NL*NGRP*NGRP)=0.0

+           YFLUX(:NGRP)=0.0

+        ELSE

+           CALL CREITP(NGRP,NL,NBURN,TERP,YTOTAL,YZNUG,YNUGF,YCHI,

+     1     YOVERV,YDIFX,YDIFY,YDIFZ,YH,YSCAT,YFLUX,ZTOTAL,ZZNUG,ZNUGF,

+     2     ZCHI,ZOVERV,ZDIFX,ZDIFY,ZDIFZ,ZH,ZSCAT,ZFLUX)

+        ENDIF

+*       DATA STORAGE

+        DO 72 JGR=1,NGRP

+        TOTAL(IB,JGR)=YTOTAL(JGR)

+        ZNUG(IB,JGR)=YZNUG(JGR)

+        SNUGF(IB,JGR)=YNUGF(JGR)

+        CHI(IB,JGR)=YCHI(JGR)

+        OVERV(IB,JGR)=YOVERV(JGR)

+        DIFFX(IB,JGR)=YDIFX(JGR)

+        DIFFY(IB,JGR)=YDIFY(JGR)

+        DIFFZ(IB,JGR)=YDIFZ(JGR)

+        H(IB,JGR)=YH(JGR)

+        DO 71 IGR=1,NGRP

+        DO 70 IL=1,NL

+        SCAT(IB,IL,IGR,JGR)=YSCAT(NL*((JGR-1)*NGRP+IGR-1)+IL)

+   70   CONTINUE

+   71   CONTINUE

+   72   CONTINUE

+*       JGR IS THE SECONDARY GROUP.

+        DO 85 JGR=1,NGRP

+        DO 80 IL=1,NL

+        IGMIN=JGR

+        IGMAX=JGR

+        DO IGR=NGRP,1,-1

+          IF(SCAT(IB,IL,IGR,JGR).NE.0.)THEN

+            IGMIN=MIN(IGMIN,IGR)

+            IGMAX=MAX(IGMAX,IGR)

+          ENDIF

+        ENDDO

+        IJJ(IB,IL,JGR)=IGMAX

+        NJJ(IB,IL,JGR)=IGMAX-IGMIN+1

+   80   CONTINUE

+   85   CONTINUE

+      ENDIF

+  100 CONTINUE

+  105 CONTINUE

+*

+      DEALLOCATE(YFLUX,YSCAT,YH,YDIFZ,YDIFY,YDIFX,YOVERV,YCHI,YNUGF,

+     1 YZNUG,YTOTAL)

+*

+      DEALLOCATE(ZFLUX,ZSCAT,ZH,ZDIFZ,ZDIFY,ZDIFX,ZOVERV,ZCHI,ZNUGF,

+     1 ZZNUG,ZTOTAL)

+*----

+*  SCRATCH STORAGE DEALLOCATION

+*----

+      DEALLOCATE(TERPW,ZONEDP,TERP)

+      RETURN

+      END

diff --git a/Donjon/src/CRETAB.f b/Donjon/src/CRETAB.f
new file mode 100644
index 0000000..87fd42c
--- /dev/null
+++ b/Donjon/src/CRETAB.f
@@ -0,0 +1,128 @@
+*DECK CRETAB
+      SUBROUTINE CRETAB(IPCPO,NISO,NGRP,NL,IMPX,HISO,NBURN,ITY,CONC,
+     1 ILEAK,ZTOTAL,ZZNUG,ZNUGF,ZCHI,ZOVERV,ZDIFFX,ZDIFFY,ZDIFFZ,ZH,
+     3 ZSCAT,ZFLUX,UPS)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Create burnup dependent table with the extracted isotope.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPCPO   pointer to l_compo information.
+* NISO    1+number of extracted isotopes.
+* NGRP    number of energy groups.
+* NL      number of legendre orders (=1 for isotropic scattering).
+* IMPX    print parameter (=0 for no print).
+* HISO    hollerith name information for extracted isotopes.
+* NBURN   number of tabulated burnup steps
+* ITY     =0: do not process the isotope; =1: use number density
+*         stored in conc(i); =2: use number density stored in compo.
+* CONC    user defined number density.
+*
+*Parameters: output
+* ILEAK   diffusion coefficient flag (=1: isotropic; =2: anisotropic).
+* ZTOTAL  burnup dependent total macroscopic x-sections
+* ZZNUG   burnup dependent nu*fission macroscopic x-sections.
+* ZNUGF   burnup dependent fission macroscopic x-sections.
+* ZCHI    burnup dependent fission spectrum.
+* ZOVERV  burnup dependent reciprocal neutron velocities.
+* ZDIFFX  burnup dependent x-directed diffusion coefficients.
+* ZDIFFY  burnup dependent y-directed diffusion coefficients.
+* ZDIFFZ  burnup dependent z-directed diffusion coefficients.
+* ZH      burnup dependent h-factors (kappa*fission macroscopic
+*         x-sections).
+* ZSCAT   burnup dependent scattering macroscopic x-sections.
+* ZFLUX   burnup dependent integrated flux.
+*
+*Parameters: scratch
+* TOTAL   total macroscopic x-sections.
+* ZNUG    nu*fission macroscopic x-sections.
+* SNUGF   fission macroscopic x-sections.
+* CHI     fission spectrum.
+* OVERV   reciprocal neutron velocities.
+* DIFFX   x-directed diffusion coefficients.
+* DIFFY   y-directed diffusion coefficients.
+* DIFFZ   z-directed diffusion coefficients.
+* H       h-factors (kappa*fission macroscopic x-sections).
+* SCAT    scattering macroscopic x-sections.
+* FLUX    integrated flux.
+* DENSIT  isotopic number densities.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPCPO
+      INTEGER NISO,NGRP,NL,IMPX,NBURN,HISO(3*NISO),ITY(NISO),ILEAK
+      REAL CONC(NISO),ZTOTAL(NBURN,NGRP),ZZNUG(NBURN,NGRP),
+     1 ZCHI(NBURN,NGRP),ZOVERV(NBURN,NGRP),ZDIFFX(NBURN,NGRP),
+     2 ZDIFFY(NBURN,NGRP),ZDIFFZ(NBURN,NGRP),ZH(NBURN,NGRP),
+     3 ZSCAT(NBURN,NL,NGRP,NGRP),ZNUGF(NBURN,NGRP),ZFLUX(NBURN,NGRP)
+      LOGICAL UPS
+*----
+*  LOCAL VARIABLES
+*----
+      CHARACTER TEXT12*12
+      REAL, ALLOCATABLE, DIMENSION(:) :: TOTAL,ZNUG,CHI,OVERV,DIFFX,
+     1 DIFFY,DIFFZ,H,SNUGF,FLUX,DENSIT
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: SCAT
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(TOTAL(NGRP),ZNUG(NGRP),CHI(NGRP),OVERV(NGRP),DIFFX(NGRP),
+     1 DIFFY(NGRP),DIFFZ(NGRP),H(NGRP),SCAT(NL,NGRP,NGRP),SNUGF(NGRP),
+     2 FLUX(NGRP),DENSIT(NISO))
+*----
+*  RECOVER MACROSCOPIC X-SECTION INFO FROM BURNUP DIRECTORIES
+*----
+      DO 20 IBURN=1,NBURN
+      WRITE(TEXT12,'(4HBURN,4X,I4)') IBURN
+      CALL LCMSIX(IPCPO,TEXT12,1)
+      CALL LCMGET(IPCPO,'ISOTOPESDENS',DENSIT)
+      IF(DENSIT(1).NE.1.)CALL XABORT('@CRETAB: DENSIT(1).NE.1.')
+      DO I=2,NISO
+        IF(ITY(I).EQ.0)THEN
+          DENSIT(I)=0.
+        ELSEIF(ITY(I).EQ.1)THEN
+          DENSIT(I)=CONC(I)
+        ELSEIF(ITY(I).NE.2)THEN
+          CALL XABORT('@CRETAB: INVALID VALUE OF ITY.')
+        ENDIF
+      ENDDO
+      CALL CREMAC(IPCPO,NISO,NGRP,NL,IMPX,HISO,DENSIT,ILEAK,TOTAL,
+     1     ZNUG,SNUGF,CHI,OVERV,DIFFX,DIFFY,DIFFZ,H,SCAT,FLUX,UPS)
+      CALL LCMSIX(IPCPO,' ',2)
+      DO 21 JGR=1,NGRP
+        ZTOTAL(IBURN,JGR)=TOTAL(JGR)
+        ZZNUG(IBURN,JGR)=ZNUG(JGR)
+        ZNUGF(IBURN,JGR)=SNUGF(JGR)
+        ZCHI(IBURN,JGR)=CHI(JGR)
+        ZOVERV(IBURN,JGR)=OVERV(JGR)
+        ZDIFFX(IBURN,JGR)=DIFFX(JGR)
+        ZDIFFY(IBURN,JGR)=DIFFY(JGR)
+        ZDIFFZ(IBURN,JGR)=DIFFZ(JGR)
+        ZH(IBURN,JGR)=H(JGR)
+        ZFLUX(IBURN,JGR)=FLUX(JGR)
+        DO 22 IGR=1,NGRP
+        DO 23 IL=1,NL
+          ZSCAT(IBURN,IL,IGR,JGR)=SCAT(IL,IGR,JGR)
+   23   CONTINUE
+   22   CONTINUE
+   21 CONTINUE
+   20 CONTINUE
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(DENSIT,FLUX,SNUGF,SCAT,H,DIFFZ,DIFFY,DIFFX,OVERV,CHI,
+     1 ZNUG,TOTAL)
+      RETURN
+      END
diff --git a/Donjon/src/CREXSI.f b/Donjon/src/CREXSI.f
new file mode 100644
index 0000000..4819bf4
--- /dev/null
+++ b/Donjon/src/CREXSI.f
@@ -0,0 +1,213 @@
+*DECK CREXSI

+      SUBROUTINE CREXSI(IPMAP,NENTRY,HENTRY,KENTRY,NMIX,NGRP,NL,ILEAK,

+     1 IMPX,TOTAL,ZNUG,SNUGF,CHI,OVERV,DIFFX,DIFFY,DIFFZ,H,IJJ,NJJ,SCAT)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Recover and/or interpolate l_compo data.

+*

+*Copyright:

+* Copyright (C) 2007 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* A. Hebert, D. Sekki

+*

+*Parameters: input

+* IPMAP   pointer to the fuel-map information.

+* NENTRY  number of lcm or xsm objects used by the module.

+* HENTRY  character*12 name of each lcm or xsm objects.

+* KENTRY  pointers to the lcm or xsm objects.

+* NMIX    maximum number of material mixtures.

+* NGRP    number of energy groups.

+* NL      number of legendre orders (=1 for isotropic scattering).

+* ILEAK   diffusion coefficient flag (=1: isotropic; =2: anisotropic).

+* IMPX    printing index (=0 for no print).

+*

+*Parameters: output

+* TOTAL   total macroscopic x-sections.

+* ZNUG    nu*fission macroscopic x-sections.

+* SNUGF   fission macroscopic x-sections.

+* CHI     fission spectrum.

+* OVERV   reciprocal neutron velocities.

+* DIFFX   x-directed diffusion coefficients.

+* DIFFY   y-directed diffusion coefficients.

+* DIFFZ   z-directed diffusion coefficients.

+* H       h-factors (kappa*fission macroscopic x-sections).

+* IJJ     profile storage index.

+* NJJ     profile storage width.

+* SCAT    scattering macroscopic x-sections.

+*

+*-----------------------------------------------------------------------

+*

+      USE GANLIB

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      INTEGER NENTRY,NMIX,NGRP,NL,ILEAK,IMPX,IJJ(NMIX,NL,NGRP),

+     1 NJJ(NMIX,NL,NGRP)

+      TYPE(C_PTR) IPMAP,KENTRY(NENTRY)

+      CHARACTER HENTRY(NENTRY)*12

+      REAL TOTAL(NMIX,NGRP),ZNUG(NMIX,NGRP),SNUGF(NMIX,NGRP),

+     1     CHI(NMIX,NGRP),OVERV(NMIX,NGRP),DIFFX(NMIX,NGRP),

+     2     DIFFY(NMIX,NGRP),DIFFZ(NMIX,NGRP),H(NMIX,NGRP),

+     3     SCAT(NMIX,NL,NGRP,NGRP)

+*----

+*  LOCAL VARIABLES

+*----

+      TYPE(C_PTR) IPCPO,JPCPO,JPMAP,KPMAP

+      PARAMETER(NSTATE=40,IOUT=6)

+      CHARACTER TEXT*12,NAMDIR*12,HCOMPO*12,HSMG*131

+      INTEGER IPAR(NSTATE),IDATA(NSTATE)

+      LOGICAL DERIV,UPS,LTAB

+      DOUBLE PRECISION DFLOT

+      REAL, ALLOCATABLE, DIMENSION(:) :: YTOTAL,YZNUG,YNUGF,YCHI,YOVERV,

+     1 YDIFX,YDIFY,YDIFZ,YH,YSCAT,YFLUX

+      INTEGER, ALLOCATABLE, DIMENSION(:) :: HISO,ITY,FMIX

+      REAL, ALLOCATABLE, DIMENSION(:) :: CONC,BURNU,BRN0,BRN1

+*

+      IVARTY=0

+      UPS=.FALSE.

+      LTAB=.FALSE.

+      DERIV=.FALSE.

+      NFUEL=0

+      MAXEN=NENTRY

+      IF(C_ASSOCIATED(IPMAP))THEN

+        CALL LCMGET(IPMAP,'STATE-VECTOR',IDATA)

+        IF(IDATA(4).NE.NGRP)CALL XABORT('@CREXSI: DIFFERENT NUM'

+     1   //'BER OF ENERGY GROUPS IN COMPO AND FUEL MAP.')

+        NB=IDATA(1)

+        NCH=IDATA(2)

+        NFUEL=IDATA(7)

+        MAXEN=MAXEN-1

+        LTAB=.TRUE.

+      ENDIF

+*----

+*  READ INTERPOLATION OPTION

+*----

+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+      DO 200 IEN=2,MAXEN

+*     KEYWORD COMPO OR TABLE

+      IF(TEXT.EQ.'COMPO')THEN

+        IF(C_ASSOCIATED(IPMAP))CALL XABORT('@CREXSI: ONLY USE '

+     1   //'OF EITHER COMPO OR TABLE OPTION. BOTH OPTIONS ARE '

+     2   //'NOT ALLOWED.')

+      ELSEIF(TEXT.EQ.'TABLE')THEN

+        IF(.NOT.C_ASSOCIATED(IPMAP))CALL XABORT('@CREXSI: MISS'

+     1   //'ING FUEL MAP.')

+      ELSE

+        CALL XABORT('@CREXSI: KEYWORD COMPO OR TABLE EXPECTED.')

+      ENDIF

+*     COMPO NAME

+      CALL REDGET(ITYP,NITMA,FLOT,HCOMPO,DFLOT)

+      IF(ITYP.NE.3)CALL XABORT('@CREXSI: COMPO NAME EXPECTED.')

+      DO JEN=2,MAXEN

+        IF(HCOMPO.EQ.HENTRY(JEN))THEN

+          IPCPO=KENTRY(JEN)

+          IF(IMPX.GT.1)CALL LCMLIB(IPCPO)

+          GOTO 10

+        ENDIF

+      ENDDO

+      WRITE(HSMG,'(44HCREXSI: UNABLE TO FIND THE COMPO WITH NAME '',

+     1      A12,2H''.)') TEXT

+      CALL XABORT(HSMG)

+*----

+*  READ MIX INFO

+*----

+   10 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+      IF(TEXT.NE.'MIX')CALL XABORT('@CREXSI: KEYWORD MIX EXPECTED.')

+      CALL LCMGET(IPCPO,'STATE-VECTOR',IPAR)

+      NGRP1=IPAR(2)

+      NL1=IPAR(4)

+      NISO=IPAR(3)

+      IF(NGRP1.NE.NGRP)THEN

+        WRITE(HSMG,'(43HCREXSI: INCONSISTENT NB OF GROUPS. IN MACRO,

+     1        5HLIB =,I5,11H IN COMPO =,I5)') NGRP,NGRP1

+        CALL XABORT(HSMG)

+      ENDIF

+      IF(NL1.LT.NL)THEN

+        WRITE(HSMG,'(43HCREXSI: INCONSISTENT NB OF LEGENDRE ORDERS.,

+     1        14H IN MACROLIB =,I5,11H IN COMPO =,I5)') NL,NL1

+        CALL XABORT(HSMG)

+      ENDIF

+   20 ALLOCATE(HISO(3*NISO),ITY(NISO),CONC(NISO))

+      CALL CREXSR(IPCPO,LTAB,HCOMPO,NMIX,IMPX,NISO,IBM,DERIV,UPS,

+     1            NAMDIR,NISO1,HISO,ITY,CONC,NBURN,KBURN,IVARTY,

+     2            IBTYP,BURN0,BURN1)

+      JPCPO=LCMGID(IPCPO,NAMDIR)

+*----

+*  TABLE-OPTION INTERPOLATION

+*----

+      IF(LTAB)THEN

+*       CHECK FUEL MIXTURE

+        JPMAP=LCMGID(IPMAP,'FUEL')

+        DO 30 IFUEL=1,NFUEL

+        KPMAP=LCMGIL(JPMAP,IFUEL)

+        CALL LCMGET(KPMAP,'MIX',IMIX)

+        IF(IMIX.EQ.IBM)GOTO 40

+        CALL LCMLEN(KPMAP,'MIX-VOID',LENGT,ITYP)

+        IF(LENGT.EQ.0)GOTO 30

+        CALL LCMGET(KPMAP,'MIX-VOID',IMIX)

+        IF(IMIX.EQ.IBM)GOTO 40

+   30   CONTINUE

+        WRITE(IOUT,*)'@CREXSI: UNABLE TO FIND FUEL MIXTURE ',IBM

+        CALL XABORT('@CREXSI: WRONG MIXTURE NUMBER.')

+*

+   40   ALLOCATE(BURNU(NBURN),BRN0(NCH*NB),BRN1(NCH*NB),FMIX(NCH*NB))

+        CALL CRERGR(JPCPO,IPMAP,NISO1,NGRP,NMIX,NL,IBM,IMPX,IBTYP,DERIV,

+     1  UPS,NBURN,BURNU,ILEAK,TOTAL,ZNUG,SNUGF,CHI,OVERV,DIFFX,DIFFY,

+     2  DIFFZ,H,SCAT,IJJ,NJJ,HISO,ITY,CONC,FMIX,BRN0,BRN1,NCH,NB,IVARTY)

+        DEALLOCATE(FMIX,BRN1,BRN0,BURNU)

+        DEALLOCATE(CONC,ITY,HISO)

+*----

+*  COMPO-OPTION INTERPOLATION

+*----

+      ELSE

+        ALLOCATE(YTOTAL(NGRP),YZNUG(NGRP),YNUGF(NGRP),YCHI(NGRP),

+     1  YOVERV(NGRP),YDIFX(NGRP),YDIFY(NGRP),YDIFZ(NGRP),YH(NGRP),

+     2  YSCAT(NL*NGRP*NGRP),YFLUX(NGRP))

+        CALL CREINT(JPCPO,NISO1,DERIV,NBURN,KBURN,BURN0,BURN1,NGRP,

+     1  NL,IMPX,HISO,ITY,CONC,ILEAK,YTOTAL,YZNUG,YNUGF,YCHI,YOVERV,

+     2  YDIFX,YDIFY,YDIFZ,YH,YSCAT,YFLUX,UPS)

+*       DATA STORAGE.

+        DO 112 JGR=1,NGRP

+          TOTAL(IBM,JGR)=YTOTAL(JGR)

+          ZNUG(IBM,JGR)=YZNUG(JGR)

+          SNUGF(IBM,JGR)=YNUGF(JGR)

+          CHI(IBM,JGR)=YCHI(JGR)

+          OVERV(IBM,JGR)=YOVERV(JGR)

+          DIFFX(IBM,JGR)=YDIFX(JGR)

+          DIFFY(IBM,JGR)=YDIFY(JGR)

+          DIFFZ(IBM,JGR)=YDIFZ(JGR)

+          H(IBM,JGR)=YH(JGR)

+          DO 111 IGR=1,NGRP

+          DO 110 IL=1,NL

+            SCAT(IBM,IL,IGR,JGR)=YSCAT(NL*((JGR-1)*NGRP+IGR-1)+IL)

+  110     CONTINUE

+  111     CONTINUE

+  112   CONTINUE

+        DEALLOCATE(YFLUX,YSCAT,YH,YDIFZ,YDIFY,YDIFX,YOVERV,YCHI,YNUGF,

+     1  YZNUG,YTOTAL)

+        DEALLOCATE(CONC,ITY,HISO)

+*       JGR IS THE SECONDARY GROUP.

+        DO 135 JGR=1,NGRP

+        DO 130 IL=1,NL

+        IGMIN=JGR

+        IGMAX=JGR

+        DO IGR=NGRP,1,-1

+          IF(SCAT(IBM,IL,IGR,JGR).NE.0.)THEN

+            IGMIN=MIN(IGMIN,IGR)

+            IGMAX=MAX(IGMAX,IGR)

+          ENDIF

+        ENDDO

+        IJJ(IBM,IL,JGR)=IGMAX

+        NJJ(IBM,IL,JGR)=IGMAX-IGMIN+1

+  130   CONTINUE

+  135   CONTINUE

+      ENDIF

+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+      IF(TEXT.EQ.'MIX')GOTO 20

+  200 CONTINUE

+      IF(TEXT.NE.';') CALL XABORT('@CREXSI: FINAL ; EXPECTED.')

+      RETURN

+      END

diff --git a/Donjon/src/CREXSR.f b/Donjon/src/CREXSR.f
new file mode 100644
index 0000000..dcc41eb
--- /dev/null
+++ b/Donjon/src/CREXSR.f
@@ -0,0 +1,170 @@
+*DECK CREXSR
+      SUBROUTINE CREXSR(IPCPO,LTAB,HCOMPO,NMIXT,IMPX,NISO,IBM,DERIV,UPS,
+     1 NAMDIR,NISOR,HISO,ITY,CONC,NBURN,KBURN,IVARTY,IBTYP,BURN0,BURN1)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Read input data stream for MIX record and recover the information
+* from l_compo linked list.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input/output
+* IPCPO   pointer to l_compo information.
+* HCOMPO  name of l_compo linked list.
+* LTAB    flag: =.true. table option; =.false. compo option.
+* NMIXT   maximum number of material mixtures.
+* IMPX    printing index (=0 for no print).
+* NISO    1+maximum number of extracted isotopes.
+* IBM     mixture number to be treated.
+* NAMDIR  character*12 name of directory in l_compo object.
+* DERIV   flag: =.true. derivative of the macrolib is computed with
+*         respect to burn1.
+* UPS     flag: =.true. no up-scatering cross section will be stored.
+* NISOR   1+number of extracted isotopes.
+* HISO    hollerith name information for extracted isotopes.
+* ITY     =0: do not process the isotope; =1: use number density
+*         stored in conc(i); =2: use number density stored in compo.
+* CONC    user defined number density.
+* NBURN   number of burnup steps in compo linked list.
+* BURN0   user defined initial burnup.
+* BURN1   user defined final burnup:  if burn0=burn1 => a simple 
+*         interpolation is performed; if burn0<burn1 => a time-average
+*         calculation is performed.
+* KBURN   =0: no burnup parameters; =1: use mw day/tonne of initial
+*         heavy elements.
+* IVARTY  index of the exit burnup used to compute derivatives. Set to
+*         zero to avoid taking the derivative.
+* IBTYP   type of interpolation: =1 time-average; =2 instantaneous;
+*         derivative with respect to a single exit burnup.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPCPO
+      INTEGER NMIXT,IMPX,NISO,IBM,NISOR,NBURN,KBURN,IVARTY,IBTYP,
+     1        HISO(3*NISO),ITY(NISO)
+      LOGICAL DERIV,UPS,LTAB
+      CHARACTER NAMDIR*12,HCOMPO*12
+      REAL CONC(NISO),BURN0,BURN1
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(NSTATE=40,IOUT=6)
+      TYPE(C_PTR) JPCPO
+      INTEGER IPAR(NSTATE)
+      CHARACTER TEXT12*12,TEXT*12,CGRPNM*12
+      DOUBLE PRECISION DFLOT
+*
+      KBURN=0
+      ITY(:NISO)=0
+      ITY(1)=2
+*----
+*  RECOVER INFORMATION
+*----
+      IBM=0
+      TEXT12='MIX'
+   10 IF(TEXT12.EQ.'MIX')THEN
+        IVARTY=0
+        IBTYP=0
+        IF(IBM.NE.0)CALL XABORT('@CREXSR: MIX ALREADY SELECTED.')
+        CALL REDGET(ITYP,IBM,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@CREXSR: INTEGER DATA EXPECTED.')
+        IF(IBM.GT.NMIXT)CALL XABORT('@CREXSR: INVALID MIX INDEX.')
+        CALL REDGET(ITYP,NITMA,FLOT,NAMDIR,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@CREXSR: CHARACTER DATA EXPECTED.')
+        IF(IMPX.GT.0)WRITE(6,'(/27H CREXSR: ACCESS DIRECTORY '',A12,
+     1  17H'' IN COMPO FILE '',A12,2H''.)') NAMDIR,HCOMPO
+        JPCPO=LCMGID(IPCPO,NAMDIR)
+        CALL LCMGET(JPCPO,'PARAM',IPAR)
+        NISOR=IPAR(2)
+        NBURN=IPAR(4)
+        IF(NISOR.GT.1)CALL LCMGET(JPCPO,'ISOTOPESNAME',HISO)
+      ELSEIF(TEXT12.EQ.'I-BURNUP')THEN
+        IF(LTAB )CALL XABORT('@CREXSR: INVALID OPTION I-BURNUP WITH'
+     1   //' FUEL MAP OBJECT.')
+        IF(NBURN.LE.1)CALL XABORT('@CREXSR: NO BURNUP INFORMATION.')
+        KBURN=1
+        CALL REDGET(ITYP,NITMA,BURN0,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@CREXSR: REAL DATA EXPECTED(1).')
+        BURN1=BURN0
+      ELSEIF(TEXT12.EQ.'T-BURNUP')THEN
+        IF(LTAB )CALL XABORT('@CREXSR: INVALID OPTION T-BURNUP WITH'
+     1   //' FUEL MAP OBJECT.')
+        IF(NBURN.LE.1)CALL XABORT('@CREXSR: NO BURNUP INFORMATION.')
+        KBURN=1
+        CALL REDGET(ITYP,NITMA,BURN0,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@CREXSR: REAL DATA EXPECTED(2).')
+        CALL REDGET(ITYP,NITMA,BURN1,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@CREXSR: REAL DATA EXPECTED(3).')
+        IF(BURN1.LE.BURN0)CALL XABORT('@CREXSR: INVALID BURN1.')
+      ELSEIF(TEXT12.EQ.'MICRO')THEN
+        IF(NISO.LE.1)CALL XABORT('NO EXTRACTED ISOTOPES IN L_COMPO.')
+   20   CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@CREXSR: CHARACTER DATA EXPECTED.')
+        IF(TEXT.EQ.'ALL')THEN
+          DO 30 I=2,NISO
+          ITY(I)=2
+   30     CONTINUE
+        ELSEIF(TEXT.EQ.'ENDMIX')THEN
+          TEXT12=TEXT
+          GOTO 10
+        ELSEIF(TEXT.EQ.'UPS')THEN
+          TEXT12=TEXT
+          GOTO 10
+        ELSE
+          DO 50 I=1,NISO
+          WRITE(CGRPNM,'(3A4)') (HISO(3*(I-1)+J),J=1,3)
+          IF(CGRPNM.EQ.TEXT)THEN
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+            IF(ITYP.EQ.2)THEN
+              CONC(I)=FLOT
+              ITY(I)=1
+            ELSEIF((ITYP.EQ.3).AND.(TEXT.EQ.'*'))THEN
+              ITY(I)=2
+            ELSE
+              CALL XABORT('@CREXSR: REAL NUMBER OR * EXPECTED.')
+            ENDIF
+            GOTO 20
+          ENDIF
+   50     CONTINUE
+          CALL XABORT('@CREXSR: UNABLE TO MATCH ISOTOPE'//TEXT//'.')
+        ENDIF
+      ELSEIF(TEXT12.EQ.'DERIV')THEN
+        DERIV=.TRUE.
+      ELSEIF(TEXT12.EQ.'TIMAV-BURN')THEN
+        IBTYP=1
+      ELSEIF(TEXT12.EQ.'INST-BURN')THEN
+        IBTYP=2
+      ELSEIF(TEXT12.EQ.'AVG-EX-BURN') THEN
+        IBTYP=3
+        CALL REDGET(INDIC,IVARTY,FLOTT,TEXT12,DFLOT)
+        IF(INDIC.NE.1) CALL XABORT('CREXSR: INTEGER DATA EXPECTED'
+     1  //'(AVG-EX-BURN).')
+      ELSEIF(TEXT12.EQ.'UPS')THEN
+        UPS=.TRUE.
+      ELSEIF(TEXT12.EQ.'ENDMIX')THEN
+        IF(LTAB)THEN
+          IF(NBURN.LE.0)CALL XABORT('@CREXSR: NO BURNUP INFORMATION '
+     1     //'FOR THIS MIXTURE.')
+        ELSE
+          IF((KBURN.EQ.0).AND.(NBURN.GT.1))CALL XABORT('@CREXSR: BUR'
+     1     //'NUP INTEGRATION OPTION REQUIRED.')
+        ENDIF
+        RETURN
+      ELSE
+        WRITE(IOUT,'(A40)')'@CREXSR: MIX SHOULD FINISH WITH ENDMIX.'
+        CALL XABORT('@CREXSR: WRONG KEYWORD '//TEXT12//'.')
+      ENDIF
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('@CREXSR: CHARACTER DATA EXPECTED.')
+      GOTO 10
+      END
diff --git a/Donjon/src/CVR.f b/Donjon/src/CVR.f
new file mode 100644
index 0000000..3ca5280
--- /dev/null
+++ b/Donjon/src/CVR.f
@@ -0,0 +1,114 @@
+*DECK CVR

+      SUBROUTINE CVR(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Perform reordering of fuel-regions properties in the reactor core,

+* according to the specified voiding pattern.

+*

+*Copyright:

+* Copyright (C) 2007 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* D. Sekki

+*

+*Parameters: input

+* NENTRY  number of data structures transfered to this module.

+* HENTRY  name of the data structures.

+* IENTRY  data structure type where:

+*         IENTRY=1 for LCM memory object;

+*         IENTRY=2 for XSM file;

+*         IENTRY=3 for sequential binary file;

+*         IENTRY=4 for sequential ASCII file.

+* JENTRY  access permission for the data structure where:

+*         JENTRY=0 for a data structure in creation mode;

+*         JENTRY=1 for a data structure in modifications mode;

+*         JENTRY=2 for a data structure in read-only mode.

+* KENTRY  data structure pointer.

+*

+*Comments:

+* The CVR: module specification is: 

+* FMAPV := CVR: FMAP :: (descrcvr) ;

+* where

+*   FMAP  : name of a read-only \emph{fmap} object,

+*     created in the RESINI: module. This object must contain the non-perturbed

+*     fuel-cell properties.

+*   FMAPV : name of a new \emph{fmap} object,

+*     that will contain the modified fuel-type indices and reordered coolant 

+*     densities according to the specified core-voiding pattern.

+*   (descrcvr) : structure describing the input data to the CVR: module.

+*

+*-----------------------------------------------------------------------

+*

+      USE GANLIB

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)

+      TYPE(C_PTR)  KENTRY(NENTRY)

+      CHARACTER    HENTRY(NENTRY)*12

+*----

+*  LOCAL VARIABLES

+*----

+      PARAMETER(NSTATE=40)

+      CHARACTER TEXT*12,HSIGN*12

+      INTEGER ISTATE(NSTATE),IGST(NSTATE)

+      DOUBLE PRECISION DFLOT

+      TYPE(C_PTR) IPMAP,JPMAP

+*----

+*  PARAMETER VALIDATION

+*----

+      IF(NENTRY.NE.2)CALL XABORT('@CVR: TWO PARAMETERS EXPECTED.')

+      TEXT=HENTRY(1)

+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2))CALL XABORT('@CVR:'

+     1 //' LCM OBJECT EXPECTED AT LHS ('//TEXT//').')

+      IF(JENTRY(1).NE.0)CALL XABORT('@CVR: FUEL MAP OBJECT IN CRE'

+     1 //'ATE MODE EXPECTED AT LHS ('//TEXT//').')

+      TEXT=HENTRY(2)

+      IF((IENTRY(2).NE.1).AND.(IENTRY(2).NE.2))CALL XABORT('@CVR:'

+     1 //' LCM OBJECT EXPECTED AT RHS ('//TEXT//').')

+      IF(JENTRY(2).NE.2)CALL XABORT('@CVR: FUEL MAP OBJECT IN REA'

+     1 //'D-ONLY MODE EXPECTED AT RHS ('//TEXT//').')

+      CALL LCMGTC(KENTRY(2),'SIGNATURE',12,HSIGN)

+      IF(HSIGN.NE.'L_MAP')THEN

+        TEXT=HENTRY(2)

+        CALL XABORT('@CVR: SIGNATURE OF '//TEXT//' IS '//HSIGN//

+     1  '. L_MAP EXPECTED.')

+      ENDIF

+      IPMAP=KENTRY(1)

+      CALL LCMEQU(KENTRY(2),IPMAP)

+*----

+*  RECOVER INFORMATION

+*----

+      ISTATE(:NSTATE)=0

+      CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)

+      NB=ISTATE(1)

+      NCH=ISTATE(2)

+      NFUEL=ISTATE(7)

+      NPARM=ISTATE(8)

+*     FUEL-MAP GEOMETRY

+      JPMAP=LCMGID(IPMAP,'GEOMAP')

+      IGST(:NSTATE)=0

+      CALL LCMGET(JPMAP,'STATE-VECTOR',IGST)

+      IF(IGST(1).NE.7)CALL XABORT('@CVR: ONLY 3-D CART'

+     1 //'ESIAN GEOMETRY ALLOWED.')

+      NX=IGST(3)

+      NY=IGST(4)

+      NZ=IGST(5)

+*     PRINTING INDEX

+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+      IF(ITYP.NE.3)CALL XABORT('@CVR: CHARACTER DATA EXPECTED.')

+      IF(TEXT.NE.'EDIT')CALL XABORT('@CVR: KEYWORD EDIT EXPECTED.')

+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+      IF(ITYP.NE.1)CALL XABORT('@CVR: INTEGER FOR EDIT EXPECTED.')

+      IMPX=MAX(0,NITMA)

+*     READ INPUT DATA

+      CALL CVRDRV(IPMAP,NCH,NB,NFUEL,NPARM,NX,NY,NZ,NVD,IVD,IMPX)

+*     UPDATE STATE-VECTOR

+      ISTATE(10)=NVD

+      ISTATE(11)=IVD

+      CALL LCMPUT(IPMAP,'STATE-VECTOR',NSTATE,1,ISTATE)

+      IF(IMPX.GT.1) CALL LCMLIB(IPMAP)

+      RETURN

+      END

diff --git a/Donjon/src/CVRCOR.f b/Donjon/src/CVRCOR.f
new file mode 100644
index 0000000..c7ea5d1
--- /dev/null
+++ b/Donjon/src/CVRCOR.f
@@ -0,0 +1,130 @@
+*DECK CVRCOR
+      SUBROUTINE CVRCOR(IPMAP,NCH,NB,NFUEL,NX,NY,NZ,IVOID,NVOID,NPARM,
+     1 PNAME,PVALUE,VCOOL,LCOOL,IMPX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Modify channels data according to the specified core-voiding pattern.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki
+*
+*Parameters: input/output
+* IPMAP   pointer to the perturbed fuel-map.
+* NCH     number of reactor channels.
+* NB      number of fuel bundles per channel.
+* NFUEL   number of fuel types.
+* NX      number of elements along x-axis in fuel map.
+* NY      number of elements along y-axis in fuel map.
+* NZ      number of elements along z-axis in fuel map.
+* IVOID   index associated with the core-voiding pattern:
+*          =1 full-core; =2 half-core; =3 quarter-core;
+*          =4 checkerboard-full; =5 checkerboard-half;
+*          =6 checkerboard-quarter.
+* NVOID   total number of voided channels.
+* NPARM   total number of recorded parameters.
+* PNAME   recorded parameter name for the coolant density.
+* PVALUE  structure containing the coolant density values
+*         throughout the reactor core.
+* VCOOL   coolant density value for voided channels.
+* LCOOL   flag with respect to the coolant densities:
+*          =.true. to modify these values;
+*          =.false. coolant densities not provided.
+* IMPX    printing index (=0 for no print).
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAP
+      INTEGER NCH,NB,NFUEL,NX,NY,NZ,IVOID,NVOID,NPARM,IMPX
+      REAL PVALUE(NCH,NB),VCOOL
+      CHARACTER PNAME*12
+      LOGICAL LCOOL
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(IOUT=6)
+      INTEGER FLMIX(NCH,NB),NSCH(NCH),INAME(3)
+      CHARACTER TEXT*20,TEXT12*12
+      LOGICAL LCHK
+      TYPE(C_PTR) JPMAP,KPMAP
+*----
+*  RECOVER INFORMATION
+*----
+      FLMIX(:NCH,:NB)=0
+      NSCH(:NCH)=0
+      LCHK=.FALSE.
+      CALL LCMGET(IPMAP,'FLMIX',FLMIX)
+      CALL LCMLEN(IPMAP,'REF-SCHEME',LENGT,ITYP)
+      IF(LENGT.EQ.0)CALL XABORT('@CVRCOR: MISSI'
+     1 //'NG REF-SCHEME DATA IN FUEL-MAP.')
+      CALL LCMGET(IPMAP,'REF-SCHEME',NSCH)
+      IF(IVOID.EQ.1)THEN
+        TEXT='FULL-CORE'
+      ELSEIF(IVOID.EQ.2)THEN
+        TEXT='HALF-CORE'
+      ELSEIF(IVOID.EQ.3)THEN
+        TEXT='QUARTER-CORE'
+      ELSEIF(IVOID.EQ.4)THEN
+        TEXT='CHECKERBOARD-FULL'
+        LCHK=.TRUE.
+      ELSEIF(IVOID.EQ.5)THEN
+        TEXT='CHECKERBOARD-HALF'
+        LCHK=.TRUE.
+      ELSEIF(IVOID.EQ.6)THEN
+        TEXT='CHECKERBOARD-QUARTER'
+        LCHK=.TRUE.
+      ENDIF
+      IF(IMPX.GT.0)WRITE(IOUT,1000)TEXT,NVOID
+*----
+*  MODIFY CHANNEL DATA
+*----
+      ITOT=0
+      JPMAP=LCMGID(IPMAP,'FUEL')
+      DO IFUEL=1,NFUEL
+        KPMAP=LCMGIL(JPMAP,IFUEL)
+        CALL LCMGET(KPMAP,'MIX',MIXF)
+        CALL LCMGET(KPMAP,'MIX-VOID',MIXV)
+        DO 20 ICH=1,NVOID
+        IF(LCHK)THEN
+          IF(NSCH(ICH).LT.0)GOTO 20
+*         POSITIVE DIRECTION ONLY
+        ENDIF
+        DO 10 IB=1,NB
+        IF(FLMIX(ICH,IB).NE.MIXF)GOTO 10
+        FLMIX(ICH,IB)=MIXV
+        IF(LCOOL) PVALUE(ICH,IB)=VCOOL
+        ITOT=ITOT+1
+   10   CONTINUE
+   20   CONTINUE
+      ENDDO
+      IF(IMPX.GT.0)WRITE(IOUT,1001)ITOT
+      IF(IMPX.LT.2)GOTO 30
+*     PRINTING
+      CALL CVRPRN(IPMAP,NCH,NB,NX,NY,NZ,FLMIX,PVALUE,LCOOL,IMPX)
+*     STORE NEW DATA
+   30 CALL LCMPUT(IPMAP,'FLMIX',NCH*NB,1,FLMIX)
+      IF(.NOT.LCOOL)GOTO 40
+      JPMAP=LCMGID(IPMAP,'PARAM')
+      DO IPAR=1,NPARM
+        KPMAP=LCMGIL(JPMAP,IPAR)
+        CALL LCMGET(KPMAP,'P-NAME',INAME)
+        WRITE(TEXT12,'(3A4)') (INAME(I),I=1,3)
+        IF(PNAME.EQ.TEXT12)THEN
+          CALL LCMPUT(KPMAP,'P-VALUE',NCH*NB,2,PVALUE)
+          GOTO 40
+        ENDIF
+      ENDDO
+   40 RETURN
+*
+ 1000 FORMAT(/2X,'SELECTED VOIDING PATTERN',2X,'=>',2X,A20
+     1     //2X,'TOTAL NUMBER OF VOIDED CHANNELS =',1X,I3/)
+ 1001 FORMAT(2X,'TOTAL NUMBER OF MODIFIED VALUES :',1X,I4/)
+      END
diff --git a/Donjon/src/CVRDRV.f b/Donjon/src/CVRDRV.f
new file mode 100644
index 0000000..08cbe5c
--- /dev/null
+++ b/Donjon/src/CVRDRV.f
@@ -0,0 +1,174 @@
+*DECK CVRDRV

+      SUBROUTINE CVRDRV(IPMAP,NCH,NB,NFUEL,NPARM,NX,NY,NZ,NVOID,IVOID,

+     1 IMPX)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Read the input data required for the voiding simulations.

+*

+*Copyright:

+* Copyright (C) 2007 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* D. Sekki

+*

+*Parameters: input

+* IPMAP  pointer to the perturbed fuel-map.

+* NCH    number of reactor channels.

+* NB     number of fuel bundles per channel.

+* NFUEL  number of fuel types.

+* NPARM  total number of recorded parameters.

+* NX     number of elements along x-axis in fuel map.

+* NY     number of elements along y-axis in fuel map.

+* NZ     number of elements along z-axis in fuel map.

+* IMPX   printing index (=0 for no print).

+*

+*Parameters: output

+* IVOID  index associated with the core-voiding pattern.

+* NVOID  total number of voided channels.

+*

+*-----------------------------------------------------------------------

+*

+      USE GANLIB

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      TYPE(C_PTR) IPMAP

+      INTEGER NCH,NB,NFUEL,NPARM,NX,NY,NZ,NVOID,IVOID,IMPX

+*----

+*  LOCAL VARIABLES

+*----

+      PARAMETER(IOUT=6)

+      CHARACTER TEXT*12,PNAME*12,CHANX*4,CHANY*4

+      INTEGER INAME(3)

+      DOUBLE PRECISION DFLOT

+      REAL PVALUE(NCH,NB)

+      LOGICAL LCOOL

+      TYPE(C_PTR) JPMAP,KPMAP

+      INTEGER, ALLOCATABLE, DIMENSION(:) :: NXX,NYY

+*----

+*  FUEL-TYPE INDICES

+*----

+      JPMAP=LCMGID(IPMAP,'FUEL')

+      DO IFUEL=1,NFUEL

+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+        IF(ITYP.NE.3)CALL XABORT('@CVRDRV: CHARACTER DATA EXPECTED(1).')

+        IF(TEXT.NE.'MIX-FUEL')CALL XABORT('@CVRDRV: KEYWORD MIX-FUEL'

+     1   //' EXPECTED.')

+*       UNPERTURBED-CELL FUEL MIXTURE NUMBER

+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+        IF(ITYP.NE.1)CALL XABORT('@CVRDRV: INTEGER DATA EXPECTED(1).')

+        KPMAP=LCMGIL(JPMAP,IFUEL)

+        CALL LCMGET(KPMAP,'MIX',IMIX)

+        IF(IMIX.NE.NITMA)THEN

+          WRITE(IOUT,*)'@CVRDRV: RECORDED FUEL MIXTURE NUMBER ',IMIX

+          WRITE(IOUT,*)'@CVRDRV: READ FROM INPUT THE MIXTURE ',NITMA

+          CALL XABORT('@CVRDRV: WRONG INPUT ORDER OF FUEL MIXTURES.')

+        ENDIF

+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+        IF(ITYP.NE.3)CALL XABORT('@CVRDRV: CHARACTER DATA EXPECTED(2).')

+        IF(TEXT.NE.'MIX-VOID')CALL XABORT('@CVRDRV: KEYWORD MIX-VOI'

+     1   //'D EXPECTED.')

+*       PERTURBED-CELL FUEL MIXTURE NUMBER

+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+        IF(ITYP.NE.1)CALL XABORT('@CVRDRV: INTEGER DATA EXPECTED(2).')

+        IF(NITMA.LE.0)CALL XABORT('@CVRDRV: MIX-VOID NUMBER MUST BE'

+     1   //' POSITIVE AND GREATER THAN ZERO.')

+        CALL LCMPUT(KPMAP,'MIX-VOID',1,1,NITMA)

+      ENDDO

+*----

+*  COOLANT DENSITIES

+*----

+      LCOOL=.FALSE.

+      PVALUE(:NCH,:NB)=0.0

+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+      IF(ITYP.NE.3)CALL XABORT('@CVRDRV: CHARACTER DATA EXPECTED(3).')

+      IF(TEXT.NE.'DENS-COOL')GOTO 20

+      IF(NPARM.EQ.0)CALL XABORT('@CVRDRV: NO DEFINED PARAMETERS IN T'

+     1 //'HE FUEL-MAP NPARM=0')

+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+      IF(ITYP.NE.3)CALL XABORT('@CVRDRV: CHARACTER DATA FOR PARAMETE'

+     1 //'R PNAME EXPECTED.')

+      JPMAP=LCMGID(IPMAP,'PARAM')

+      DO IPAR=1,NPARM

+        KPMAP=LCMGIL(JPMAP,IPAR)

+        CALL LCMGET(KPMAP,'P-NAME',INAME)

+        WRITE(PNAME,'(3A4)') (INAME(I),I=1,3)

+        IF(PNAME.EQ.TEXT)THEN

+          CALL LCMGET(KPMAP,'P-VALUE',PVALUE)

+          GOTO 10

+        ENDIF

+      ENDDO

+      CALL XABORT('@CVRDRV: UNABLE TO FIND PARAMETER WITH PNAME '//TEXT)

+*

+   10 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+      IF(TEXT.NE.'SET')CALL XABORT('@CVRDRV: KEYWORD SET EXPECTED.')

+      CALL REDGET(ITYP,NITMA,VCOOL,TEXT,DFLOT)

+      IF(ITYP.NE.2)CALL XABORT('@CVRDRV: REAL DATA FOR THE COOLANT DEN'

+     1 //'SITY EXPECTED.')

+      IF(VCOOL.LT.0.)CALL XABORT('@CVRDRV: INVALID VALUE FOR THE COOLA'

+     1 //'NT DENSITY <0.')

+      LCOOL=.TRUE.

+*----

+*  CORE-VOIDING PATTERN

+*----

+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+   20 IF(TEXT.NE.'VOID-PATTERN')CALL XABORT('@CVRDRV: KEYWORD VOID-'

+     1 //'PATTERN EXPECTED.')

+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+      IF(ITYP.NE.3)CALL XABORT('@CVRDRV: CHARACTER DATA EXPECTED(4).')

+      IF(TEXT.EQ.'FULL')THEN

+        IVOID=1

+        NVOID=NCH

+      ELSEIF(TEXT.EQ.'HALF')THEN

+        IVOID=2

+        NVOID=NCH/2

+      ELSEIF(TEXT.EQ.'QUARTER')THEN

+        IVOID=3

+        NVOID=NCH/4

+      ELSEIF(TEXT.EQ.'CHECKER')THEN

+        IVOID=4

+        NVOID=NCH

+      ELSEIF(TEXT.EQ.'CHECKER-1/2')THEN

+        IVOID=5

+        NVOID=NCH/2

+      ELSEIF(TEXT.EQ.'CHECKER-1/4')THEN

+        IVOID=6

+        NVOID=NCH/4

+      ELSEIF(TEXT.EQ.'CHAN-VOID')THEN

+*----

+*  USER-DEFINED PATTERN

+*----

+        IVOID=7

+*       TOTAL NUMBER OF VOIDED CHANNELS

+        CALL REDGET(ITYP,NVOID,FLOT,TEXT,DFLOT)

+        IF(ITYP.NE.1)CALL XABORT('@CVRDRV: INTEGER TOTAL NUMBER OF V'

+     1   //'OIDED CHANNELS EXPECTED.')

+        IF((NVOID.LT.1).OR.(NVOID.GT.NCH))CALL XABORT('@CVRDRV: TH'

+     1   //'E NUMBER OF VOIDED CHANNELS MUST BE > 0 AND < NCH')

+        ALLOCATE(NXX(NVOID),NYY(NVOID))

+        DO I=1,NVOID

+*         VOIDED-CHANNEL YNAME

+          CALL REDGET(ITYP,NITMA,FLOT,CHANY,DFLOT)

+          IF(ITYP.NE.3)CALL XABORT('@CVRDRV: CHANNEL YNAME EXPECTED.')

+          READ(CHANY,'(A4)') NYY(I)

+*         VOIDED-CHANNEL XNAME

+          CALL REDGET(ITYP,NITMA,FLOT,CHANX,DFLOT)

+          IF(ITYP.NE.3)CALL XABORT('@CVRDRV: CHANNEL XNAME EXPECTED.')

+          READ(CHANX,'(A4)') NXX(I)

+        ENDDO

+        CALL CVRUSR(IPMAP,NCH,NB,NFUEL,NX,NY,NZ,NVOID,NXX,NYY,NPARM,

+     1  PNAME,PVALUE,VCOOL,LCOOL,IMPX)

+        DEALLOCATE(NXX,NYY)

+      ELSE

+        CALL XABORT('@CVRDRV: WRONG KEYWORD '//TEXT)

+      ENDIF

+*

+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+      IF(TEXT.NE.';')CALL XABORT('@CVRDRV: FINAL ; EXPECTED.')

+*     SPECIFIED CORE-VOIDING PATTERN

+      IF(IVOID.LT.7) CALL CVRCOR(IPMAP,NCH,NB,NFUEL,NX,NY,NZ,IVOID,

+     1 NVOID,NPARM,PNAME,PVALUE,VCOOL,LCOOL,IMPX)

+      RETURN

+      END

diff --git a/Donjon/src/CVRPRN.f b/Donjon/src/CVRPRN.f
new file mode 100644
index 0000000..dc60cc5
--- /dev/null
+++ b/Donjon/src/CVRPRN.f
@@ -0,0 +1,124 @@
+*DECK CVRPRN
+      SUBROUTINE CVRPRN(IPMAP,NCH,NB,NX,NY,NZ,MIXNEW,PVALUE,LCOOL,IMPX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Print the fuel-type indices per bundle for each reactor channel.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki
+*
+*Parameters: input/output
+* IPMAP   pointer to fuel-map information.
+* NCH     number of reactor channels.
+* NB      number of fuel bundles per channel.
+* NX      number of elements along x-axis in fuel map.
+* NY      number of elements along y-axis in fuel map.
+* NZ      number of elements along z-axis in fuel map.
+* MIXNEW  updated fuel-type index.
+* PVALUE  structure containing the modified coolant density
+*         values throughout the reactor core.
+* LCOOL   flag with respect to the coolant densities:
+*          =.true. coolant densities were modified;
+*          =.false. coolant densities not provided.
+* IMPX    printing index (=0 for no print).
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAP
+      INTEGER NCH,NB,NX,NY,NZ,MIXNEW(NCH,NB),IMPX
+      REAL PVALUE(NCH,NB)
+      LOGICAL LCOOL
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(IOUT=6)
+      INTEGER MIX(NX*NY*NZ),MIXOLD(NCH,NB),
+     1 NSCH(NCH),NAMX(NX),NAMY(NY),FMIX(NX,NY,NB)
+      CHARACTER TEXT*12,CHANX*2,CHANY*2,FORM1*14,FORM2*14
+*----
+*  RECOVER INFORMATION
+*----
+      MIX(:NX*NY*NZ)=0
+      MIXOLD(:NCH,NB)=0
+      NSCH(:NCH)=0
+      NAMX(:NX)=0
+      NAMY(:NY)=0
+      FMIX(:NX,:NY,:NB)=0
+      CALL LCMGET(IPMAP,'BMIX',MIX)
+      CALL LCMGET(IPMAP,'FLMIX',MIXOLD)
+*     CHANNEL NAMES
+      CALL LCMGET(IPMAP,'XNAME',NAMX)
+      CALL LCMGET(IPMAP,'YNAME',NAMY)
+*     REFUELLING SCHEME
+      CALL LCMLEN(IPMAP,'REF-SCHEME',LENGT,ITYP)
+      IF(LENGT.EQ.0)CALL XABORT('@CVRPRN: MISSI'
+     1 //'NG REF-SCHEME DATA IN FUEL-MAP.')
+      CALL LCMGET(IPMAP,'REF-SCHEME',NSCH)
+      IF((IMPX.NE.2).AND.(IMPX.LT.4))GOTO 20
+*----
+*  PRINTING OVER EACH CHANNEL
+*----
+      IEL=0
+      ICH=0
+      DO 15 J=1,NY
+      DO 10 I=1,NX
+      IEL=IEL+1
+      IF(MIX(IEL).EQ.0)GOTO 10
+      ICH=ICH+1
+      WRITE(TEXT,'(A9,I3.3)')'CHANNEL #',ICH
+      WRITE(CHANX,'(A2)') (NAMX(I))
+      WRITE(CHANY,'(A2)') (NAMY(J))
+      WRITE(IOUT,1001)TEXT,CHANY,CHANX,NSCH(ICH)
+      WRITE(IOUT,1002) (MIXOLD(ICH,IB),IB=1,NB)
+      WRITE(IOUT,1003) (MIXNEW(ICH,IB),IB=1,NB)
+      IF(LCOOL)WRITE(IOUT,1004)(PVALUE(ICH,IB),IB=1,NB)
+   10 CONTINUE
+   15 CONTINUE
+   20 IF((IMPX.NE.3).AND.(IMPX.LT.4))GOTO 50
+*----
+*  PRINTING PER RADIAL PLANE
+*----
+      WRITE(FORM1,'(A4,I2,A8)')'(A4,',NX,'(A3,1X))'
+      WRITE(FORM2,'(A4,I2,A8)')'(A2,',NX,'(I3,1X))'
+      WRITE(IOUT,1005)
+      IEL=0
+      DO IB=1,NB
+        ICH=0
+        DO 35 J=1,NY
+        DO 30 I=1,NX
+        IEL=IEL+1
+        IF(MIX(IEL).EQ.0)GOTO 30
+        ICH=ICH+1
+        FMIX(I,J,IB)=MIXNEW(ICH,IB)
+   30   CONTINUE
+   35   CONTINUE
+      ENDDO
+      DO IB=1,NB
+        WRITE(IOUT,1006)IB
+        WRITE(IOUT,FORM1)' ',(NAMX(I),I=1,NX)
+        WRITE(IOUT,*)' '
+        DO 40 J=1,NY
+        WRITE(CHANY,'(A2)') (NAMY(J))
+        IF(INDEX(CHANY,'-').EQ.1)GOTO 40
+        WRITE(IOUT,FORM2)CHANY,(FMIX(I,J,IB),I=1,NX)
+   40   CONTINUE
+      ENDDO
+   50 RETURN
+*
+ 1001 FORMAT(/10X,'* ',A12,' *',5X,'NAME:',1X,A2,A2,
+     1 5X,'REF-SCHEME:',1X,I2)
+ 1002 FORMAT(2X,'OLD FUEL INDICES :',2X,12(I2,2X))
+ 1003 FORMAT(2X,'NEW FUEL INDICES :',2X,12(I2,2X)/)
+ 1004 FORMAT(2X,'COOLANT DENSITIES:',1X,12(F4.2,1X)/)
+ 1005 FORMAT(//20X,'** FUEL-TYPE INDICES PER RADIAL PLANE **')
+ 1006 FORMAT(//2X,'RADIAL PLANE',1X,'#',I2.2/)
+      END
diff --git a/Donjon/src/CVRUSR.f b/Donjon/src/CVRUSR.f
new file mode 100644
index 0000000..6405cc7
--- /dev/null
+++ b/Donjon/src/CVRUSR.f
@@ -0,0 +1,144 @@
+*DECK CVRUSR

+      SUBROUTINE CVRUSR(IPMAP,NCH,NB,NFUEL,NX,NY,NZ,NVOID,NAMXV,NAMYV,

+     1 NPARM,PNAME,PVALUE,VCOOL,LCOOL,IMPX)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Modify channels data according to the user-defined voiding pattern.

+*

+*Copyright:

+* Copyright (C) 2007 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* D. Sekki

+*

+*Parameters: input/output

+* IPMAP   pointer to fuel-map information.

+* NCH     number of reactor channels.

+* NB      number of fuel bundles per channel.

+* NFUEL   number of fuel types.

+* NX      number of elements along x-axis in fuel map.

+* NY      number of elements along y-axis in fuel map.

+* NZ      number of elements along z-axis in fuel map.

+* NVOID   total number of voided channels.

+* NAMXV   names of voided channels along x-axis.

+* NAMYV   names of voided channels along y-axis.

+* NPARM   total number of recorded parameters.

+* PNAME   recorded parameter name for the coolant density.

+* PVALUE  structure containing the coolant density values

+*         throughout the reactor core.

+* VCOOL   coolant density value for voided channels.

+* LCOOL   flag with respect to the coolant densities:

+*          =.true. to modify these values;

+*          =.false. coolant densities not provided.

+* IMPX    printing index (=0 for no print).

+*

+*-----------------------------------------------------------------------

+*

+      USE GANLIB

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      TYPE(C_PTR) IPMAP

+      INTEGER NCH,NB,NFUEL,NX,NY,NZ,NVOID,NPARM,IMPX,NAMXV(NVOID),

+     1 NAMYV(NVOID)

+      REAL PVALUE(NCH,NB),VCOOL

+      CHARACTER PNAME*12

+      LOGICAL LCOOL

+*----

+*  LOCAL VARIABLES

+*----

+      PARAMETER(IOUT=6)

+      INTEGER MIX(NX*NY*NZ),FLMIX(NCH,NB),NAMX(NX),NAMY(NY),INAME(3)

+      CHARACTER TEXT*12,CHANX*2,CHANY*2

+      TYPE(C_PTR) JPMAP,KPMAP

+      INTEGER, ALLOCATABLE, DIMENSION(:) :: CNANV

+*----

+*  SCRATCH STORAGE ALLOCATION

+*----

+      ALLOCATE(CNANV(NVOID))

+*----

+*  RECOVER INFORMATION

+*----

+      MIX(:NX*NY*NZ)=0

+      FLMIX(:NCH,NB)=0

+      NAMX(:NX)=0

+      NAMY(:NY)=0

+      CALL LCMGET(IPMAP,'BMIX',MIX)

+      CALL LCMGET(IPMAP,'FLMIX',FLMIX)

+*     CHANNEL NAMES

+      CALL LCMGET(IPMAP,'XNAME',NAMX)

+      CALL LCMGET(IPMAP,'YNAME',NAMY)

+      TEXT='USER-DEFINED'

+      IF(IMPX.GT.0)WRITE(IOUT,1000)TEXT,NVOID

+*----

+*  CHECK VOIDED CHANNELS

+*----

+      DO 20 IVD=1,NVOID

+      IEL=0

+      ICH=0

+      DO 15 J=1,NY

+      DO 10 I=1,NX

+        IEL=IEL+1

+        IF(MIX(IEL).EQ.0)GOTO 10

+        ICH=ICH+1

+        IF(NAMXV(IVD).NE.NAMX(I))GOTO 10

+        IF(NAMYV(IVD).NE.NAMY(J))GOTO 10

+        CNANV(IVD)=ICH

+        GOTO 20

+   10 CONTINUE

+   15 CONTINUE

+      WRITE(CHANX,'(A2)') (NAMXV(IVD))

+      WRITE(CHANY,'(A2)') (NAMYV(IVD))

+      WRITE(IOUT,1001)CHANY,CHANX

+      CALL XABORT('@CVRUSR: INVALID INPUT DATA.')

+   20 CONTINUE

+*----

+*  MODIFY CHANNEL DATA

+*----

+      ITOT=0

+      JPMAP=LCMGID(IPMAP,'FUEL')

+      DO IFUEL=1,NFUEL

+        KPMAP=LCMGIL(JPMAP,IFUEL)

+        CALL LCMGET(KPMAP,'MIX',MIXF)

+        CALL LCMGET(KPMAP,'MIX-VOID',MIXV)

+        DO IVD=1,NVOID

+          ICH=CNANV(IVD)

+          DO 30 IB=1,NB

+          IF(FLMIX(ICH,IB).NE.MIXF)GOTO 30

+          FLMIX(ICH,IB)=MIXV

+          IF(LCOOL) PVALUE(ICH,IB)=VCOOL

+          ITOT=ITOT+1

+   30     CONTINUE

+        ENDDO

+      ENDDO

+      IF(IMPX.GT.0)WRITE(IOUT,1002)ITOT

+      IF(IMPX.LT.2)GOTO 40

+*     PRINTING

+      CALL CVRPRN(IPMAP,NCH,NB,NX,NY,NZ,FLMIX,PVALUE,LCOOL,IMPX)

+*     STORE NEW DATA

+   40 CALL LCMPUT(IPMAP,'FLMIX',NCH*NB,1,FLMIX)

+      IF(.NOT.LCOOL)GOTO 50

+      JPMAP=LCMGID(IPMAP,'PARAM')

+      DO IPAR=1,NPARM

+        KPMAP=LCMGIL(JPMAP,IPAR)

+        CALL LCMGET(KPMAP,'P-NAME',INAME)

+        WRITE(TEXT,'(3A4)') (INAME(I),I=1,3)

+        IF(PNAME.EQ.TEXT)THEN

+          CALL LCMPUT(KPMAP,'P-VALUE',NCH*NB,2,PVALUE)

+          GOTO 50

+        ENDIF

+      ENDDO

+*----

+*  SCRATCH STORAGE DEALLOCATION

+*----

+   50 DEALLOCATE(CNANV)

+      RETURN

+*

+ 1000 FORMAT(/2X,'SELECTED VOIDING PATTERN',2X,'=>',2X,A20

+     1     //2X,'TOTAL NUMBER OF VOIDED CHANNELS =',1X,I3/)

+ 1001 FORMAT(/1X,'@CVRUSR: UNABLE TO FIND THE CHANN',

+     1 'EL NAME:',1X,A2,A2)

+ 1002 FORMAT(2X,'TOTAL NUMBER OF MODIFIED VALUES :',1X,I4/)

+      END

diff --git a/Donjon/src/D2P.f b/Donjon/src/D2P.f
new file mode 100644
index 0000000..96b1ccf
--- /dev/null
+++ b/Donjon/src/D2P.f
@@ -0,0 +1,1155 @@
+*DECK PMAXS
+      SUBROUTINE D2P(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* PMAXS interface file generation.
+*
+*Copyright:
+* Copyright (C) 2015 IRSN
+*
+*Author(s): 
+* J. Taforeau
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* None
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER :: STAVEC(40) = 0
+      CHARACTER TEXT*72
+      INTEGER UV
+      INTEGER :: NFC1 = 0
+      INTEGER :: NFC2 = 0
+      INTEGER :: NFC3 = 0
+      INTEGER :: NFC4 = 0
+      INTEGER :: NXC  = 0
+      INTEGER :: JOBT  = 0
+      INTEGER :: NGP = 2
+      INTEGER :: NCRD = 0
+      INTEGER :: MIX = 1
+      INTEGER :: FA_K = -1
+      INTEGER :: IUPS = 0
+      INTEGER :: USRSTA = 0
+      INTEGER :: XESM = 3
+      INTEGER :: ITEMP = 0
+      INTEGER :: NOTHPK = 0
+      INTEGER :: IOTHPK = 0
+      REAL :: VERS = 3.0
+      REAL :: SFAC = 1.0
+      REAL :: BFAC = 1.0
+      REAL :: THCK = -1.
+      REAL FLOTT
+      INTEGER PHASE, ITYPLIR, NITMA
+      DOUBLE PRECISION DFLOT
+      INTEGER :: IPRINT = -1
+      INTEGER,DIMENSION(20) :: CRDINF = -1
+      INTEGER,DIMENSION(12) :: USRVAL = 0
+      INTEGER ,DIMENSION(12) :: OTHTYP = 2
+      REAL,DIMENSION(5) :: LOCYLD = (/0.,-1.,-1.,-1.,-1. /)
+      REAL,DIMENSION(5)::FC1=(/17.0,17.0,3.0,0.0,0.73659 /)
+      REAL,DIMENSION(8)::FC2
+      DATA FC2/6.2506E-01,1E-04,6*0.0/
+      REAL,DIMENSION(7)::FC3
+      DATA FC3/2.4921E+02, 2.4921E+02, 2.4921E+02, 2.3020E+01,
+     1    1.4407E+02, 4.5099E+01, 4.5099E+01/
+      REAL,DIMENSION(3)::FC4
+      DATA FC4/1.44270E+00, 7.21350E-01, 7.21350E-01/
+      REAL,DIMENSION(3)::XSC
+      DATA XSC/ 1.0, 1.0, 5.32151E-01/
+      REAL,DIMENSION(3)::YLD
+      DATA YLD/ 0.06386, 0.00228, 0.0113/
+      CHARACTER*16 :: JOBTIT = 'D2P.PMAXS'
+      CHARACTER*40 :: COM = 'PWR CASE : UOX/MOX CORE FUEL'
+      CHARACTER*12 :: FILNAM = 'HELIOS.dra'
+      CHARACTER*12 :: MIXDIR = 'default     '
+      CHARACTER*12 :: HDET = 'NULL        '
+      CHARACTER*4 :: DER = 'T'
+      CHARACTER*1 :: JOBOPT(16)
+      CHARACTER*5 :: MESH = 'SAP'
+      CHARACTER*12 :: USRPAR(12) = '            '
+      CHARACTER*12 :: OTHPK(12) = '            '
+      CHARACTER*8 :: HCUR(2)= 'NUL'
+      CHARACTER*8 :: HFLX(2)= 'NUL'
+
+      CHARACTER*12,DIMENSION(12) :: OTHVAL = '            '
+      REAL :: OTHVAR(12)
+
+      REAL USRVAPK(12,10)
+      CHARACTER*4 :: CRDMOD = ' '
+      CHARACTER*3 :: ADF = 'NUL'
+      CHARACTER*3 :: CDF = 'NUL'
+      CHARACTER*8,DIMENSION(4) :: ADFD = 'FD_B    '
+      CHARACTER*8,DIMENSION(8) :: CDFD = 'FD_C    '
+      CHARACTER*3 :: GFF = 'NUL'
+      CHARACTER*12,DIMENSION(6) :: PKEY
+      DATA PKEY/ "BARR","DMOD","CBOR","TCOM","TMOD","BURN"/
+      CHARACTER*12,DIMENSION(6) :: REFNAM
+      DATA REFNAM/ "BARR","DMOD","CBOR","TCOM","TMOD","BURN"/
+      CHARACTER*12,DIMENSION(8) :: ISOT
+      DATA ISOT/ "XE135PF","SM149PF","I135PF","PM149PF","PM148PF",
+     >  "PM148MPF","ND147PF","PM147PF"/
+      DATA JOBOPT/14*'F',"",""/
+      CHARACTER*3 :: YLDOPT = 'REF'
+      CHARACTER*4 :: OPT = 'NONE'
+      CHARACTER*4 :: HEQUI = 'NONE'
+      CHARACTER*4 :: HMASL = 'NONE'
+      CHARACTER*1 :: ISOTOPT = '*'
+      REAL :: ISOTVAL = 0.
+      LOGICAL :: SAP=.FALSE.
+      LOGICAL :: MIC=.TRUE.
+      LOGICAL :: EXCESS=.FALSE.
+      LOGICAL :: SCAT=.FALSE.
+      LOGICAL :: LADD=.FALSE.
+      LOGICAL :: LNEW=.FALSE.
+      LOGICAL :: LPRC=.FALSE.
+      LOGICAL :: LMEM=.FALSE.
+      LOGICAL :: LCOR=.FALSE.
+      OTHVAR(:) = -1
+*----
+*  parameters VALIDATION
+*----
+*----
+*  RECOVER iPHASE AND iPRINT INDICES
+*----
+      WRITE(6,*) "****************************************************"
+      WRITE(6,*) "*          RECOVERING D2P: DATA INPUT              *"
+      WRITE(6,*) "****************************************************"
+
+ 100  CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+      IF (ITYPLIR.NE.3) THEN
+       CALL XABORT ('@D2P: KEYWORD EXPECTED AS INPUT OF D2P: MODULE')
+      ELSE IF (ITYPLIR.EQ.3) THEN
+       IF (TEXT.EQ.'PHASE' ) THEN
+        CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+        IF (ITYPLIR.EQ.1) THEN
+         PHASE=NITMA
+         GO TO 100
+        ELSE
+         CALL XABORT('@D2P: INTEGER EXPECTED AFTER PHASE KEYWORD')
+        ENDIF
+       ELSE IF (TEXT.EQ.'EDIT' ) THEN
+        CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+        IF (ITYPLIR.EQ.1) THEN
+         IPRINT=NITMA
+         GO TO 100
+        ELSE
+         CALL XABORT('@D2P: INTEGER EXPECTED AFTER EDIT KEYWORD')
+        ENDIF
+       ELSE IF (TEXT.EQ.'MIX') THEN
+         CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+         IF (ITYPLIR.EQ.1) THEN
+          MIX = NITMA
+          GO TO 100
+         ELSE
+           CALL XABORT('@D2P: INTEGER EXPECTED AFTER MIX KEYWORD')
+         ENDIF
+       ELSE IF (TEXT.EQ.'NAMDIR' ) THEN
+        CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+        IF (ITYPLIR.EQ.3) THEN
+         MIXDIR=TEXT(1:12)
+         IF(NITMA.GT.12) CALL XABORT('@D2P: C*12 EXPECTED FOR NAMDIR')
+         GO TO 100
+        ELSE
+         CALL XABORT('@D2P: CHARACTER EXPECTED AFTER NAMDIR')
+        ENDIF
+       ELSE IF (TEXT.EQ. 'TEMP') THEN
+        CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+        IF (ITYPLIR.EQ.3) THEN
+         IF (NITMA.NE.1) THEN
+          CALL XABORT('@D2P: "C" or "K" EXPECTED AFTER TEMP KEYWORD')
+         ELSE
+          IF (TEXT.EQ. 'C') THEN
+           ITEMP=0
+           GO TO 100
+          ELSE IF (TEXT.EQ. 'K') THEN
+           ITEMP=1
+           GO TO 100
+          ELSE
+           CALL XABORT('@D2P: "C" or "K" EXPECTED AFTER TEMP KEYWORD')
+          ENDIF
+         ENDIF
+        ELSE
+          CALL XABORT('@D2P: CHARACTER EXPECTED AFTER TEMP KEYWORD')
+        ENDIF
+       ELSE IF (TEXT .EQ. 'PKEY') THEN
+  15    CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+        IF (ITYPLIR.NE.3) THEN
+         CALL XABORT('@D2P: CHARACTER EXPECTED AFTER PKEY KEYWORD')
+        ELSE
+         IF (TEXT.EQ.REFNAM(1)) THEN
+          CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+          PKEY(1)=TEXT(:12)
+          GO TO 15
+         ELSE IF (TEXT.EQ.REFNAM(2)) THEN
+          CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+          PKEY(2)=TEXT(:12)
+          GO TO 15
+         ELSE IF (TEXT.EQ.REFNAM(3)) THEN
+          CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+          PKEY(3)=TEXT(:12)
+          GO TO 15
+         ELSE IF (TEXT.EQ.REFNAM(4)) THEN
+          CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+          PKEY(4)=TEXT(:12)
+          GO TO 15
+         ELSE IF (TEXT.EQ.REFNAM(5)) THEN
+          CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+          PKEY(5)=TEXT(:12)
+          GO TO 15
+         ELSE IF (TEXT.EQ.REFNAM(6)) THEN
+          CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+          PKEY(6)=TEXT(:12)
+          GO TO 15
+         ELSE IF (TEXT.EQ.'ENDPKEY') THEN
+         GO TO 100
+         ELSE
+          CALL XABORT('@D2P: UNKNOWN PKEY NAME : '//TEXT//'.')
+         ENDIF
+        ENDIF
+      ELSE IF (TEXT .EQ. 'OTHER') THEN
+       IOTHPK=0
+       CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+        IF(ITYPLIR.NE.1)THEN
+         CALL XABORT('@D2P: INTEGER EXPECTED AFTER OTHPK CARD')
+        ENDIF
+       NOTHPK=NITMA
+       STAVEC(20)=NOTHPK
+       DO WHILE (IOTHPK.LT.NOTHPK)
+       CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+        IF(ITYPLIR.NE.3)THEN
+         CALL XABORT('@D2P: C*12 (othnam) EXPECTED AFTER OTHPK CARD')
+        ELSE
+         IF(NITMA.GT.12)THEN
+          CALL XABORT('@D2P: C*12 EXPECTED AFTER OTHPK CARD')
+         ELSE
+          IOTHPK=IOTHPK+1
+          OTHPK(IOTHPK)=TEXT(:12)
+         ENDIF
+        ENDIF
+       CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+        IF(ITYPLIR.NE.3)THEN
+         CALL XABORT('@D2P: C*1 ((othtyp) EXPECTED AFTER OTHPK CARD')
+        ELSE
+         IF(NITMA.GT.1)THEN
+          CALL XABORT('@D2P: C*1 (othtyp) EXPECTED AFTER OTHPK CARD')
+         ELSE
+          IF (TEXT.EQ.'R') THEN
+           OTHTYP(IOTHPK)=2
+          ELSE IF (TEXT.EQ.'I') THEN
+           OTHTYP(IOTHPK)=1
+          ELSE IF (TEXT.EQ.'S') THEN
+           OTHTYP(IOTHPK)=3
+          ELSE
+           WRITE(6,*) '@D2P: UNKNOWN TYPE (',TEXT(:1),') FOR (',
+     >     OTHPK(IOTHPK),') PKEY.'
+           CALL XABORT('@D2P: PLEASE USE I/R or S')
+          ENDIF
+         ENDIF
+        ENDIF
+       CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+          IF(ITYPLIR.EQ.OTHTYP(IOTHPK))THEN
+           IF (ITYPLIR.EQ.1) THEN
+           WRITE(OTHVAL(IOTHPK),*)NITMA
+           OTHVAR(IOTHPK)=NITMA
+           ENDIF
+           IF (ITYPLIR.EQ.2) THEN
+            WRITE(OTHVAL(IOTHPK),'(f12.5)')FLOTT
+            OTHVAR(IOTHPK)=FLOTT
+           ENDIF
+           IF (ITYPLIR.EQ.3) OTHVAL(IOTHPK)=TEXT(:12)
+          ELSE
+           CALL XABORT('@D2P: INCONSISTENT VALUE (othval)')
+          ENDIF
+       ENDDO
+       GO TO 100
+      ELSE IF (TEXT .EQ. 'ADF') THEN
+  17    CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+        IF(ITYPLIR.NE.3)THEN
+         CALL XABORT('@D2P: C*3 EXPECTED AFTER ADF CARD')
+        ENDIF
+        IF(NITMA.GT.5) THEN
+         CALL XABORT('@D2P: C*3 OR C*5 EXPECTED AFTER ADF CARD')
+        ENDIF
+        ADF=TEXT(:3)
+        IF (TEXT(:5).EQ.'MERGE') THEN
+         STAVEC(21)=1
+         GO TO 17
+        ELSE IF ((ADF.NE.'SEL') .AND. (ADF .NE.'GET')
+     >       .AND. (ADF .NE.'DRA').AND. (ADF .NE.'GEN')) THEN
+         WRITE(6,*) "@D2P: UNKNOWN KEYWORD :", ADF
+         CALL XABORT('@D2P: DRA, SEL OR GET EXPECTED AFTER ADF CARD')
+        ENDIF
+        IF (ADF.EQ.'DRA') THEN
+         CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+         IF(ITYPLIR.NE.1) THEN
+          CALL XABORT('@D2P: INTEGER EXPECTED AFTER ADF DRA CARD')
+         ENDIF
+         STAVEC(13)=NITMA !NADF
+         IF((NITMA.NE.1).AND.(NITMA.NE.4)) THEN
+          CALL XABORT('@D2P: 1 or 4 EXPECTED AFTER ADF DRA CARD')
+         ENDIF
+         DO I=1,STAVEC(13)
+          CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+          IF(ITYPLIR.NE.3) THEN
+           CALL XABORT('@D2P: NADF STRING EXPECTED AFTER ADF DRA'
+     >     //' CARD')
+          ENDIF
+          ADFD(I)=TEXT(:8)
+         ENDDO
+         GO TO 100
+        ELSEIF (ADF .EQ. 'GEN') THEN
+        STAVEC(13)= 1 !NADF
+        CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+        IF((ITYPLIR.NE.3).AND.(TEXT(:5).NE.'THICK')) THEN
+          CALL XABORT('@D2P: REFLECTOR THICKNESS (THICK) EXPECTED')
+        ELSE
+         CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+         IF (ITYPLIR.NE.2) THEN
+          CALL XABORT('@D2P: REAL EXPECTED FOR REFLECTOR THICKNESS')
+         ELSE
+          THCK=FLOTT
+         ENDIF
+        ENDIF
+        DO J=1,2
+        CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+        IF(ITYPLIR.NE.3) THEN
+          CALL XABORT('@D2P: CHARACTER EXPECTED AFTER ADF GEN CARD')
+        ENDIF
+        IF ((TEXT(:4).NE.'FLUX').AND.(TEXT.NE.'CURR'))THEN
+         CALL XABORT('@D2P: FLUX OR CURR KEYWORD EXPECTED AFTER GEN')
+        ELSE
+         DO I=1,2
+          CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+          IF(ITYPLIR.NE.3) THEN
+           CALL XABORT('@D2P: CHARACTER EXPECTED CURR OR FLUX')
+          ENDIF
+          IF (J.EQ.1)HFLX(I)=TEXT(:8)
+          IF (J.EQ.2)HCUR(I)=TEXT(:8)
+         ENDDO
+        ENDIF
+        ENDDO
+        GO TO 100
+        ENDIF
+       ELSE IF (TEXT .EQ. 'CDF') THEN
+       CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+        IF(ITYPLIR.NE.3)THEN
+         CALL XABORT('@D2P: C*3 EXPECTED AFTER CDF CARD')
+        ENDIF
+        IF(NITMA.NE.3) THEN
+         CALL XABORT('@D2P: C*3 EXPECTED AFTER CDF CARD')
+        ENDIF
+        CDF=TEXT(:3)
+        IF ((CDF .NE.'DRA')) THEN
+         WRITE(6,*) "@D2P: UNKNOWN KEYWORD :", CDF
+         CALL XABORT('@D2P: DRA EXPECTED AFTER CDF CARD')
+        ENDIF
+        IF (CDF.EQ.'DRA') THEN
+         CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+         IF(ITYPLIR.NE.1) THEN
+          CALL XABORT('@D2P: Integer EXPECTED AFTER CDF DRA CARD')
+         ENDIF
+         STAVEC(15)=NITMA !NCDF
+         IF((NITMA.NE.1).AND.(NITMA.NE.2).AND.(NITMA.NE.3).AND.
+     >      (NITMA.NE.4).AND.(NITMA.NE.5).AND.(NITMA.NE.8)) THEN
+          CALL XABORT('@D2P: 1 to 5 or 8 EXPECTED AFTER CDF DRA'
+     >    //' CARD')
+         ENDIF
+         DO I=1,STAVEC(15)
+          CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+          IF(ITYPLIR.NE.3) THEN
+           CALL XABORT('@D2P: NCDF String EXPECTED AFTER CDF DRA'
+     >     //' CARD')
+          ENDIF
+          CDFD(I)=TEXT(:8)
+         ENDDO
+        ENDIF
+        GO TO 100
+       ELSE IF (TEXT .EQ. 'GFF') THEN
+         CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+         IF(ITYPLIR.NE.3)THEN
+          CALL XABORT('@D2P: C*3 EXPECTED AFTER GFF CARD')
+         ENDIF
+         IF(NITMA.NE.3) THEN
+          CALL XABORT('@D2P: C*3 EXPECTED AFTER GFF CARD')
+         ENDIF
+         GFF=TEXT(:3)
+         IF ((GFF .NE.'DRA')) THEN
+          WRITE(6,*) "@D2P: UNKNOWN KEYWORD :", GFF
+          CALL XABORT('@D2P: DRA EXPECTED AFTER GFF CARD')
+         ENDIF
+         GO TO 100
+       ELSE IF (TEXT.EQ.'FUEL' ) THEN
+        FA_K=1
+        CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+        IF (ITYPLIR.NE.3) THEN
+         CALL XABORT ('@D2P: KEYWORD BARR EXPECTED AFTER FUEL CARD')
+        ELSE IF (TEXT.EQ.'BARR') THEN
+  10     CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+         IF (ITYPLIR.EQ.1 .AND. TEXT .NE.'ENDBARR') THEN
+          IF (TEXT .EQ. 'DEF' .OR. TEXT .EQ. 'USER') THEN
+           NCRD = NCRD + 1
+           IF (NCRD <= 20) THEN
+            CRDINF(NCRD)=NITMA
+            GO TO 10
+           ELSE
+            CALL XABORT('@D2P: NUMBER OF BARR COMPOSITIONS EXCEED 20')
+           ENDIF
+          ELSE
+            CALL XABORT('@D2P: DEF OR USER KEYWORD EXPECTED AFTER BARR'
+     1      //' KEYWORD')
+          ENDIF
+         ELSE IF (ITYPLIR.EQ.3) THEN
+          IF (TEXT .NE. ';' ) THEN
+  11       IF (TEXT .EQ. 'GRID') THEN
+            CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+            IF (ITYPLIR.NE.3) THEN
+             CALL XABORT('@D2P: CHARACTER EXPECTED AFTER GRID KEYWORD')
+            ELSE
+             IF((TEXT.EQ.'SAP').OR.(TEXT.EQ.'DEF').OR.
+     1         (TEXT.EQ.'USER')) THEN
+              IF (TEXT.EQ.'SAP') THEN
+              MESH=TEXT(:5)
+               GO TO 10
+              ELSE IF (TEXT.EQ.'DEF') THEN
+              MESH=TEXT(:5)
+               GO TO 10
+              ELSE IF (TEXT.EQ.'USER') THEN
+  12           CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+               IF (ITYPLIR.NE.3) THEN
+                CALL XABORT('@D2P: KEYWORD EXPECTED AFTER USER KEYWORD')
+               ELSE IF (TEXT.EQ.'NEW') THEN
+                LNEW=.TRUE.
+                GO TO 12
+               ELSE IF (TEXT.EQ.'GLOBAL') THEN
+                IF (LNEW) THEN
+                 CALL XABORT('@D2P: INCOMPATIBLE OPT GLOBAL WITH NEW')
+                ENDIF
+                MESH='GLOB'
+  90            CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+                IF  (ITYPLIR.NE.3) THEN
+                 CALL XABORT('@D2P: PKEY NAME EXPECTED IN GLOBAL OPT')
+                ELSE
+                 IF (TEXT.EQ.'ENDGLOBAL') GO TO 10
+                 IF(NITMA > 12) THEN
+                  CALL XABORT('@D2P: PKEY NAME IN GLOBAL MUST BE C*12')
+                 ELSE
+                  CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+                  USRSTA = USRSTA+1
+                  USRPAR(USRSTA)=TEXT(:12)
+                  IF  (ITYPLIR.NE.1) THEN
+                   CALL XABORT ('@D2P: NB OF VALUES FOR STATE '//TEXT//
+     1              ' EXPECTED')
+                  ELSE
+                   USRVAL(USRSTA)=NITMA
+                   GO TO 90
+                  ENDIF
+                 ENDIF
+                ENDIF
+               ELSE IF (TEXT.EQ.'ADD') THEN
+                MESH='ADD'
+                LADD=.TRUE.
+  95            CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+                IF  (ITYPLIR.NE.3) THEN
+                 CALL XABORT('@D2P: PKEY NAME EXPECTED IN USER ADD OPT')
+                ELSE
+                 IF (TEXT.EQ.'ENDADD') GO TO 10
+                 IF(NITMA.GE.12) THEN
+                  CALL XABORT('@D2P: STATE NAME IN ADD MUST BE C*12')
+                 ELSE
+                  USRSTA = USRSTA+1
+                  USRPAR(USRSTA)=TEXT(:12)
+                  CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+                  IF  (ITYPLIR.NE.1) THEN
+                   CALL XABORT('@D2P: NB OF VALUES FOR STATE '//TEXT//
+     1              'EXPECTED')
+                  ELSE
+                   USRVAL(USRSTA)=NITMA
+                   DO UV=1,USRVAL(USRSTA)
+                   CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+                    IF (ITYPLIR .NE. 2) THEN
+                     CALL XABORT ('@D2P: REAL EXPECTED IN USER ADD OPT')
+                    ELSE
+                     USRVAPK(USRSTA,UV)=FLOTT
+                    ENDIF
+                   ENDDO
+                   UV=1
+                   GO TO 95
+                  ENDIF
+                 ENDIF
+                ENDIF
+               ELSE
+                CALL XABORT('@D2P: UNKNOWN OPTION '//TEXT//
+     1                'FOR USER OPT')
+               ENDIF
+              ENDIF
+             ELSE
+              CALL XABORT('@D2P: UNKNOWN OPTION FOR GRID KEYWORD')
+             ENDIF
+            ENDIF
+           ELSE IF (TEXT.EQ.'DEF' .OR. TEXT.EQ.'USER') THEN
+            CRDMOD=TEXT(:4)
+            GO TO 10
+           ELSE IF (TEXT.EQ.'ENDBARR') THEN
+            IF (CRDMOD=='DEF') THEN
+              CALL XABORT('@D2P: ENDBARR KEYWORD IS EXPECTED ONLY FOR'
+     1        //' USER BARR COMPOSITION')
+            ELSE
+              GO TO 10
+            ENDIF
+           ELSE IF (TEXT .EQ. 'SCATTERING') THEN
+             SCAT=.TRUE.
+             GO TO 10
+           ELSE IF (TEXT .EQ. 'DET') THEN
+             CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+             IF(ITYPLIR.NE.3)THEN
+              CALL XABORT('@D2P: C*12 EXPECTED AFTER DET CARD')
+             ENDIF
+             IF(NITMA.GT.12) THEN
+              CALL XABORT('@D2P: C*12 EXPECTED AFTER GFF CARD')
+             ENDIF
+             HDET=TEXT(:12)
+             GO TO 10
+           ELSE IF (TEXT .EQ. 'ABSORPTION') THEN
+   5        CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+            IF (ITYPLIR.NE.3) THEN
+             CALL XABORT('@D2P: C*6 EXPECTED AFTER ABSORPTION KEYWORD')
+            ELSE IF (TEXT .EQ. 'MIC') THEN
+             MIC =.TRUE.
+             GO TO 10
+            ELSE IF (TEXT .EQ. 'SAP') THEN
+             SAP =.TRUE.
+             MIC =.FALSE.
+             GO TO 5
+            ELSE IF (TEXT .EQ. 'EXCESS') THEN
+             IF (SAP .EQV. .FALSE.) THEN
+              CALL XABORT('@D2P: SAP KEYWORD EXPECTED BEFORE EXCESS')
+             ELSE
+              EXCESS = .TRUE.
+              GO TO 10
+             ENDIF
+            ELSE
+             GO TO 11
+            ENDIF
+           ELSE IF (TEXT .EQ. 'ISOTOPES') THEN
+  25        CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+            IF (ITYPLIR.NE.3) THEN
+             CALL XABORT('@D2P: CHARACTER EXPECTED AFTER PKEY KEYWORD')
+            ELSE
+             IF (TEXT.EQ.'XE135') THEN
+              CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+              ISOT(1)=TEXT(:12)
+              GO TO 25
+             ELSE IF (TEXT.EQ.'SM149') THEN
+              CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+              ISOT(2)=TEXT(:12)
+              GO TO 25
+             ELSE IF (TEXT.EQ.'I135') THEN
+              CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+              ISOT(3)=TEXT(:12)
+              GO TO 25
+             ELSE IF (TEXT.EQ.'PM149') THEN
+              CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+              ISOT(4)=TEXT(:12)
+              GO TO 25
+             ELSE IF (TEXT.EQ.'PM148') THEN
+              CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+              ISOT(5)=TEXT(:12)
+              GO TO 25
+             ELSE IF (TEXT.EQ.'PM148M') THEN
+              CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+              ISOT(6)=TEXT(:12)
+              GO TO 25
+             ELSE IF (TEXT.EQ.'PM147') THEN
+              CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+              ISOT(8)=TEXT(:12)
+              GO TO 25
+             ELSE IF (TEXT.EQ.'ND147') THEN
+              CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+              ISOT(7)=TEXT(:12)
+              GO TO 25
+             ELSE IF (TEXT.EQ.'ENDISOTOPES') THEN
+             GO TO 10
+             ELSE
+              CALL XABORT('@D2P: UNKNOWN NAME OF ISOTOPE: '//TEXT//'.')
+             ENDIF
+            ENDIF
+           ELSE IF (TEXT .EQ. 'YLD') THEN
+  37        CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+            IF (ITYPLIR.NE.3) THEN
+             CALL XABORT('@D2P: CHARACTER EXPECTED AFTER YLD KEYWORD')
+            ELSE
+             IF (TEXT(:3).EQ.'COR') THEN
+              LCOR=.TRUE.
+              GO TO 37
+             ELSE
+              IF (.NOT.LCOR) STAVEC(22)=0
+              YLDOPT=TEXT(:3)
+              IF (YLDOPT.EQ.'REF') THEN
+               IF (LCOR) STAVEC(22)=1
+               GO TO 10
+              ELSE IF (YLDOPT.EQ.'FIX') THEN
+               IF (LCOR) THEN
+                WRITE (6,*) '@D2P : NO CORRECTION POSSIBLE OF FISSION'
+                CALL XABORT ('YIELDS WITH THE FIX OPTION')
+               ENDIF
+               DO I=1, 3
+                CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+                IF (ITYPLIR==2) THEN
+                 YLD(I)=FLOTT
+                ELSE
+                 CALL XABORT('REAL EXPECTED FOR YIELD VALUES')
+                ENDIF
+               ENDDO
+               GO TO 10
+              ELSE IF (YLDOPT.EQ.'MAN') THEN
+               IF (LCOR) STAVEC(22)=2
+  35           CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+               I=1
+               DO WHILE (TEXT.NE.REFNAM(I).AND.(I.LE.5))
+                I=I+1
+               ENDDO
+               IF (I.GT.5) THEN
+                IF (TEXT.EQ.'ENDMAN') GO TO 10
+                CALL XABORT('@D2P: PKEY NAME ('//TEXT(:12)//') NOT '
+     >          //'ALLOWED IN YIELD CARD')
+               ELSE
+                CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+
+                IF (ITYPLIR.EQ.2) THEN
+                 LOCYLD(I)=FLOTT
+                 GO TO 35
+                ELSE
+                CALL XABORT('@D2P: SOMETHING WRONG OCCURS IN YLD CARD')
+                ENDIF
+               ENDIF
+              ELSE
+               CALL XABORT('@D2P: UNKNOWN OPTION FOR YLD: '//TEXT//'.')
+              ENDIF
+             ENDIF
+            ENDIF
+           ELSE IF (TEXT.EQ.'GENPMAXS') THEN
+            GO TO 120
+           ELSE IF (TEXT.EQ.'HELIOS') THEN
+            GO TO 21
+           ELSE IF (TEXT.EQ.'PROC') THEN
+            GO TO 220
+           ELSE
+            CALL XABORT('@D2P: SOMETHING WRONG OCCURS IN INPUT DATA')
+           ENDIF
+          ELSE
+           GOTO 200
+          ENDIF
+         ENDIF
+        ELSE
+          CALL XABORT('@D2P: UNKNOWN KEYWORD '//TEXT//', BARR EXPECTED')
+        ENDIF
+       ELSE IF (TEXT .EQ. 'REFLECTOR') THEN
+        FA_K=0
+        NCRD=1
+        CRDINF(1)=1
+        CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+        IF (ITYPLIR.NE.3) THEN
+         CALL XABORT('@D2P: SOMETHING WRONG OCCURS IN REFLECTOR DATA')
+        ELSE IF (ITYPLIR.EQ.3) THEN
+         IF ((TEXT.NE.';'))THEN
+          IF (TEXT.EQ.'GENPMAXS') THEN
+           GO TO 120
+          ELSE IF (TEXT.EQ.'HELIOS') THEN
+           GO TO 21
+          ELSE IF (TEXT.EQ.'PROC') THEN
+           GO TO 220
+          ELSE
+           CALL XABORT('@D2P: SOMETHING WRONG OCCURS IN INPUT DATA')
+          ENDIF
+         ELSE
+           GOTO 200
+         ENDIF
+        ELSE
+         CALL XABORT('@D2P: UNKNOWN KEYWORD'//TEXT//', IN INPUT DATA')
+        ENDIF
+       ENDIF
+
+  21   IF (TEXT .EQ. 'HELIOS') THEN
+        CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+  30    IF (ITYPLIR.NE.3) THEN
+         CALL XABORT ('@D2P: KEYWORD EXPECTED AFTER HELIOS CARD')
+        ELSE IF (TEXT.EQ.'FILE_CONT_1') THEN
+  40     CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+         IF ((ITYPLIR.EQ.1).OR.(ITYPLIR.EQ.2)) THEN
+          NFC1 = NFC1 +1
+          IF (NFC1 <= 5) THEN
+           IF (ITYPLIR.EQ.1) FC1(NFC1) = NITMA
+           IF (ITYPLIR.EQ.2) FC1(NFC1) = FLOTT
+           GO TO 40
+          ELSE
+           CALL XABORT('@D2P: FIVE VALUES FOR FILE_CONT_1 ARE EXPECTED')
+          ENDIF
+         ELSE IF (ITYPLIR.EQ.3) THEN
+          IF (NFC1.NE.5) THEN
+           CALL XABORT('@D2P: FIVE VALUES FOR FILE_CONT_1 ARE EXPECTED')
+          ENDIF
+          IF (TEXT .NE. ';' ) THEN
+           GO TO 30
+          ELSE
+           GOTO 200
+          ENDIF
+         ENDIF
+        ELSE IF (TEXT.EQ.'FILE_CONT_2') THEN
+
+  50     CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+
+         IF (ITYPLIR.EQ.2) THEN
+          NFC2 = NFC2 +1
+          IF (NFC2 <= 8) THEN
+           FC2(NFC2) = FLOTT
+           GO TO 50
+          ELSE
+           CALL XABORT('@D2P: 8 VALUES AT MOST IN FILE_CONT_2')
+          ENDIF
+         ELSE IF (ITYPLIR.EQ.1) THEN
+           CALL XABORT('@D2P: REAL VALUES EXPECTED IN FILE_CONT_2')
+         ELSE IF (ITYPLIR.EQ.3) THEN
+          IF (NFC2<2) THEN
+           CALL XABORT('@D2P: 2 VALUES AT LEAST IN FILE_CONT_2')
+          ENDIF
+          IF (TEXT .NE. ';' ) THEN
+           GO TO 30
+          ELSE
+           GOTO 200
+          ENDIF
+         ENDIF
+        ELSE IF (TEXT.EQ.'FILE_CONT_3') THEN
+
+  60     CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+
+         IF (ITYPLIR.EQ.2) THEN
+          NFC3 = NFC3 +1
+          IF (NFC3 <= 7) THEN
+           FC3(NFC3) = FLOTT
+           GO TO 60
+          ELSE
+           CALL XABORT('@D2P: 7 VALUES IN FILE_CONT_3 EXPECTED')
+          ENDIF
+         ELSE IF (ITYPLIR.EQ.1) THEN
+           CALL XABORT('@D2P: REAL VALUES EXPECTED IN FILE_CONT_3  ')
+         ELSE IF (ITYPLIR.EQ.3) THEN
+          IF (NFC3<7) THEN
+           CALL XABORT('@D2P: 7 VALUES FOR FILE_CONT_3 EXPECTED')
+          ENDIF
+          IF (TEXT .NE. ';' ) THEN
+           GO TO 30
+          ELSE
+           GOTO 200
+          ENDIF
+         ENDIF
+        ELSE IF (TEXT.EQ.'FILE_CONT_4') THEN
+
+  70     CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+
+         IF (ITYPLIR.EQ.2) THEN
+          NFC4 = NFC4 +1
+          IF (NFC4 <= 3) THEN
+           FC4(NFC4) = FLOTT
+           GO TO 70
+          ELSE
+           CALL XABORT('@D2P: 3 VALUES IN FILE_CONT_4 EXPECTED')
+          ENDIF
+         ELSE IF (ITYPLIR.EQ.1) THEN
+           CALL XABORT('@D2P: REAL VALUES EXPECTED IN FILE_CONT_4')
+         ELSE IF (ITYPLIR.EQ.3) THEN
+          IF (NFC4<3) THEN
+           CALL XABORT('@D2P: 3 VALUES IN FILE_CONT_4 EXPECTED')
+          ENDIF
+          IF (TEXT .NE. ';' ) THEN
+           GO TO 30
+          ELSE
+           GOTO 200
+          ENDIF
+         ENDIF
+        ELSE IF (TEXT.EQ.'XS_CONT') THEN
+
+  80     CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+
+         IF ((ITYPLIR.EQ.1).OR.(ITYPLIR.EQ.2)) THEN
+          NXC = NXC +1
+          IF (NXC <= 3) THEN
+           IF (ITYPLIR.EQ.1) XSC(NXC) = NITMA
+           IF (ITYPLIR.EQ.2) XSC(NXC) = FLOTT
+           GO TO 80
+          ELSE
+           CALL XABORT('@D2P: 3 VALUES IN XS_CONT ARE EXPECTED')
+          ENDIF
+         ELSE IF (ITYPLIR.EQ.3) THEN
+          IF (NXC<3) THEN
+           CALL XABORT('@D2P: 3 VALUES FOR XS_CONT ARE EXPECTED')
+          ENDIF
+          IF (TEXT .NE. ';' ) THEN
+           GO TO 30
+          ELSE
+           GOTO 200
+          ENDIF
+         ENDIF
+        ELSE IF (TEXT.EQ.'GENPMAXS')THEN
+         GO TO 120
+        ELSE IF (TEXT.EQ.'PROC')THEN
+         GO TO 220
+        ELSE
+         CALL XABORT ('@D2P: UNKNOWN KEYWORD: '//TEXT//'.')
+        ENDIF
+       ENDIF
+
+
+
+  120  IF (TEXT .EQ. 'GENPMAXS') THEN
+
+        CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+  130   IF (ITYPLIR.NE.3) THEN
+         CALL XABORT ('@D2P: KEYWORD EXPECTED AFTER GENPMAXS CARD')
+        ELSE IF (TEXT.EQ.'JOB_TIT') THEN
+
+         CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+
+         IF ((ITYPLIR.NE.3)) THEN
+          CALL XABORT('@D2P: CHARACTER EXPECTED AFTER JOB_TIT CARD')
+         ELSE IF (ITYPLIR.EQ.3) THEN
+          IF (TEXT .NE. ';' ) THEN
+           JOBTIT=TEXT(:16)
+           IF (NITMA>16) THEN
+            CALL XABORT('@D2P: JOB_TIT NAME TOO LONG (>C*16)')
+           ENDIF
+           CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+           GO TO 130
+          ELSE
+           CALL XABORT('@D2P: CHARACTER EXPECTED AFTER JOB_TIT CARD')
+          ENDIF
+         ENDIF
+        ELSE IF (TEXT.EQ.'FILE_NAME') THEN
+         CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+         IF ((ITYPLIR.NE.3)) THEN
+          CALL XABORT('CHARACTER EXPECTED AFTER JOB_TIT CARD')
+         ELSE IF (ITYPLIR.EQ.3) THEN
+          IF (TEXT .NE. ';' ) THEN
+           FILNAM=TEXT(:12)
+           IF (NITMA>12) THEN
+            CALL XABORT('FILE_NAME NAME TOO LONG (>C*12)')
+           ENDIF
+           CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+           GO TO 130
+          ELSE
+           CALL XABORT('@D2P: CHARACTER EXPECTED AFTER FILE_NAME CARD')
+          ENDIF
+         ENDIF
+        ELSE IF (TEXT.EQ.'DERIVATIVE') THEN
+         CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+         IF ((ITYPLIR.NE.3)) THEN
+          CALL XABORT('@D2P: CHARACTER EXPECTED AFTER DERIVATIVE CARD')
+         ELSE IF (ITYPLIR.EQ.3) THEN
+          IF (TEXT .NE. ';' ) THEN
+           IF ((TEXT.EQ.'T').OR.(TEXT.EQ.'F')) THEN
+            DER=TEXT(:4)
+            CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+            GO TO 130
+           ELSE
+            CALL XABORT('@D2P: (T/F) EXECTED AFTER DERIVATIVE CARD')
+           ENDIF
+          ELSE
+           CALL XABORT('@D2P: (T/F) EXPECTED AFTER DERIVATIVE CARD')
+          ENDIF
+         ENDIF
+        ELSE IF (TEXT.EQ.'COMMENT') THEN
+         CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+         IF ((ITYPLIR.NE.3)) THEN
+          CALL XABORT('@D2P: CHARACTER EXPECTED AFTER COMMENT CARD')
+         ELSE IF (ITYPLIR.EQ.3) THEN
+          IF (TEXT .NE. ';' ) THEN
+           COM=TEXT(:40)
+           IF (NITMA>40)THEN
+            CALL XABORT('@D2P: COMMENT NAME TOO LONG (>C*40)')
+           ENDIF
+           CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+           GO TO 130
+          ELSE
+           CALL XABORT('@D2P: CHARACTER EXPECTED AFTER COMMENT CARD')
+          ENDIF
+         ENDIF
+        ELSE IF (TEXT.EQ.'JOB_OPT') THEN
+ 140     CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+
+         IF ((ITYPLIR.NE.3)) THEN
+          CALL XABORT('@D2P: CHARACTER EXPECTED AFTER JOB_OPT CARD')
+         ELSE IF (ITYPLIR.EQ.3) THEN
+          IF (TEXT .NE. ';' ) THEN
+           JOBT=JOBT+1
+
+           IF ((TEXT.EQ.'T').OR.(TEXT.EQ.'F')) THEN
+            IF (JOBT<=14) THEN
+             JOBOPT(JOBT)=TEXT(:1)
+             GO TO 140
+            ELSE
+             WRITE (6,*) '@D2P: LAST JOB_OPT VALUE :', TEXT
+             CALL XABORT('@D2P: 14 VALUES EXPECTED FOR JOB_OPT CARD')
+            ENDIF
+            CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+            GO TO 130
+           ELSE
+             IF (JOBT<=14) THEN
+             WRITE (6,*)'@D2P: ',JOBT,'th JOB_OPT VALUE :', TEXT
+             CALL XABORT('@D2P: (T/F) VALUES EXPECTED FOR JOB_OPT CARD')
+             ELSE
+             GO TO 130
+             ENDIF
+           ENDIF
+          ELSE IF (JOBT==14 .and. TEXT==';') THEN
+           GO TO 190
+          ELSE IF (JOBT==15) THEN
+           GO TO 130
+          ELSE
+           CALL XABORT('@D2P: CHARACTER EXPECTED AFTER JOB_OPT CARD')
+          ENDIF
+         ENDIF
+        ELSE IF (TEXT.EQ.'IUPS') THEN
+         CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+         IF ((ITYPLIR.NE.1)) THEN
+          CALL XABORT('@D2P: INTEGER EXPECTED AFTER IUPS CARD')
+         ELSE IF (ITYPLIR.EQ.1) THEN
+           IF ((NITMA>2).OR.(NITMA<0)) THEN
+            CALL XABORT ('@D2P: IUPS INTEGER MUST BE 0,1 or 2')
+           ELSE
+            IUPS=NITMA
+            CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+            IF (ITYPLIR.EQ.3) THEN
+             GO TO 130
+            ELSE
+             CALL XABORT('@D2P: ONLY 1 VALUE IS EXPECTED FOR IUPS')
+            ENDIF
+           ENDIF
+         ENDIF
+        ELSE IF (TEXT.EQ.'XESM') THEN
+         CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+         IF ((ITYPLIR.NE.1)) THEN
+          CALL XABORT('@D2P: INTEGER EXPECTED AFTER XESM CARD')
+         ELSE IF (ITYPLIR.EQ.1) THEN
+           IF ((NITMA>3).OR.(NITMA<1)) THEN
+            CALL XABORT ('@D2P: XESM CARD INTEGER MUST BE 1,2 or 3')
+           ELSE
+            XESM=NITMA
+            CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+            IF (ITYPLIR.EQ.3) THEN
+             GO TO 130
+            ELSE
+             CALL XABORT('@D2P: ONLY 1 VALUE IS EXPECTED FOR XESM')
+            ENDIF
+           ENDIF
+         ENDIF
+        ELSE IF (TEXT.EQ.'VERSION') THEN
+         CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+         IF ((ITYPLIR.NE.2)) THEN
+          CALL XABORT('@D2P: REAL EXPECTED AFTER VERSION CARD')
+         ELSE IF (ITYPLIR.EQ.2) THEN
+           IF ((FLOTT<0)) THEN
+            CALL XABORT ('@D2P: VERSION NUMBER MUST BE POSITIVE')
+           ELSE
+            VERS=FLOTT
+            CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+            IF (ITYPLIR.EQ.3) THEN
+             GO TO 130
+            ELSE
+             CALL XABORT('@D2P: ONLY ONE VALUE IS EXPECTED FOR VERSION')
+            ENDIF
+           ENDIF
+         ENDIF
+        ELSE IF (TEXT.EQ.'SFAC') THEN
+         CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+         IF ((ITYPLIR.NE.2)) THEN
+          CALL XABORT('@D2P: REAL EXPECTED AFTER SFAC CARD')
+         ELSE IF (ITYPLIR.EQ.2) THEN
+           IF ((FLOTT<0)) THEN
+            CALL XABORT ('@D2P: SFAC FACTOR MUST BE POSITIVE')
+           ELSE
+            SFAC=FLOTT
+            CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+            IF (ITYPLIR.EQ.3) THEN
+             GO TO 130
+            ELSE
+             CALL XABORT('@D2P: ONLY ONE VALUE IS EXPECTED FOR SFAC ')
+            ENDIF
+           ENDIF
+         ENDIF
+        ELSE IF (TEXT.EQ.'BFAC') THEN
+         CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+         IF ((ITYPLIR.NE.2)) THEN
+          CALL XABORT('@D2P: REAL EXPECTED AFTER BFAC CARD')
+         ELSE IF (ITYPLIR.EQ.2) THEN
+           IF ((FLOTT<0)) THEN
+            CALL XABORT ('@D2P: BFAC FACTOR MUST BE POSITIVE')
+           ELSE
+            BFAC=FLOTT
+            CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+            IF (ITYPLIR.EQ.3) THEN
+             GO TO 130
+            ELSE
+             CALL XABORT('@D2P: ONLY 1 VALUE IS EXPETCTED FOR BFAC')
+            ENDIF
+           ENDIF
+         ENDIF
+        ELSE IF (TEXT .EQ. ';' ) THEN
+         GO TO 190
+        ELSE IF (TEXT .EQ. 'PROC') THEN
+         GO TO 220
+        ELSE
+         CALL XABORT ('@D2P: UNKNOWN KEYWORD: '//TEXT//'.')
+        ENDIF
+       ENDIF
+
+  220  IF (TEXT .EQ. 'PROC') THEN
+        LPRC=.TRUE.
+  221   CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+
+        IF (ITYPLIR.NE.3) THEN
+         CALL XABORT ('@D2P: C*4 EXPECTED AFTER PROC CARD')
+        ELSE IF (TEXT.EQ.';') THEN
+         GO TO 190
+        ELSE IF (TEXT.EQ.'MEMO')THEN
+          LMEM=.TRUE.
+          GO TO 221
+        ELSE IF ((NITMA .NE. 4)) THEN
+         CALL XABORT ('@D2P: C*4 EXPECTED AFTER PROC CARD')
+        ELSE
+         OPT=TEXT(:4)
+         CALL REDGET(ITYPLIR,NITMA,FLOTT,TEXT,DFLOT)
+         SELECT CASE (OPT)
+         CASE ('ISOT')
+          IF (TEXT.EQ."*") THEN
+           ISOTOPT=TEXT(:1)
+          ELSE IF(ITYPLIR.NE.2) THEN
+           CALL XABORT('@D2P: * OR REAL EXPECTED AFTER ISOT CARD')
+          ELSE
+           ISOTOPT='R'
+           ISOTVAL=FLOTT
+          ENDIF
+         CASE ('EQUI')
+          IF(ITYPLIR.NE.3) THEN
+           CALL XABORT('@D2P: HEQUI (C*4) EXPECTED AFTER EQUI CARD')
+          ELSE
+           IF (NITMA.NE.4) THEN
+            CALL XABORT('@D2P: HEQUI (C*4) EXPECTED AFTER EQUI CARD')
+           ELSE
+            HEQUI=TEXT(:4)
+           ENDIF
+          ENDIF
+         CASE ('MASL')
+          IF(ITYPLIR.NE.3) THEN
+           CALL XABORT('@D2P: HMASL (C*4) EXPECTED AFTER MASL CARD')
+          ELSE
+           IF (NITMA.NE.4) THEN
+            CALL XABORT('@D2P: HMASL (C*4) EXPECTED AFTER MASL CARD')
+           ELSE
+            HMASL=TEXT(:4)
+           ENDIF
+          ENDIF
+
+         CASE DEFAULT
+          CALL XABORT('@D2P: UNKNOWN OPTION ('//OPT//') IN PROC CARD')
+         END SELECT
+         GO TO 221
+        ENDIF
+
+
+       ENDIF
+
+ 190   IF (TEXT(:1) .EQ. ';' ) THEN
+        IF (NFC2.NE.0) NGP = NFC2
+        IF (JOBT.NE.14) THEN
+         IF (JOBT.NE.15) THEN
+          IF (JOBT.NE.0)THEN
+           CALL XABORT('@D2P: 14 VALUES EXPECTED FOR JOB_OPT')
+          ENDIF
+         ENDIF
+        ENDIF
+        GO TO 200
+       ELSE
+        CALL XABORT('@D2P: UNKNOWN KEYWORD:'//TEXT//'.')
+       ENDIF
+      ENDIF
+
+
+
+ 200  IF (PHASE.EQ.1) THEN
+      IF ((ADF.EQ.'NUL') .and. (JOBOPT(1).EQ.'T')) THEN
+       WRITE(6,*)"@D2P: ADF CALCULATION REQUIRED, PLEASE USE THE 'ADF'",
+     >    " CARD."
+       CALL XABORT("")
+      ELSE IF ((ADF.NE.'NUL') .and. (JOBOPT(1).EQ.'F')) THEN
+       WRITE(6,*)"@D2P: ADF CALCULATION REQUIRED, PLEASE TURN ON THE ",
+     >    "'ladf' FLAG IN JOB_OPT CARD."
+       CALL XABORT("")
+      ENDIF
+      IF ((CDF.EQ.'NUL') .and. (JOBOPT(10).EQ.'T')) THEN
+       WRITE(6,*)"@D2P: CDF CALCULATION REQUIRED, PLEASE USE THE 'CDF'",
+     >    " CARD."
+       CALL XABORT("")
+      ELSE IF ((CDF.NE.'NUL') .and. (JOBOPT(10).EQ.'F')) THEN
+       WRITE(6,*)"@D2P: CDF CALCULATION REQUIRED, PLEASE TURN ON THE ",
+     >    "'lcdf' FLAG IN JOB_OPT CARD."
+       CALL XABORT("")
+      ENDIF
+            IF ((GFF.EQ.'NUL') .and. (JOBOPT(11).EQ.'T')) THEN
+       WRITE(6,*)"@D2P: GFF CALCULATION REQUIRED, PLEASE USE THE 'GFF'",
+     >    " CARD."
+       CALL XABORT("")
+      ELSE IF ((CDF.NE.'NUL') .and. (JOBOPT(10).EQ.'F')) THEN
+       WRITE(6,*)"@D2P: GFF CALCULATION REQUIRED, PLEASE TURN ON THE ",
+     >    "'lgff' FLAG IN JOB_OPT CARD."
+       CALL XABORT("")
+      ENDIF
+      IF (FA_K==0) THEN
+       IF ((ADF.EQ.'SEL').OR.(ADF.EQ.'GET')) THEN
+        CALL XABORT('@D2P: ADF OF TYPE DRA EXPECTED FOR REFLECTOR CASE')
+       ENDIF
+       DO I=2, 16
+        IF (JOBOPT(I).EQ.'T') THEN
+         JOBOPT(I)='F'
+         WRITE(6,*)"@D2P: JOB_OPT(",I,") SET TO 'F' FOR RELFECTOR CASE"
+        ENDIF
+       ENDDO
+      ENDIF
+      ENDIF
+      CALL  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,  JOBOPT, USRPAR,   MESH,
+     >                    PKEY, FILNAM,   ISOT,  JOBTIT,    COM,    SAP,
+     >                     MIC,    EXC,   SCAT,    LADD,   LNEW, MIXDIR,
+     >                     CDF,    GFF,   ADFD,    CDFD,    YLD, YLDOPT,
+     >                  LOCYLD,   XESM,  ITEMP,   OTHPK, OTHTYP, OTHVAL,
+     >                    HDET,   LPRC,  HEQUI,  HMASL ,ISOTOPT,ISOTVAL,
+     >                    LMEM, OTHVAR,   THCK,    HFLX,   HCUR        )
+
+      END
diff --git a/Donjon/src/D2PADF.f b/Donjon/src/D2PADF.f
new file mode 100644
index 0000000..7cbb735
--- /dev/null
+++ b/Donjon/src/D2PADF.f
@@ -0,0 +1,364 @@
+*DECK D2PADF
+      SUBROUTINE D2PADF (IPDAT,IPRINT,NG,NMIL, ADF, NSF, DIFC,CURRN,
+     1 SRFLX,ZAFLX,RPAR,IPAR,ADF_T,STAIDX,NVAR)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* CALL to GET_SAP_ADF to recover ADF information.
+*
+*Author(s): 
+* J. Taforeau
+*
+*Parameters: 
+* IPDAT    
+* IPRINT   
+* NG       
+* NMIL     
+* ADF      
+* NSF      
+* DIFC     
+* CURRN    
+* SRFLX    
+* ZAFLX    
+* RPAR     
+* IPAR     
+* ADF_T    
+* STAIDX   
+* NVAR     
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPDAT,IPTH,KPTH
+      INTEGER IPRINT,NG,NMIL,NSF,IPAR(3,NSF),NVAR
+      REAL ADF(NSF,NG,10),DIFC(NG),CURRN(NSF,NG,2),SRFLX(NSF,NG),
+     1 ZAFLX(NMIL,NG)
+      DOUBLE PRECISION RPAR(6,NSF)
+      CHARACTER*3 ADF_T
+      INTEGER STAIDX(NVAR)   ! Index of current branch state values
+*----
+*  LOCAL VARIABLES
+*----
+      REAL SIDE,APOTHEM,VOLUME
+      INTEGER :: NSD = 4
+      INTEGER TOS(-1:1,-1:1)
+      REAL SIGF(4)
+      INTEGER DX, DY, SOT, IAXIS
+      INTEGER  NAXIS,NPAIR(2),CAXIS(4),PAXIS(0:1,2),TRF_I(2,4)
+      INTEGER  ICELL(2),NSURF(2)
+      INTEGER IND, NZ, NC, IPAIR, IA, IP, NSURFAC,P, TR,NS,NGRP
+      REAL*8 :: J_NET,J_PLUS,J_MINOS,FI_HET,TRANSV_CURR,FI_HOMOG,FAVE
+      REAL*8 :: J_SUMM
+      REAL :: B2_VECT(NMIL,NG), DIFF_C(NMIL,NG) ! B2 and D vectors
+      REAL :: APOTH(NMIL,4)
+      LOGICAL :: HASSYM(2,NMIL)
+      INTEGER INTCORR(0:1,1,2)
+      REAL CURR_INFO(1:(NMIL+1),NG,NSF,9)
+
+      IF(NMIL > 1) CALL XABORT ('@D2P: MORE THAN 1 MIXTRURE ')
+      IF(NSF .NE. NSD) CALL XABORT('@D2PADF: NUMBER OF SURFACE NE 4')
+
+      SIDE= REAL(MAXVAL(RPAR(5,:)))
+      APOTHEM= SIDE/2.0
+      VOLUME= NSF*SIDE*APOTHEM/2.0
+      CURR_INFO= 0.0
+      ! TOS is the interface number corresponding to the cell
+      ! to the right of the equation number (interface)
+      TOS= 0
+      TOS( 0, 1)= 4 !DX=0 DY>0 west
+      TOS( 0,-1)= 2 !DX=0 DY<0 east
+      TOS( 1, 0)= 1 !DX>0 DY=0 north
+      TOS(-1, 0)= 3 !DX<0 DY=0 south
+
+      SIGF(1)= 1.
+      SIGF(2)= 1.
+      SIGF(3)= 1.
+      SIGF(4)= 1.
+
+      !deltas in sense counterclokwise around the geometry
+      !AXIS 1 DX>0 DY=0
+      !AXIS 2 DX=0 DY>0
+      NPAIR= 0
+      NAXIS= 2
+
+      INTCORR= 0
+      !AXIS 1
+      INTCORR(0,1,1)= 1
+      INTCORR(1,1,1)= 3
+      NPAIR(1)= 1
+      !AXIS 2
+      INTCORR(0,1,2)= 2
+      INTCORR(1,1,2)= 4
+      NPAIR(2)= 1
+
+      !axis not crossing the surface
+      CAXIS(1)= 1
+      CAXIS(2)= 2
+      CAXIS(3)= CAXIS(1)
+      CAXIS(4)= CAXIS(2)
+      !axis crossing a surface
+      PAXIS(0,1)= 2
+      PAXIS(1,1)= 4
+      PAXIS(0,2)= 1
+      PAXIS(1,2)= 3
+
+      HASSYM= .FALSE.
+      ! coefficient related to the transversal component of the J+.
+      ! each surface has its 2 transversal components
+      ! first surface
+      TRF_I(1,1)= 2
+      TRF_I(2,1)= 4
+
+      ! 2-nd surface
+      TRF_I(1,2)= 1
+      TRF_I(2,2)= 3
+
+      ! 3-th surface
+      TRF_I(1,3)= 2
+      TRF_I(2,3)= 4
+
+      ! 4-th surface
+      TRF_I(1,4)= 1
+      TRF_I(2,4)= 3
+
+      ADF=0.0
+      SOT=0
+
+      CURR_INFO= 0.0 !this is needed to know where to apply simmetries
+
+      DO NS= 1,NSF
+
+         ICELL(1)= IPAR(2,NS)
+         ICELL(2)= IPAR(3,NS)
+
+         IF(RPAR(3,NS).LT.-1.E-3) THEN
+          DX = -1
+         ELSEIF(RPAR(3,NS).GT.1.E-3) THEN
+          DX = 1
+         ELSE
+          DX = 0
+         ENDIF
+
+         IF(RPAR(4,NS).LT.-1.E-3) THEN
+          DY = -1
+         ELSEIF(RPAR(4,NS).GT.1.E-3) THEN
+          DY = 1
+         ELSE
+          DY = 0
+         ENDIF
+         ! check for the boundary regions
+
+         IF(ICELL(1).LE.0) THEN
+          ICELL(1)= NMIL+1
+!           WRITE (*,*) 'BORDER TO THE RIGHT! MESH CH  ', ICELL(1)
+         ENDIF
+
+         IF(ICELL(2).LE.0) THEN
+           ICELL(2)= NMIL+1
+!           WRITE (*,*) 'BORDER TO THE LEFT! MESH CH   ', ICELL(2)
+         ENDIF
+         ! equations at the boundary:
+         ! mesh on the left indicator of the surface ------------
+         IF(TOS(DX,DY).EQ.1) SOT= 3
+         IF(TOS(DX,DY).EQ.2) SOT= 4
+         IF(TOS(DX,DY).EQ.3) SOT= 1
+         IF(TOS(DX,DY).EQ.4) SOT= 2
+         !
+         !-------------------------------------------------------
+         ! loop for the values of the J+-, J, FI
+         DO NGRP= 1,NG
+          ! J+
+          CURR_INFO(ICELL(1),NGRP,TOS(DX,DY),1)=
+     >     CURRN(NS,NGRP,2)/REAL(RPAR(5,NS))
+          CURR_INFO(ICELL(2),NGRP,SOT,1)=
+     >    CURRN(NS,NGRP,1)/REAL(RPAR(5,NS))
+          ! J-
+          CURR_INFO(ICELL(1),NGRP,TOS(DX,DY),2)=
+     >    CURRN(NS,NGRP,1)/REAL(RPAR(5,NS))
+          CURR_INFO(ICELL(2),NGRP,SOT       ,2)=
+     >    CURRN(NS,NGRP,2)/REAL(RPAR(5,NS))
+
+          ! J
+          CURR_INFO(ICELL(1),NGRP,TOS(DX,DY),3)=
+     >    CURR_INFO(ICELL(1),NGRP,TOS(DX,DY),1) -
+     >    CURR_INFO(ICELL(1),NGRP,TOS(DX,DY),2)
+
+          CURR_INFO(ICELL(2),NGRP,SOT       ,3)=
+     >    CURR_INFO(ICELL(2),NGRP,SOT       ,1) -
+     >    CURR_INFO(ICELL(2),NGRP,SOT       ,2)
+          ! F-surf(het)
+          IF(ICELL(1).EQ.(NMIL+1)) THEN
+             IF(HASSYM(CAXIS(SOT),ICELL(2))) THEN
+                CURR_INFO(ICELL(2),NGRP,SOT,4) = 0.0
+             ELSE
+                CURR_INFO(ICELL(2),NGRP,SOT,4) = SRFLX(NS,NGRP)
+     >          / REAL(RPAR(5,NS))
+             ENDIF
+          ELSEIF(ICELL(2).EQ.(NMIL+1)) THEN
+             IF(HASSYM(CAXIS(TOS(DX,DY)),ICELL(1))) THEN
+                CURR_INFO(ICELL(1),NGRP,TOS(DX,DY),4) = 0.0
+             ELSE
+                CURR_INFO(ICELL(1),NGRP,TOS(DX,DY),4) =
+     >           SRFLX(NS,NGRP)/REAL(RPAR(5,NS))
+             ENDIF
+          ELSE ! both cells are real
+            CURR_INFO(ICELL(1),NGRP,TOS(DX,DY),4) =
+     >       SRFLX(NS,NGRP)/REAL(RPAR(5,NS))
+            CURR_INFO(ICELL(2),NGRP,SOT       ,4) =
+     >       SRFLX(NS,NGRP)/REAL(RPAR(5,NS))
+          ENDIF
+         ! side dimension
+          CURR_INFO(ICELL(1),NGRP,TOS(DX,DY),9)= REAL(RPAR(5,NS))
+          CURR_INFO(ICELL(2),NGRP,SOT       ,9)= REAL(RPAR(5,NS))
+
+          NSURF(1)= TOS(DX,DY)
+          NSURF(2)= SOT
+          DO IND= 1,2
+           IF(ICELL(IND) < (NMIL+1)) THEN
+            NZ= ICELL(IND)
+            ! FI
+            CURR_INFO(NZ,NGRP,:,5)=ZAFLX(NZ,NGRP)
+           ENDIF
+          ENDDO
+         ENDDO
+      ENDDO ! NS
+
+      DO NC= 1,NMIL
+         DO IAXIS= 1,NAXIS
+          IF(HASSYM(IAXIS,NC)) THEN
+           DO IPAIR= 1,NPAIR(IAXIS)
+            ! put current value in the interface in front of it
+            IF(CURR_INFO(NC,1,INTCORR(0,IPAIR,IAXIS),4).NE.0.) THEN
+               CURR_INFO(NC,:,INTCORR(1,IPAIR,IAXIS),1:9)=
+     >         CURR_INFO(NC,:,INTCORR(0,IPAIR,IAXIS),1:9)
+            ELSEIF(CURR_INFO(NC,1,INTCORR(1,IPAIR,IAXIS),4).NE.0.)
+     >       THEN
+               CURR_INFO(NC,:,INTCORR(0,IPAIR,IAXIS),1:9)=
+     >         CURR_INFO(NC,:,INTCORR(1,IPAIR,IAXIS),1:9)
+            ENDIF
+           ENDDO
+          ENDIF
+         ENDDO
+
+         ! now put the possible zero dimension values
+         DO IA= 1,NAXIS
+          DO IP= 1,NPAIR(IA)
+           ! put current value in the interface in front of it
+           IF(CURR_INFO(NC,1,INTCORR(0,IP,IA),9) .NE. 0.) THEN
+           ELSE
+            CURR_INFO(NC,:,INTCORR(0,IP,IA),1:9) =
+     >       CURR_INFO(NC,:,INTCORR(1,IP,IA),1:9)
+           ENDIF
+           IF(CURR_INFO(NC,1,INTCORR(1,IP,IA),9) .NE. 0.)THEN
+           ELSE
+            CURR_INFO(NC,:,INTCORR(1,IP,IA),1:9) =
+     >       CURR_INFO(NC,:,INTCORR(0,IP,IA),1:9)
+           ENDIF
+          ENDDO
+         ENDDO
+      ENDDO ! NC
+
+!-------------------------------------------------------
+      DO NC= 1,NMIL
+         DO NSURFAC= 1,NSD
+          DO NGRP= 1,NG
+
+           DIFF_C(NC,NGRP)= DIFC(NGRP)
+           J_PLUS = CURR_INFO(NC,NGRP,NSURFAC,1)
+           J_MINOS= CURR_INFO(NC,NGRP,NSURFAC,2)
+           J_NET  = CURR_INFO(NC,NGRP,NSURFAC,3)
+           FI_HET = CURR_INFO(NC,NGRP,NSURFAC,4)
+           FAVE   = CURR_INFO(NC,NGRP,NSURFAC,5)
+
+           APOTH(NC,NSURFAC)=
+     >     CURR_INFO(NC,NGRP,PAXIS(0,CAXIS(NSURFAC)),9)/2.0
+           CURR_INFO(NC,NGRP,NSURFAC,8)= APOTH(NC,NSURFAC)
+           FI_HOMOG = SIGF(NSURFAC)*J_NET * APOTH(NC,NSURFAC)
+     >     / DIFF_C(NC,NGRP) + FAVE
+           ! FG:
+           CURR_INFO(NC,NGRP,NSURFAC,6)= REAL(FI_HET / FI_HOMOG)
+           ! FS:
+           CURR_INFO(NC,NGRP,NSURFAC,7)= REAL(2. *
+     >                ( J_PLUS + J_MINOS ) / FI_HOMOG)
+
+          ENDDO !NGRP
+         ENDDO !NSURFAC
+      ENDDO !NC
+      !
+      ! B2 loop:
+      !
+      DO NCELL= 1,NMIL
+         DO NGRP= 1,NG
+          J_SUMM = SUM(CURR_INFO(NCELL,NGRP,:,3))
+
+          B2_VECT(NCELL,NGRP)= REAL(J_SUMM / ( DIFF_C(NCELL,NGRP)
+     >    * CURR_INFO(NCELL,NGRP,1,5) ))
+         ENDDO
+      ENDDO
+
+      DO NCELL= 1,NMIL
+         DO NGRP= 1,NG
+          DO NSURFAC= 1,NSD
+           ! TRANSVERSAL CURRENTS SUMMATION
+           TRANSV_CURR= 0.
+           DO TR= 1,2
+            TRANSV_CURR= TRANSV_CURR +
+     >      CURR_INFO(NCELL,NGRP,TRF_I(TR,NSURFAC),3)
+           ENDDO
+            ! no need to be stored !!!!
+            ! CURR_INFO(NCELL,NGRP,NSURFAC,8)= TRANSV_CURR
+          ENDDO
+         ENDDO
+      ENDDO
+      ! store new IDF in the corresponding module to be used in
+      ! writenemtab
+      DO NCELL= 1,NMIL
+        DO NGRP= 1,NG
+          ! B2XS(K,NCELL,NGRP)=B2_VECT(NCELL,NGRP)
+          DO NSURFAC= 1,NSD
+            DO P=1,9
+              ! 1 ->  J+
+              ! 2 ->  J-
+              ! 3 ->  J
+              ! 4 ->  F-surf
+              ! 5 ->  F-ave
+              ! 6 ->  GET_IDF
+              ! 7 ->  SEL_IDF
+              ! 8 ->  apotheme
+              ! 9 ->  side length
+              ADF(NSURFAC,NGRP,P)=CURR_INFO(NCELL,NGRP,NSURFAC,P)
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDDO
+
+      IF(IPRINT > 1) THEN
+        WRITE(6,*) "*** RECOVER ASSEMBLY DISCONTINUITY FACTOR ***"
+        IF(ADF_T.EQ.'GET') WRITE(6,*) "ADF TYPE : GET "
+        IF(ADF_T.EQ.'SEL') WRITE(6,*) "ADF TYPE : SELENGUT "
+       DO NGRP=1, NG
+        WRITE(6,*) "GROUP             :",NGRP
+         IF(ADF_T.EQ.'GET') WRITE(6,*)"ADF(N/E/S/W) :",ADF (:,NGRP,6)
+         IF(ADF_T.EQ.'SEL') WRITE(6,*)"ADF(N/E/S/W) :",ADF (:,NGRP,7)
+       ENDDO
+      ENDIF
+
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
+      IPTH=LCMGID(IPDAT,'CROSS_SECT')
+      KPTH=LCMDIL(IPTH,STAIDX(NVAR))
+      CALL LCMSIX(KPTH,'MACROLIB_XS',1)
+      IF(ADF_T.EQ.'GET') THEN
+       CALL LCMPUT(KPTH,'ADF',NSF*NG,2,ADF(:,:,6))
+      ELSEIF(ADF_T.EQ.'SEL') THEN
+       CALL LCMPUT(KPTH,'ADF',NSF*NG,2,ADF(:,:,7))
+      ELSE
+       CALL XABORT('@D2PADF: UNKNOW ADF TYPE'//ADF_T//'.')
+      ENDIF
+      END
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
diff --git a/Donjon/src/D2PDEF.f b/Donjon/src/D2PDEF.f
new file mode 100644
index 0000000..92e3ea0
--- /dev/null
+++ b/Donjon/src/D2PDEF.f
@@ -0,0 +1,199 @@
+*DECK D2PDEF
+      SUBROUTINE D2PDEF( IPDAT,  PKEY, VALPAR,   NVALPA,  STAIDX,REFIDX,
+     >                  REFSTA,HSTSTA,  STATE,   CRDINF,    NCRD,  NVAR,
+     >                  PKIDX,  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
+*
+*Parameters: 
+* IPDAT    
+* PKEY     
+* VALPAR   
+* NVALPA   
+* STAIDX   
+* REFIDX   
+* REFSTA   
+* HSTSTA   
+* STATE    
+* CRDINF   
+* NCRD     
+* NVAR     
+* PKIDX    
+* IPRINT   
+*
+*-----------------------------------------------------------------------
+*
+      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*12 PKEY(NVAR)
+      INTEGER PKIDX(NVAR)
+*----
+*  LOCAL VARIABLES
+*----
+      TYPE(C_PTR) IPTH,KPTH
+      INTEGER ITYLCM,i,PK,IDX(NVAR),j
+      INTEGER :: NBR = 1
+      ! number of values for each default state variable ( 1 if the
+      ! initial number of values is less than 3, 3 otherwise)
+      ! 1 : DMOD ; 2 : CBOR ; 3 : TCOM ; 4 : TMOD
+      INTEGER :: DMS(5) = 0  ! NB OF VALUE FOR PARAMETER
+      REAL :: REF(5) = -999.9 ! REFERENC VALUE
+      REAL :: STA(5) = -999.9 ! INITIAL VALUE
+      REAL :: HST(5) = -999.9 ! HISTORY VALUE
+      CHARACTER*12 PKNAM(6)
+      LOGICAL LFLAG(6)
+      CHARACTER*12,DIMENSION(6) :: PKREF
+      DATA PKREF/ "BARR","DMOD","CBOR","TCOM","TMOD","BURN"/
+      REAL DEF(5,3)
+      DEF(:5,:3)=0
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
+
+      DO PK=1, 6
+        IPTH=LCMGID(IPDAT,'PKEY_INFO')
+        KPTH=LCMDIL(IPTH,PK)
+        CALL LCMGET(KPTH,'LFLAG',LFLAG(PK))
+        IF (PK == 1 .OR. PK==6)THEN
+         CALL LCMGTC(KPTH,'NAME',12,PKNAM(PK))
+        ELSE
+         IF(LFLAG(PK)) CALL LCMGTC(KPTH,'NAME',12,PKNAM(PK))
+        ENDIF
+      ENDDO
+
+      DO i=1, NVAR
+       IF (PKIDX(i).EQ.-1) THEN
+        IDX(i)=1
+       ELSE
+        IDX(i)=PKIDX(i)
+       ENDIF
+       CALL LCMLEN(IPDAT,PKREF(IDX(i)),NVALPA(i),ITYLCM)
+       CALL LCMGET(IPDAT,PKREF(IDX(i)),VALPAR(i,1:NVALPA(i)))
+       IF (PKREF(IDX(i)).EQ.PKREF(1)) THEN
+        NBR=NBR*NVALPA(i)
+        PKEY(1)=PKNAM(1)
+        REFSTA(1)=CRDINF(1)
+        HSTSTA(1)= CRDINF(1)
+        STATE(1)= CRDINF(1)
+        STAIDX(1)=1
+        REFIDX(1)=1
+       ENDIF
+      ENDDO
+
+      DO i=1, NVAR
+       DO j=2,5
+        IF (PKREF(IDX(i)).EQ.PKREF(j)) THEN
+          IF(NVALPA(i)>2) THEN
+           DMS(j)=3
+           DEF(j,2)=VALPAR(i,NINT(NVALPA(i)/2.0))
+           DEF(j,3)=VALPAR(i,NVALPA(i))
+           STAIDX(j)=2   ! DMOD INDEX OF INITIAL DEFAULT VALUE
+           REFIDX(j)=2   ! DMOD INDEX OF REFERENCE DEFAULT VALUE
+           NBR=NBR*3
+          ELSE
+           DMS(j)=1
+           STAIDX(j)=1   ! DMOD INDEX OF INITIAL DEFAULT VALUE
+           REFIDX(j)=1   ! DMOD INDEX OF REFERENCE DEFAULT VALUE
+          ENDIF
+          DEF(j,1)=VALPAR(i,1)
+          STA(j)=VALPAR(i,NINT(NVALPA(i)/2.0))
+          HST(j)=VALPAR(i,NINT(NVALPA(i)/2.0))
+          REF(j)=HST(j)
+        ENDIF
+       ENDDO
+      ENDDO
+
+      DO k=2,5
+       IF (k==6) THEN
+        PKEY(k)=PKNAM(6)
+        STATE(k)= VALPAR(NVAR,1)
+        STAIDX(k)=1
+        REFIDX(k)=1
+        CALL LCMDEL(IPDAT,PKREF(k))
+        CALL LCMPUT(IPDAT,PKREF(k),NVALPA(NVAR),2,
+     1  VALPAR(NVAR,1:NVALPA(NVAR)) )
+       ELSE IF (LFLAG(k)) THEN
+        l=k-1
+        DO WHILE ((.NOT.(LFLAG(l)).and. (l.GT.1)))
+        l=l-1
+        ENDDO
+        PKEY(l+1)=PKNAM(k)
+        REFSTA(l+1)=REF(k)
+        HSTSTA(l+1)=HST(k)
+        STATE(l+1)=STA(k)
+        CALL LCMPUT(IPDAT,PKREF(k),DMS(k),2,DEF(k,1:DMS(k)))
+       ENDIF
+      ENDDO
+
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
+      CALL LCMPTC(IPDAT,'STATE_VAR',12,NVAR,PKEY)
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
+      CALL LCMPTC(IPDAT,'BRANCH',12,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 : ", DEF(2,1:DMS(2))
+          WRITE(6,*) "  CBOR : ", DEF(3,1:DMS(3))
+          WRITE(6,*) "  TCOM : ", DEF(4,1:DMS(4))
+          IF(LFLAG(5)) THEN
+          WRITE(6,*) "  TMOD : ", DEF(5,1:DMS(5))
+          ENDIF
+          WRITE(6,*)
+          WRITE(6,*) "NUMBER OF BRANCHES : ", NBR
+          WRITE(6,*)
+          WRITE(6,*) "STATE PARAMETERS : ",PKEY(1:NVAR)
+          WRITE(6,*) "REFERENCE STATES VALUES :", REFSTA
+          WRITE(6,*)
+          WRITE(6,*) "INITIAL STATES VALUES :", STATE
+          WRITE(6,*) "INITIAL STATES INDEX VALUES :", STAIDX
+          WRITE(6,*)
+      ENDIF
+
+      END
diff --git a/Donjon/src/D2PDIV.f b/Donjon/src/D2PDIV.f
new file mode 100644
index 0000000..6ee5701
--- /dev/null
+++ b/Donjon/src/D2PDIV.f
@@ -0,0 +1,290 @@
+*DECK D2PDIV
+      SUBROUTINE D2PDIV(  IPDAT, IPSAP , IPRINT,    NGP,   NBU,  NVAR,
+     >                     GRID,  NPAR ,   NREA,   NISO,  NMAC,  NMIL,
+     >                     NANI, NADRX , STAIDX,  STATE, STAVAR,  NSF,
+     >                     LABS,   SCAT,   LADF                      )
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover the DIVERS directory of an elementary calculation and store
+* additional XS recovered directly from IPSAP
+* WARNING: the GET_DIVERS_INFO subroutine cannot recover DIVERS
+* information in the case where cross sections are interpolated by
+* the SCR: module
+*
+*Author(s): 
+* J. Taforeau
+*
+*Parameters: input
+* IPDAT   address of the INFO data block
+* IPSAP   address of the saphyb object
+* IPRINT  control the printing on screen
+* NGP     number of energy groups
+* NBU     number of burnup point in IPSAP
+* NVAR    number of state parameters in INFO data block
+* GRID    type of gridding for branches (0 = default, 1 = Saphyb
+*         branching etc )
+* NPAR    number of state parameters in saphyb (including FLUE and
+*         TIME)
+* NREA    number of reactions in IPSAP
+* NISO    number of isotopoes in IPSAP
+* NMAC    number of macros in IPSAP
+* NMIL    number of mixtrures  in IPSAP
+* NANI    number of anisotropy
+* STAIDX  index of state variables
+* STATE   state variables of current branch calculation
+* STAVAR  state variables in INFO data block
+* NSF     nummber of surface in IPSAP
+* LABS    information for absorption reconstruction
+* SCAT    information for scattering XS reconstruction
+* LADF    flag for ADF reconstrcution
+*
+*Parameters: 
+* NADRX   
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPDAT,IPSAP
+      INTEGER NPAR,NMIL,GRID,NVAR,NBU,NSF,NREA,NISO,NADRX
+      INTEGER NGP,IPRINT,NMAC,NANI,STAIDX (NVAR)
+      REAL STATE(NVAR)
+      CHARACTER(LEN=12) STAVAR(NVAR)
+      LOGICAL LABS(3),SCAT,LADF
+*----
+*  LOCAL VARIABLES
+*----
+      TYPE(C_PTR) IPTH,KPTH
+      ! LOOP INDEX
+      INTEGER i, It, Ib,PK
+      ! LOOP INDEX OF : PARAMETERS (ISV=1..NPAR), STATES (INP=1..NVAR)
+      INTEGER ISV,INP
+      ! DIMENSION OF ARBVAL
+      INTEGER DIMARB
+      ! NUMBER OF ELEMENTARY CALCULATIONS
+      INTEGER NCALS
+      ! TYPE OF DATA RECOVERED FROM GANLIB SUBROUTINES
+      INTEGER ITYLCM
+      ! NUMBER OF VALUES IN IDVAL ET VALDIV
+      INTEGER NVDIV
+      ! ORDER NUMBERS OF FLUE PARAMETERS IN SAPHYB
+      INTEGER :: FLUE_ID = 0
+      ! ORDER NUMBERS OF TIME PARAMETERS IN SAPHYB
+      INTEGER :: TIME_ID = 0
+      ! CF : APOLLO2 : NOTICE INFORMATIQUE DE LA VERSION 2.8-1
+      INTEGER MUPLET(NPAR)
+      ! VECTOR OF : RANK ORDER OF STATE PARAMETERS, NUMBER OF VALUES
+      ! FOR EACH STATE PARAMETERS
+      INTEGER  RANK_ORDER(NPAR), NVALUE(NPAR)
+      REAL B2
+      CHARACTER*3 :: ADF_T = 'DRA'
+      ! NAME OF DIRECTORIES IN SAPHYB : ELEMENTARY CALCULATION,
+      ! CONTROL ROD
+      CHARACTER(LEN=12) CALDIR,BARRDIR
+      ! NAME OF STATE VARIABLES IN SAPHYB
+      CHARACTER(LEN=12) PKNAM(6)
+      ! STATE VARIABLES IN SAPHYB
+      CHARACTER(LEN=12) PKEY(NPAR)
+      LOGICAL LFLAG(6)
+
+      ! CF : APOLLO2 : NOTICE INFORMATIQUE DE LA VERSION 2.8-1
+      ! VALUES OF : VALDIV = (KEFF, KINF,B2),  CONTROL ROD KEFF, KINF,B
+      INTEGER, ALLOCATABLE, DIMENSION(:) ::  DEBARB,ARBVAL
+      REAL, ALLOCATABLE, DIMENSION(:) :: VALDIV,BARR_VAL
+      CHARACTER(LEN=4), ALLOCATABLE, DIMENSION(:) :: IDVAL
+
+      ! RECOVER INFOMATION FROM INFO DATA BLOCK AND SAPHYB OBJECT
+
+      ! MOVING INTO INFO DATA BLOCK
+      CALL LCMSIX (IPSAP,' ',0)
+
+      CALL LCMSIX (IPSAP,'paramdescrip',1)
+      CALL LCMGTC(IPSAP,'PARKEY',4,NPAR,PKEY)
+      CALL LCMGET (IPSAP,'NVALUE',NVALUE)
+
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
+      IF (LADF) CALL LCMGTC(IPDAT,'ADF_TYPE',3,ADF_T)
+      PKEY (1:NPAR) (5:12) = "        "
+      DO PK=1, 6
+        IPTH=LCMGID(IPDAT,'PKEY_INFO')
+        KPTH=LCMDIL(IPTH,PK)
+        CALL LCMGET(KPTH,'LFLAG',LFLAG(PK))
+        IF (PK == 1 .OR. PK==6)THEN
+         CALL LCMGTC(KPTH,'NAME',12,PKNAM(PK))
+        ELSE
+         IF(LFLAG(PK)) CALL LCMGTC(KPTH,'NAME',12,PKNAM(PK))
+        ENDIF
+      ENDDO
+      ! LOOP TO STORE THE INDEX OF FLUE AND
+      ! LINK THE FLUE AND TIME VARIABLES INDEX TO BURN VARIABLE INDEX
+      DO It=1, NPAR
+        IF(PKEY(It)=="TIME") TIME_ID=It
+        IF(PKEY(It)=="FLUE") FLUE_ID=It
+      ENDDO
+      ! LOOP OVER NUMBER OF STATE PARAMETERS IN SAPHYB
+      DO ISV=1, NPAR
+        ! LOOP OVER NUMBER OF STATE PARAMETERS IN INFO DATA BLOCK
+        DO INP=1, NVAR
+         ! IF NAME OF STATE VARIABLE IN INFO AND SAPHYB ARE EQUAL
+         IF(PKEY(ISV)==STAVAR(INP)) THEN
+          ! SPECIAL CASE FOR BARR parameters
+          IF(PKEY(ISV)==PKNAM(1)) THEN
+           !SPECIAL CASE FOR CONTROL ROD
+           ALLOCATE (BARR_VAL(NVALUE(ISV)))
+           WRITE(BARRDIR,'("pval", I8)') ISV
+           ! NAME OF DIRECTORY IN SAPHYB  CONTAINING CONTROL ROD VALUES
+           IF(LFLAG(1)) THEN
+           ! RECOVER CONTROL ROD VALUES
+            CALL LCMSIX (IPSAP,' ',0)
+            CALL LCMSIX (IPSAP,'paramvaleurs',1)
+            CALL LCMGET(IPSAP,BARRDIR,BARR_VAL)
+
+           ! LOOP OVER POSSIBLE VALUES OF CONTROL ROD IN SAPHYB
+            DO Ib=1, NVALUE(ISV)
+             IF(STATE(INP)==BARR_VAL(Ib)) THEN
+              ! STORE THE ORDER NUMBERS OF CURRENT CONTROL VALUES
+              ! CORRESPONDING TO THE BRANCH CALCULATED
+              RANK_ORDER(ISV)=Ib
+             ENDIF
+            ENDDO
+           ENDIF
+           DEALLOCATE (BARR_VAL)
+
+          ! SPECIAL CASE WITH DEFAULT VALUES FOR STATE VARIABLES
+          ! (OTHER THAN BARR)
+          ELSE IF(GRID==0) THEN
+           ! TREATEMENT OF THE MID VALUE OF THE GRID
+           IF(STAIDX(INP)==2) THEN
+            ! ONLY DMOD,TCOM AND CBOR ARE  AFFECTED BY THE DEFAULT
+            ! GRIDDING
+            IF((PKEY(ISV)==PKNAM(2))) THEN
+             RANK_ORDER(ISV)=NINT (NVALUE(ISV)/2.0)
+            ELSE IF((PKEY(ISV)==PKNAM(4)))THEN
+             RANK_ORDER(ISV)=NINT (NVALUE(ISV)/2.0)
+            ELSE IF((PKEY(ISV)==PKNAM(3)))THEN
+             RANK_ORDER(ISV)=NINT (NVALUE(ISV)/2.0)
+            ELSE
+             RANK_ORDER(ISV)=STAIDX(INP)
+            ENDIF
+           ! TREATEMENT OF THE LAST VALUE OF THE GRID
+           ELSE  IF(STAIDX(INP)==3) THEN
+            ! ONLY DMOD,TCOM AND CBOR ARE  AFFECTED BY THE DEFAULT
+            ! GRIDDING
+            IF((PKEY(ISV)==PKNAM(2))) THEN
+             RANK_ORDER(ISV)=NVALUE(ISV)
+            ELSE IF((PKEY(ISV)==PKNAM(4)))THEN
+             RANK_ORDER(ISV)=NVALUE(ISV)
+            ELSE IF((PKEY(ISV)==PKNAM(3)))THEN
+             RANK_ORDER(ISV)=NVALUE(ISV)
+            ELSE
+             RANK_ORDER(ISV)=STAIDX(INP)
+            ENDIF
+             ! ONLY DMOD,TCOM AND CBOR ARE  AFFECTED BY THE DEFAULT
+             ! GRIDDING
+           ELSE ! THE FIRST VALUE IS UNCHANGED BY SET_DEFAULT_VALUE
+             RANK_ORDER(ISV)=STAIDX(INP)
+           ENDIF
+         ! IF WE KEEP THE INITIAL STATE VARIABLE GRID OF SAPHYB
+          ELSE
+           RANK_ORDER(ISV)=STAIDX(INP)
+          ENDIF
+          !TREATMENT OF FLUE AND TIME VARIABLES
+          IF(PKEY(ISV)==PKNAM(6)) THEN
+           IF(FLUE_ID>0) RANK_ORDER(FLUE_ID)=RANK_ORDER(ISV)
+           IF(TIME_ID>0) RANK_ORDER(TIME_ID)=RANK_ORDER(ISV)
+          ENDIF
+         ENDIF
+        ENDDO
+      ENDDO
+
+      ! RECOVER INFORMATION FROM SAPHYB
+      CALL LCMSIX (IPSAP,' ',0)
+      CALL LCMSIX (IPSAP,'paramarbre',1)
+      CALL LCMLEN (IPSAP,'ARBVAL',DIMARB,ITYLCM)
+      ALLOCATE (ARBVAL(DIMARB),DEBARB(DIMARB+1))
+      CALL LCMGET (IPSAP,'NCALS',NCALS)
+      CALL LCMGET (IPSAP,'ARBVAL',ARBVAL)
+      CALL LCMGET (IPSAP,'DEBARB',DEBARB)
+      ! PROCEDURE TO RECOVER THE NUMBER OF THE ELEMENTARY CALCULATION
+      ! CORREPSONDING TO THE CURRENT BRANCH
+      ! CF APOLLO2 : NOTICE INFORMATIQUE DE LA VERSION 2.8-1
+      II=1
+      DO 30 IPAR=1,NPAR
+        MUPLET(IPAR) =RANK_ORDER(IPAR)
+        DO 10 I=DEBARB(II),DEBARB(II+1)-1
+         IF(MUPLET(IPAR).LE.ARBVAL(I))THEN
+          IF(MUPLET(IPAR).EQ.ARBVAL(I))THEN
+           II=I
+           GO TO 30
+          ELSE
+           GO TO 20
+          ENDIF
+         ENDIF
+10      CONTINUE
+20      ICAL=0
+       WRITE(6,*) " MUPLET : ", MUPLET
+       CALL XABORT ("@D2PDIV: ELEMENTARY CALCULATION UNKNOWN")
+       RETURN
+30    CONTINUE
+      ! END OF APPOLO2 PROCEDURE
+
+      ICAL=DEBARB(II+1) ! number of the elementary calculation
+
+      ! MOVING IN THE ELEMENTARY CALCULATION AND RECONVER THE B2, KEFF
+      ! AND KINF DATA
+      WRITE(CALDIR,'("calc", I8)') ICAL
+      CALL LCMSIX (IPSAP,' ',0)
+      CALL LCMSIX (IPSAP,CALDIR,1)
+      CALL LCMSIX(IPSAP,'divers',1)
+      CALL LCMGET(IPSAP,'NVDIV',NVDIV)
+
+      ALLOCATE(IDVAL(NVDIV),VALDIV(NVDIV))
+      CALL LCMGTC(IPSAP,'IDVAL',4,NVDIV,IDVAL)
+      CALL LCMGET(IPSAP,'VALDIV',VALDIV)
+
+
+      ! STORE RESULTS (IF CORRESPONDING DATA IS AVAILABLE) INTO INFO
+      ! data block at :
+      ! INFO/BRANCH_INFO/KEFF
+      ! INFO/BRANCH_INFO/B2
+      ! INFO/BRANCH_INFO/KINF
+
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
+      IF(STAIDX(NVAR)==1) THEN
+        IPTH=LCMLID(IPDAT,'DIVERS',NBU)
+      ELSE
+        IPTH=LCMGID(IPDAT,'DIVERS')
+      ENDIF
+      KPTH=LCMDIL(IPTH,STAIDX(NVAR))
+
+      IF(IPRINT>1) THEN
+        WRITE(6,*)
+        WRITE(6,*) "****          DIVERS INFORMATION           ****"
+      ENDIF
+      DO Idiv=1, NVDIV
+        IF(IDVAL(Idiv)=="KEFF") THEN
+         CALL LCMPUT(KPTH,'KEFF',1,2,VALDIV(Idiv))
+         IF(IPRINT>1) WRITE(6,*)"KEFF                    :",VALDIV(Idiv)
+        ENDIF
+        IF(IDVAL(Idiv)=="KINF") THEN
+         CALL LCMPUT(KPTH,'KINF',1,2,VALDIV(Idiv))
+         IF(IPRINT>1) WRITE(6,*)"KINF                    :",VALDIV(Idiv)
+        ENDIF
+        IF(IDVAL(Idiv)=="B2") THEN
+         CALL LCMPUT(KPTH,'B2',1,2,VALDIV(Idiv))
+         B2=VALDIV(Idiv)
+         IF(IPRINT>1) WRITE(6,*)"B2                      :",VALDIV(Idiv)
+        ENDIF
+      ENDDO
+      ! TEMPORARY SUBROUTINE WAITING FOR FURTHER DEVELOMENTS TO RECOVER
+      ! ADDITIONAL INFORMATION
+      CALL D2PXSA(IPDAT,IPSAP,ICAL,IPRINT,NGP,NREA,NISO,NMAC,NMIL,
+     1   NANI,NVAR,NADRX,STAIDX,B2,ADF_T,NSF,LABS,SCAT,LADF)
+      DEALLOCATE (ARBVAL,DEBARB,VALDIV,IDVAL)            ! FREE MEMORY
+      END
diff --git a/Donjon/src/D2PDRV.f b/Donjon/src/D2PDRV.f
new file mode 100644
index 0000000..fe41a0a
--- /dev/null
+++ b/Donjon/src/D2PDRV.f
@@ -0,0 +1,419 @@
+*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, JOBOPT, USRPAR,   MESH,
+     >                     PKEY, FILNAM,   ISOT, JOBTIT,    COM,    SAP,
+     >                      MIC,    EXC,   SCAT,   LADD,   LNEW, MIXDIR,
+     >                      CDF,    GFF,   ADFD,   CDFD,    YLD, YLDOPT,
+     >                   LOCYLD,   XESM,  ITEMP,  OTHPK, OTHTYP, OTHVAL,
+     >                     HDET,  LPRC,  HEQUI,   HMASL,ISOTOPT,ISOTVAL,
+     >                     LMEM,OTHVAR,   THCK,    HFLX,   HCUR        )
+*
+*-----------------------------------------------------------------------
+*
+*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 data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+* 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
+* 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 promethium
+* 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
+* MIXDIR  directory that contains homogeneous mixture information
+* CDF     type of CDF to be selected
+* GFF     type of GFF to be selected
+* ADFD    name of record for 'DRA' type of ADF
+* CDFD    name of record for 'DRA' type of CDF
+* YLD     user defined values for fission yields (1:I, 2:XE, 3:PM)
+* LOCYLD  value for state parameter on which fission yield will be calcu
+* YLDOPT  option for fission yield calculation (DEF, MAN, FIX)
+* XESM    option for comparing k-inf in GenPMAX (1: using Pm/Sm data;
+*         2: using I/Xe data; 3: using I/Xe/Pm/Sm data)
+* ITEMP   indicate if temperature is in C or in K in the SAP/MCO objec
+* HDET    name of isotope for the detector cross sections
+* LMER    ADF are merged in the cross sections
+* THCK    Thickness of reflector
+* HFLX    Name of the record for the flux
+* HCUR    Name of the record for the current
+*
+*Parameters: 
+* OTHPK   
+* OTHTYP  
+* OTHVAL  
+* LPRC    
+* HEQUI   
+* HMASL   
+* ISOTOPT 
+* ISOTVAL 
+* LMEM    
+* OTHVAR  
+*
+*-----------------------------------------------------------------------
+*
+      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,XESM
+      INTEGER PHASE,IPRINT,ITEMP
+      REAL THCK
+      INTEGER STAVEC(40),CRDINF(20),USRVAL(12)
+      REAL VERS,SFAC,BFAC,YLD(3),LOCYLD(5)
+      REAL FC1(5),FC2(8),FC3(7),FC4(3),XSC(3)
+      REAL USRVAPK(12,10),ISOTVAL,OTHVAR(12)
+      CHARACTER JOBOPT(16)
+      CHARACTER*12 OTHTYP(12),OTHPK(12),OTHVAL(12),HDET
+      CHARACTER*3 ADF,CDF,GFF,YLDOPT
+      CHARACTER*8 ADFD(4),CDFD(8)
+      CHARACTER*4 DER,HEQUI,HMASL,JOB(4)
+      CHARACTER*1 ISOTOPT
+      CHARACTER*5 MESH
+      CHARACTER*8 PKEY(6)
+      CHARACTER*12 FILNAM,ISOT(6),SIGNAT,MIXDIR,USRPAR(12)
+      CHARACTER*16 JOBTIT
+      CHARACTER*8 HCUR(2),HFLX(2)
+      CHARACTER*40 COM
+      LOGICAL SAP, MIC, EXC,SCAT,LADD,LNEW,LPRC,LMEM
+*----
+*  LOCAL VARIABLES
+*----
+      TYPE(C_PTR) IPSAP,IPDAT,IPMIC
+      INTEGER IPHEL,IPINP,IPPRC
+      INTEGER DEB,REW
+      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.NE.3) CALL XABORT('@D2PDRV: 3 PARAMETERS EXPECTED.')
+       IF((IENTRY(1).NE.4)) THEN
+        WRITE(HSMG,'(12H@D2P: ENTRY ,A12,24H IS NOT OF SEQUENTIAL AS,
+     >  9HNCII TYPE)') HENTRY(2)
+        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(2).NE.1) THEN
+        WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,19H IS NOT OF LCM 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(2),'SIGNATURE',12,HSIGN)
+       IF(HSIGN.NE.'L_INFO') THEN
+        TEXT12=HENTRY(2)
+        CALL XABORT('@D2P: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     1  '. L_INFO EXPECTED.')
+       ENDIF
+      IF(IENTRY(3).GT.2) THEN
+       WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,19H IS NOT OF LCM TYPE)')
+     >  HENTRY(3)
+       CALL XABORT(HSMG)
+      ELSE IF(JENTRY(3).NE.2) THEN
+        WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,20H IS NOT IN READ ONLY,
+     >  5H MODE)')
+     >  HENTRY(3)
+        CALL XABORT(HSMG)
+       ENDIF
+       CALL LCMGTC(KENTRY(3),'SIGNATURE',12,HSIGN)
+       SIGNAT=HSIGN
+       IF((HSIGN.NE.'L_SAPHYB')) THEN
+        IF(HSIGN.NE.'L_MULTICOMPO') THEN
+         TEXT12=HENTRY(3)
+         CALL XABORT('@D2PDRV: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     1   '. L_SAPHYB OR L_MULTICOMPO EXPECTED.')
+        ENDIF
+       ENDIF
+
+       IPPRC=FILUNIT(KENTRY(1))
+       IPDAT=KENTRY(2) ! output INFO address
+       IPSAP=KENTRY(3) ! 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))
+       STAVEC(19)=ITEMP
+       IF ((XSC(1).GT.4).OR.(XSC(2).GT.8)) THEN
+        CALL XABORT ('@D2PDRV: CARD XS_CONT : NSIDE AND NCORNER'
+     1   //' CANNOT EXCEED 4 AND 8 RESPECTIVELY.')
+       ENDIF
+       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 , IPRINT, STAVEC, CRDINF,   NCRD,
+     >                     PKEY,   ISOT,   MESH, USRPAR, USRVAL, USRSTA,
+     >                  USRVAPK,    SAP,    MIC, EXC   ,   SCAT, ADF   ,
+     >                      DEB,   FA_K,   LADD,   LNEW,    MIX,    XSC,
+     >                   JOBOPT, SIGNAT, MIXDIR,    CDF,    GFF,   ADFD,
+     >                     CDFD,    YLD, YLDOPT, LOCYLD,   OTHPK,OTHTYP,
+     >                   OTHVAL,   HDET, OTHVAR,   THCK,    HFLX,  HCUR)
+
+      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 (LPRC) THEN
+       WRITE(6,*) "****************************************************"
+       WRITE(6,*) "*                BUILDING PROCEDURE                *"
+       WRITE(6,*) "****************************************************"
+       CALL  D2PPRC(   IPDAT, IPPRC,HEQUI, HMASL, ISOTVAL, ISOTOPT,LMEM,
+     >                IPRINT,MIXDIR,JOBOPT                             )
+      ENDIF
+      IF(IPRINT > 0)  THEN
+       WRITE(6,*) "****************************************************"
+       WRITE(6,*) "*                END OF PHASE 1                    *"
+       WRITE(6,*) "****************************************************"
+      ENDIF
+*----
+*  PHASE 2 : BRANCHING CALCULATION
+*----
+      ELSE IF (PHASE.EQ.2) THEN
+       IF(NENTRY.NE.5) CALL XABORT('@D2PDRV: 5 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(5).GT.2)) THEN
+        WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,19H IS NOT OF XSM TYPE)')
+     >  HENTRY(5)
+        CALL XABORT(HSMG)
+       ELSE IF(JENTRY(5).NE.2) THEN
+        WRITE(HSMG,'(15H@D2PDRV: ENTRY ,A12,24H IS NOT IN READ-ONLY MOD,
+     >  1HE)')
+     >  HENTRY(5)
+        CALL XABORT(HSMG)
+       ENDIF
+       CALL LCMGTC(KENTRY(3),'SIGNATURE',12,HSIGN)
+       IF(HSIGN.NE.'L_INFO') THEN
+        TEXT12=HENTRY(3)
+        CALL XABORT('@D2PDRV: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     1  '. L_INFO EXPECTED.')
+       ENDIF
+       CALL LCMGTC(KENTRY(5),'SIGNATURE',12,SIGNAT)
+       IF((SIGNAT.NE.'L_SAPHYB')) THEN
+        IF(SIGNAT.NE.'L_MULTICOMPO') THEN
+         TEXT12=HENTRY(5)
+         CALL XABORT('@D2PDRV: SIGNATURE OF '//TEXT12//' IS '//SIGNAT//
+     1   '. L_SAPHYB OR L_MULTICOMPO EXPECTED.')
+        ENDIF
+       ENDIF
+      IPHEL=FILUNIT(KENTRY(1))
+      IPINP=FILUNIT(KENTRY(2)) ! input GENPMAXS file unit
+      IPDAT=KENTRY(3) ! input DATA vector address
+      IPMIC=KENTRY(4) ! input Microlib vector address
+      IPSAP=KENTRY(5) ! 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)
+      IF (STAVEC(18).EQ.1) THEN
+       CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
+       CALL LCMGTC(IPDAT,'NAMDIR',12,MIXDIR)
+       CALL LCMSIX(IPDAT,' ',0)
+      ENDIF
+      CALL LCMSIX(IPDAT,'GENPMAXS_INP',1)
+      CALL LCMGTC(IPDAT,'JOB_OPT',4,4,JOB)
+      NGP = STAVEC(1)
+      i=1
+      DO j=1,4
+       DO k=1,4
+        JOBOPT(i)= JOB(j)(k:k)
+        i=i+1
+       ENDDO
+      ENDDO
+      CALL LCMGET(IPDAT,'FLAG',DEB)
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
+      CALL LCMGET(IPDAT,'REWIND',REW)
+      IF ((DEB.LE.0).AND.(REW.EQ.1))THEN
+
+       WRITE(6,*)"*******   CREATION OF HELIOS ANS GENPMAXS FILES *****"
+       CALL      D2PHEL( IPHEL,  IPDAT,  IPMIC ,  IPINP,       STAVEC,
+     >                  JOBOPT, IPRINT                               )
+
+      ENDIF
+
+      CALL D2PXS(IPDAT,IPMIC,IPSAP,STAVEC,SIGNAT,MIXDIR,JOBOPT,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,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
+       CALL LCMSIX(IPDAT,'GENPMAXS_INP',1)
+       CALL LCMGET(IPDAT,'FLAG',DEB)
+      IF (DEB<0) THEN
+       DEB=1
+       WRITE(6,*) "****************************************************"
+       WRITE(6,*) "*            END OF FISSION YIELD BRANCH           *"
+       WRITE(6,*) "****************************************************"
+       CALL LCMPUT(IPDAT,'FLAG',1,1,DEB)
+      ELSE
+      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,DEB,SIGNAT,IPRINT)
+
+      IF(IPRINT > 0)  THEN
+       WRITE(6,*) "****************************************************"
+       WRITE(6,*) "*                END OF PHASE 3                    *"
+       WRITE(6,*) "****************************************************"
+      ENDIF
+      ENDIF
+      ENDIF
+      END
diff --git a/Donjon/src/D2PGEN.f b/Donjon/src/D2PGEN.f
new file mode 100644
index 0000000..635bae9
--- /dev/null
+++ b/Donjon/src/D2PGEN.f
@@ -0,0 +1,404 @@
+*DECK D2PGEN
+      SUBROUTINE D2PGEN( IPINP, IPDAT,   STAVEC, JOBTIT, FILNAM,    DER,
+     >                    VERS,   COM,   JOBOPT,   IUPS,   FA_K,   SFAC,
+     >                    BFAC,   DEB,     XESM,  FC1  ,    FC2,    FC3,
+     >                     FC4,   XSC,   IPRINT                        )
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Create the GENPMAXS input file GENPMAXS.inp at phase 1
+* WARNING: 04/2014: the format of this file respects the GENPMAXS format
+* (it can't be changed)
+* The information is recovered from the input file (.x2m) and stored in
+* the INFO DATA block. The user can change any values in the input file
+*
+*Author(s): 
+* J. Taforeau
+*
+*Parameters: input
+* IPINP   file unit of GENPMAXS.inp file
+* IPDAT   address of info data block
+* VERS    version of PARCS to be used
+* SFAC    the scattering cross section factor
+* BFAC    the multiplier for betas
+* DEB     FLAG to indicate the first call to the D2PGEN subroutine
+* 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
+* STAVEC  various parameters associated with the IPDAT structure
+* FILNAM  name of IPINP
+* JOBTIT  title of in header of PMAXS file
+* COM     comment to be printed in PMAXS file
+* DER     partials derivative (T) or row cross section (F) to be stored
+*         in PMAXS
+* JOBOPT  array of flag to indicate the content option in the HELIOS
+*         like file and PMAXS
+* XESM    option for comparing k-inf in GenPMAX (1: using Pm/Sm data; 
+*         2: using I/Xe data; 3: using I/Xe/Pm/Sm data)
+*
+*Parameters: 
+* FC1     
+* FC2     
+* FC3     
+* FC4     
+* XSC     
+* IPRINT  
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPDAT
+      INTEGER IPINP,STAVEC(40),FA_K,IUPS,DEB,XESM
+      REAL SFAC,BFAC,VERS
+      CHARACTER FILNAM*12,COM*40
+      CHARACTER*16 JOBTIT
+      CHARACTER*1 DER
+      REAL FC1(5)
+      REAL FC2(8)
+      REAL FC3(7)
+      REAL FC4(3)
+      REAL XSC(3)
+
+*----
+*  LOCAL VARIABLES
+*----
+      TYPE(C_PTR) IPTH,KPTH
+      ! INDEX AND FLAG EXISTENCE OF : TEMPERATURE OF FUEL AND MODERATO
+      INTEGER ITCOM, ITMOD,TMOD, TCOM
+      ! NUMBER OF STATES VARIABLES, BURNUP EXEPTED
+      INTEGER  NVAR
+      ! NUMBER OF STATES VARIABLES
+      INTEGER  STVARN
+      ! IF FLAG=1, END OF A BRANCH CALCULATION
+      INTEGER FLAG_PRINT, FLAG
+      ! NUMBER OF BRANCH CONTAINED IN THE FINAL PMAXS FILE
+      INTEGER NBR
+      ! INDEX OF THE CURRENT BRANCH AND NUMBER OF BURNUP POINTS
+      INTEGER BR_IT, NBU
+      INTEGER CRDINF(STAVEC(6)),STAIDX(STAVEC(2))
+      INTEGER IB,PK,GRID,NCRD,NDEL,NLOC,ST
+      ! DATA SOURCE INFORMATION (CF GENPMAXS MANUAL)
+      REAL DATSRC(5),LOCYLD(5),THCK
+      REAL STATE(STAVEC(2)),HISTORY(STAVEC(2)-1), BU(STAVEC(4))
+      CHARACTER(len=12) STATE_VAR(STAVEC(2))
+      CHARACTER(len=4) STAVAR(STAVEC(2))
+      INTEGER PKIDX(STAVEC(2))
+      CHARACTER*1 JOBOPT(16)
+      CHARACTER*4 BR
+      CHARACTER*3 ADF_T
+      CHARACTER*12,DIMENSION(6) :: PKNAM
+      DATA PKNAM/ "BARR","DMOD","CBOR","TCOM","TMOD","BURN"/
+      LOGICAL LFLAG(6)
+      LOGICAL :: LYLD=.FALSE.
+      CHARACTER*3 YLDOPT
+
+      ! INITIALIZATION OF ARRAYS
+      DATSRC(1)= 2.0
+      DATSRC(2)= 1.0
+      DATSRC(3)= FA_K
+      DATSRC(4)= SFAC
+      DATSRC(5)= BFAC
+      NGP=STAVEC(1)
+      NBU=STAVEC(4)
+      STVARN=STAVEC(2)
+      NVAR=STVARN-1
+      NCRD=STAVEC(6)
+      NDEL=STAVEC(7)
+
+      !RECOVER INFORMATION FROM INFO DATA block
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
+      IF (JOBOPT(9).EQ. 'T') LYLD = .TRUE.
+      IF (LYLD) THEN
+      CALL LCMGTC(IPDAT,'YLD_OPT',3,YLDOPT)
+      CALL LCMGET(IPDAT,'YLD_LOC',LOCYLD)
+      ENDIF
+      CALL LCMGTC(IPDAT,'STATE_VAR',12,STVARN,STATE_VAR)
+      CALL LCMGET(IPDAT,'PKIDX',PKIDX)
+
+      DO PK=1, 6
+        IPTH=LCMGID(IPDAT,'PKEY_INFO')
+        KPTH=LCMDIL(IPTH,PK)
+
+        CALL LCMGET(KPTH,'LFLAG',LFLAG(PK))
+        IF (PK == 1 .OR. PK==6)THEN
+         CALL LCMGTC(KPTH,'NAME',12,PKNAM(PK))
+        ELSE
+         IF(LFLAG(PK)) CALL LCMGTC(KPTH,'NAME',12,PKNAM(PK))
+        ENDIF
+      ENDDO
+
+      IF(FA_K==1) THEN
+        GRID=STAVEC(5)
+      ELSE
+        GRID = 2  ! NO XE/SM FOR REFLECTOR CASE
+      ENDIF
+      ITCOM=0
+      ITMOD=0
+      TCOM=0
+      TMOD=0
+
+      DO IST=1, STVARN
+        IF(STATE_VAR(IST)==PKNAM(1)) STAVAR(IST)='CR  '
+        IF(STATE_VAR(IST)==PKNAM(2)) STAVAR(IST)='DC  '
+        IF(STATE_VAR(IST)==PKNAM(3)) STAVAR(IST)='PC  '
+        IF(STATE_VAR(IST)==PKNAM(6)) STAVAR(IST)='BU  '
+        IF(STATE_VAR(IST)==PKNAM(4)) THEN
+          ITCOM=IST
+          TCOM=1
+          STAVAR(IST)='TF  '
+        ENDIF
+        IF(STATE_VAR(IST)==PKNAM(5)) THEN
+          ITMOD=IST
+          TMOD = 1
+          STAVAR(IST)='TC  '
+        ENDIF
+      ENDDO
+
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
+      CALL LCMPTC(IPDAT,'IDEVAR',4,STVARN,STAVAR)
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'GENPMAXS_INP',1)
+
+      IF(DEB.LE.0) THEN
+
+          CALL LCMSIX(IPDAT,' ',0)
+          CALL LCMSIX(IPDAT,'GENPMAXS_INP',1)
+        CALL LCMPUT(IPDAT,'FLAG',1,1,DEB)
+        FLAG=DEB
+        CALL LCMSIX(IPDAT,' ',0)
+        CALL LCMGET(IPDAT,'BARR_INFO',CRDINF)
+        CALL D2PREF( IPDAT, STVARN,   CRDINF,   NCRD,  GRID, PKIDX,
+     1               PKNAM, IPRINT                                )
+        IF (LYLD.and. (YLDOPT.EQ.'MAN')) THEN
+         CALL LCMSIX(IPDAT,' ',0)
+         CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
+         CALL LCMGET(IPDAT,'STATE',STATE)
+         NLOC=0
+         ST=0
+         DO I=1,5
+          IF (LOCYLD(I).NE. -1) THEN
+           NLOC=NLOC+1
+           IF (LFLAG(I)) THEN
+            ST=ST+1
+            STATE(I)=LOCYLD(I)
+            STATE_VAR(I)=PKNAM(I)
+           ELSE IF (I.EQ.1) THEN
+            ST=ST+1
+            STATE_VAR(I)=PKNAM(I)
+           ENDIF
+          ENDIF
+         ENDDO
+         IF ((NLOC.NE.ST).OR.(NLOC.NE.NVAR)) THEN
+          WRITE(6,*) '@D2PGEN : INCORRECT NUMBER OF STATE PARAMETERS',
+     >    ' SET IN "YLD MAN" CARD : ',NLOC
+          CALL XABORT('=> PLEASE FOLLOW THE SAP/MCO OBJECT CONTENT.')
+         ENDIF
+
+         CALL LCMSIX(IPDAT,' ',0)
+         CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
+         CALL LCMPUT(IPDAT,'STATE',STVARN,2,STATE)
+        ENDIF
+
+      ELSE
+        CALL LCMGET(IPDAT,'FLAG',FLAG)
+      ENDIF
+
+      IF(FLAG .LE. 0) THEN
+        !FIRST CALL TO D2PGEN SUBROUTINE
+        CALL LCMSIX(IPDAT,' ',0)
+        CALL LCMSIX(IPDAT,'GENPMAXS_INP',1)
+        ! CHECK THE JOB_OPT VECTOR
+
+        ! LDED : DIRECT ENERGY DEPOSITION FRACTION NOT IMPLEMENTED
+        IF(JOBOPT(3)=='T') JOBOPT(3)='F'
+        ! LJ1F : J1 FACTOR FOR MINIMAL CRITICAL POWER RATIO
+        IF(JOBOPT(6)=='T') JOBOPT(6)='F'
+        ! LCHD : DELAY NEUTRON FISSION SPECTRUM NOT IMPLEMENTED
+        ! IF(JOBOPT(8)=='T') JOBOPT(8)='F'
+        ! LBET : BETA NOT IMPLEMENTED
+        IF((JOBOPT(12)=='T') .and. NDEL > 6) THEN
+          JOBOPT(12)='F'
+          WRITE(6,*) "@D2PGEN: WARNING "
+          WRITE(6,*) "NUMBER OF DELAYED NEUTRON GROUPS > 6 "
+          ! HELIOS FORMAT ACCEPTS ONLY NDEL =6
+          WRITE(6,*) "lbet (JOBOPT(12)) FLAG FORCED TO FALSE "
+        ENDIF
+        ! LDEC : DECAY HEAT DATA NOT IMPLEMENTED
+        IF(JOBOPT(14)=='T') JOBOPT(14)='F'
+        IF((JOBOPT(13)=='T') .and. NDEL > 6) THEN
+          JOBOPT(13)='F'
+          WRITE(6,*) "@D2PGEN: WARNING "
+          WRITE(6,*) "NUMBER OF DELAYED NEUTRON GROUPS > 6 "
+          ! HELIOS FORMAT ACCEPTS ONLY NDEL =6
+          WRITE(6,*) "lamb (JOBOPT(13)) FLAG FORCED TO FALSE "
+        ENDIF
+
+        ! RECOVER INFORMATION FROM GENPMAXS_INP
+        CALL LCMPTC(IPDAT,'JOB_TIT',16,JOBTIT)
+        CALL LCMPTC(IPDAT,'DERIVATIVE',1,DER)
+        CALL LCMPTC(IPDAT,'JOB_OPT',1,16,JOBOPT(:16))
+        CALL LCMPUT(IPDAT,'IUPS',1,1,IUPS)
+        CALL LCMPUT(IPDAT,'XESMOPT',1,1,XESM)
+        CALL LCMPUT(IPDAT,'DAT_SRC',5,2,DATSRC)
+        CALL LCMPTC(IPDAT,'COMMENT',40,COM)
+        CALL LCMPUT(IPDAT,'VERSION',1,2,VERS)
+        CALL LCMPTC(IPDAT,'FILE_NAME',12,FILNAM)
+
+        CALL LCMSIX(IPDAT,' ',0)
+        CALL LCMSIX(IPDAT,'HELIOS_HEAD',1)
+        CALL LCMPUT(IPDAT,'FILE_CONT_1',2,2,FC1(4:5))
+        CALL LCMPUT(IPDAT,'FILE_CONT_2',8,2,FC2)
+        CALL LCMPUT(IPDAT,'FILE_CONT_3',7,2,FC3)
+        CALL LCMPUT(IPDAT,'FILE_CONT_4',3,2,FC4)
+        CALL LCMPUT(IPDAT,'XS_CONT',3,2,XSC)
+        CALL LCMSIX(IPDAT,' ',0)
+        CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
+        ! RECOVER HISTORY STATE AND number of branches
+        CALL LCMGET(IPDAT,'HST_STATE',HISTORY)
+        CALL LCMGET(IPDAT,'BRANCH_NB',NBR)
+
+        ! WRITING JOBTIT CARD
+
+        IF(IPRINT > 2)  THEN
+          WRITE(6,*)
+          WRITE(6,*) "******* INFORMATION FOR GENPMAXS INPUT *********"
+          WRITE(6,*)
+          WRITE(6,*) "JOB_TIT CARD : JOB_TIT,DERIVATIVE,",
+     1    " VERSION, COMMENT"
+          WRITE(6,*) "VALUES    :",JOBTIT,DER, VERS, COM
+          WRITE(6,*)
+          WRITE(6,*) "JOB_OPT CARD : ad,xe,de,j1,ch,Xd,iv,dt,yl,cd,gf,",
+     1    " be,lb,dc,ups"
+          WRITE(6,'(A,14(A,1X))') "VALUES    :",JOBOPT(1:14)
+          WRITE(6,*)
+          WRITE(6,*) "DAT_SRC CARD : SRC_KIND, NFILE, FA_KIND, SFAC,",
+     1    " BFAC"
+          WRITE(6,*) "VALUES    :",INT(DATSRC)
+          WRITE(6,*)
+          WRITE(6,*) "STAVAR CARD :"
+          WRITE(6,*) "NUMBER    :",STVARN
+          WRITE(6,*) "VALUES    :",STAVAR(1:STVARN)
+          WRITE(6,*)
+          WRITE(6,*) "HISTORY CARD (IN GENPMAXS FORMALISM):"
+          WRITE(6,*) "VALUES OF STATES VARIABLES :",HISTORY(1:NVAR)
+          WRITE(6,*)
+          WRITE(6,*) "BRANCH CARD :"
+          WRITE(6,*) "NUMBER OF BRANCHES : ",NBR
+          WRITE(6,*)
+
+        ENDIF
+      ELSE IF(FLAG == 1) THEN
+        CALL LCMSIX(IPDAT,' ',0)
+        CALL LCMGET(IPDAT,'BARR_INFO',CRDINF)
+        CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
+        CALL LCMGET(IPDAT,'STATE',STATE)
+        CALL LCMGET(IPDAT,'STATE_INDEX',STAIDX)
+        CALL LCMGET(IPDAT,'PRINT',FLAG_PRINT)
+        CALL LCMGTC(IPDAT,'BRANCH',4,BR)
+        CALL LCMGET(IPDAT,'BRANCH_IT',BR_IT)
+
+        ! REORG  BARR INFORMATION
+
+        DO IB=1 ,NCRD
+          IF(STATE(1)==CRDINF(IB)) THEN
+           STATE(1)=IB-1
+           EXIT
+          ENDIF
+        ENDDO
+        ! TEMPERATURE CONVERSION
+        IF (STAVEC(19).EQ.0) THEN
+         IF(TCOM==1) STATE(ITCOM)=STATE(ITCOM)+273.15 ! convert C to K
+         IF(TMOD==1) STATE(ITMOD)=STATE(ITMOD)+273.15
+        ENDIF
+        ! CONTINUE WRITING BRANCH CARD
+        IF(FLAG_PRINT==1) THEN
+          WRITE (IPINP,'(A,A,I4.4,3X,3(F11.5,1X,F11.5,1X))')
+     1    'HIST',BR(1:2),BR_IT,(STATE(I), I=1,NVAR)
+        ENDIF
+
+        IF(IPRINT > 2)  THEN
+          WRITE(6,*)
+          WRITE(6,*) "*CONTINUE WRITING BRANCH CARD IN GENPMAXS INPUT*"
+          WRITE(6,*)
+          WRITE(6,*) "BRANCH TYPE          : ",BR
+          WRITE(6,*) "BRANCH INDEX         : ",BR_IT
+          WRITE(6,*) "BRANCH STATE VALUES  : ",STATE(1:NVAR)
+          WRITE(6,*) "BRANCH STATE INDEX   : ",STAIDX(1:NVAR)
+          WRITE(6,*)
+        ENDIF
+      ELSE IF(FLAG == 2) THEN
+        ! RECOVER INFORMATION FROM INFO
+        CALL LCMSIX(IPDAT,' ',0)
+        CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
+
+        CALL LCMGET(IPDAT,'BURN',BU)
+        IF(JOBOPT(1)=='T') THEN
+         CALL LCMGTC(IPDAT,'ADF_TYPE',3,ADF_T)
+         IF (ADF_T.EQ.'GEN') CALL LCMGET(IPDAT,'THCK',THCK)
+        ENDIF
+        CALL LCMSIX(IPDAT,' ',0)
+        CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
+        CALL LCMGET(IPDAT,'BRANCH_NB',NBR)
+
+
+        CALL LCMSIX(IPDAT,' ',0)
+        CALL LCMSIX(IPDAT,'GENPMAXS_INP',1)
+        CALL LCMGTC(IPDAT,'FILE_NAME',12,FILNAM)
+        CALL LCMGET(IPDAT,'DAT_SRC',DATSRC)
+
+
+        ! WRITING BURNUP CARD
+        WRITE (IPINP,'(A)') '%BURNUP'
+        WRITE (IPINP,'(I1,/,A,3X,I2)') 1, 'set1',NBU
+        WRITE (IPINP,'(5(3X,F8.3),/)') (BU(I)/1000, I=1,NBU)
+        WRITE (IPINP,'(A,1X,I4,A,I1)') 'HIST01',NBR,'*',1
+
+        IF ((INT(DATSRC(3)).EQ.0).AND.(JOBOPT(1)=='T')
+     >  .AND.(ADF_T.EQ.'GEN'))THEN
+         WRITE (IPINP,'(A)')'%ADF_1D'
+         WRITE (IPINP,'(A)')'ANM   0   1'
+         WRITE (IPINP,'(F8.5)')THCK
+        ENDIF
+        ! WRITING HEL_FMT CARD
+        WRITE (IPINP,'(A)') '%HEL_FMT'
+        WRITE (IPINP,'(I1,/,I1,1X,I2,1X,I2,1X,I1)') 1,1,24,12,8
+
+        ! WRITING FIL_CNT CARD
+        WRITE (IPINP,'(A)') '%FIL_CNT'
+        WRITE (IPINP,'(I1,3X,A,3X,I4,3X,I1)') 1,FILNAM,NBR,1
+        DO IB=1,NBR
+          WRITE (IPINP,'(I4,1X,I1,1X,I4,1X,I1,1X,I2)') IB,1,IB,1,NBU
+        ENDDO
+
+        ! WRITING JOB_END CARD
+        WRITE (IPINP,'(A)') '%JOB_END'
+
+        IF(IPRINT > 2)  THEN
+          WRITE(6,*)
+          WRITE(6,*) "***** END OF EDITING THE GENPMAXS INPUT ******"
+          WRITE(6,*)
+          WRITE(6,*) "BURNUP CARD : "
+          WRITE(6,*) "VALUES OF BURNUP POINTS :",BU/1000
+          WRITE(6,*)
+          WRITE(6,*) "HEL_FMT CARD : NFMT, Index, LABEL, WIDTH, COLUMN"
+          WRITE(6,*) "VALUES (FIXED)   :",1,4,24,12,8
+          WRITE(6,*)
+          WRITE(6,*) "EDIT FIL_CNT CARD "
+          WRITE(6,*)
+        ENDIF
+      ENDIF
+      CALL LCMSIX(IPDAT,' ',0)
+
+      END
diff --git a/Donjon/src/D2PHEL.f b/Donjon/src/D2PHEL.f
new file mode 100644
index 0000000..3360d32
--- /dev/null
+++ b/Donjon/src/D2PHEL.f
@@ -0,0 +1,363 @@
+      SUBROUTINE D2PHEL ( IPHEL,  IPDAT,  IPMIC ,  IPINP,     STAVEC,
+     >                   JOBOPT, IPRINT                             )
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Store the header of HELIOS.dra file - (independant data compared with
+* branching calculation) at phase 1
+* WARNING: 04/2014 : the format of this file respect the HELIOS format
+* (it cannot be changed)
+* The information is recovered from the input file (.x2m) and stored in
+* the INFO DATA block. The user can change any values in the input file
+*
+*Author(s): 
+* J. Taforeau
+*
+*Parameters: input
+* IPHEL   file unit of HELIOS like file
+* IPDAT   adress of info data block
+* STAVEC  various parameters associated with the IPDAT structure
+* 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
+* IPRINT  control the printing on screen
+*
+*Parameters: 
+* IPMIC   
+* IPINP   
+* JOBOPT  
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPDAT,IPMIC
+      INTEGER IPHEL
+      INTEGER STAVEC(40)
+      ! FILE_CONT DATA BLOC ( CF D2P: DOCUMENTATION)
+      REAL FC1(2)
+      REAL FC2(8)
+      REAL FC3(7)
+      REAL FC4(3)
+      REAL XSC(3)
+      REAL DATSRC(5)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER NBU,FA_K
+      CHARACTER*16 JOBTIT
+      CHARACTER*12 FILNAM
+      CHARACTER*1 DER
+      CHARACTER*40 COM
+      CHARACTER*1 JOBOPT(16)
+      REAL HISTORY(STAVEC(2)-1)
+      CHARACTER*4 STAVAR(STAVEC(2))
+      INTEGER IUPS,XESM
+      REAL VERS
+
+
+      NBU=STAVEC(4)
+      NPAR=STAVEC(2)
+      NVAR=NPAR-1
+
+      ! RECOVER INFORMATION FROM INFO/HELIOS_HEAD DATA BLOCK
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
+
+      CALL LCMGTC(IPDAT,'IDEVAR',4,NPAR,STAVAR)
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'GENPMAXS_INP',1)
+      CALL LCMGET(IPDAT,'DAT_SRC',DATSRC)
+      CALL LCMGTC(IPDAT,'JOB_TIT',16,JOBTIT)
+      CALL LCMGTC(IPDAT,'DERIVATIVE',1,DER)
+      CALL LCMGET(IPDAT,'IUPS',IUPS)
+      CALL LCMGET(IPDAT,'XESMOPT',XESM)
+      CALL LCMGTC(IPDAT,'COMMENT',40,COM)
+      CALL LCMGET(IPDAT,'VERSION',VERS)
+      CALL LCMGTC(IPDAT,'FILE_NAME',12,FILNAM)
+      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,'BRANCH_INFO',1)
+      !RECOVER HISTORY STATE AND number of branches
+      CALL LCMGET(IPDAT,'HST_STATE',HISTORY)
+      CALL LCMGET(IPDAT,'BRANCH_NB',NBR)
+
+      IF (IUPS.EQ.2) IUPS=0
+      FA_K=INT(DATSRC(3))
+      IF ((STAVEC(21).EQ.1) .and. (JOBOPT(1).EQ.'T') )THEN
+       JOBOPT(1)='F'
+      ENDIF
+      IF (STAVEC(19).EQ.0) THEN
+       DO I=1,NVAR
+        IF (STAVAR(I).EQ.'TF  ') THEN
+
+         HISTORY(I)=HISTORY(I)+273.15
+        ENDIF
+        IF (STAVAR(I).EQ.'TC  ') THEN
+         HISTORY(I)=HISTORY(I)+273.15
+        ENDIF
+       ENDDO
+      ENDIF
+
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
+      CALL LCMPUT(IPDAT,'HST_STATE',NVAR,2,HISTORY)
+        ! WRITING JOBTIT CARD
+      WRITE (IPINP,*) '%JOB_TIT'
+      WRITE (IPINP,'(A,A,A,1X,A,1X,F3.1,1X,A,A,A)')
+     1'"',JOBTIT,'"',DER, VERS, '"',COM,'"'
+
+      ! WRITING JOB_OPT CARD
+      WRITE (IPINP,*) '%JOB_OPT'
+      WRITE (IPINP,'(14(A,1X),2(I1,1X))',advance="no")
+     1 JOBOPT(1:14),IUPS,XESM
+      WRITE (IPINP,'(/A)')
+     1'!ad,xe,de,j1,ch,Xd,iv,dt,yl,cd,gf,be,lb,dc,ups'
+
+      ! WRITING DAT_SRC CARD
+      WRITE (IPINP,*) '%DAT_SRC'
+      WRITE(IPINP,'(I2,1X,I2,1X,I2,1X,F3.1,1X,F3.1)')INT(DATSRC(1)),
+     1INT(DATSRC(2)),INT(DATSRC(3)),DATSRC(4),DATSRC(5)
+
+      ! WRITING STA_VAR CARD
+      WRITE (IPINP,*) '%STA_VAR'
+      WRITE (IPINP,'(I2/,3(A,1X,A))') NVAR,(STAVAR(I), I=1,NVAR)
+
+      ! WRITING HISTORY CARD
+      ! CONCERN THE CONTROL ROD COMPOSITION
+      IF(HISTORY(1)==0) THEN
+        HISTORY(1)=1
+      ELSE IF(HISTORY(1)==1) THEN
+        HISTORY(1)=0
+      ELSE IF(HISTORY(1)==2) THEN
+        HISTORY(1)=2
+      ENDIF
+
+      WRITE (IPINP,*) '%HISTORY'
+      WRITE (IPINP,'(I1,1X,I1,/,A,1X,3(F11.5,1X,F11.5,1X))') 1,1,
+     1'HIST01',(HISTORY(I), I=1,NVAR)
+
+      ! WRITING BRANCH CARD
+      WRITE (IPINP,*) '%BRANCH'
+      WRITE (IPINP,'(I4,1X,I1)') NBR, 1
+
+
+      ! WRITE FILE_CONT DATA in HELIOS.dra file
+      IF(IPRINT > 0) WRITE(6,*) "STEP 1 : EDIT THE HEADER "
+      CALL SET_INFO(IPHEL)
+      IF(IPRINT > 0) WRITE(6,*) "STEP 2 : EDIT THE CONT1 BLOCK "
+      IF (FA_K.EQ.0) THEN
+       FC1(1)=0.
+      ELSE
+       IF (FC1(1).EQ.0.) THEN
+
+        CALL LCMSIX(IPMIC,'',0)
+        CALL LCMSIX(IPMIC,'MACROLIB',1)
+        CALL LCMLEN(IPMIC,'MASL',ILONG,ITYLCM)
+        IF (ILONG.GT.1) THEN
+         CALL XABORT("@D2PHEL: MORE THAN 1 METAL DENS. IN THE MICROLIB")
+        ELSE IF (ILONG.EQ.0) THEN
+         WRITE(6,*)"@D2PHEL: RECORD MASL NOT FOUND IN MICROLIB"
+         WRITE(6,*)"=> PLEASE USE THE FILE_CONT_1 CARD IN D2P:"
+         CALL XABORT(" OR USE THE 'REFLECTOR' KEYWORD")
+        ELSE
+         CALL LCMGET(IPMIC,'MASL',FC1(1))
+        ENDIF
+       ELSE  IF (FC1(1).LE.0.) THEN
+        CALL XABORT('@D2PHEL: NEGATIVE VALUE FOR HEAVY METAL DENSITY')
+       ENDIF
+      ENDIF
+      CALL LCMPUT(IPDAT,'FILE_CONT_1',2,2,FC1)
+      CALL SET_CONT1(IPHEL,STAVEC,FC1,IPRINT)
+      ! IF(IPRINT > 0) WRITE(6,*) "STEP 3 : EDIT THE CONT2 BLOCK "
+       ! CALL SET_CONT2(IPHEL,FC2,NGP,IPRINT)
+      IF(IPRINT > 0) WRITE(6,*) "STEP 4 : EDIT THE CONT3 BLOCK "
+      CALL SET_CONT3(IPHEL,FC3,IPRINT)
+      IF(IPRINT > 0) WRITE(6,*) "STEP 5 : EDIT THE CONT4 BLOCK "
+      CALL SET_CONT4(IPHEL,FC4,IPRINT)
+
+      ! MOVE TO GENPMAXS_INP DIRECTORY
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'GENPMAXS_INP',1)
+      IF ((STAVEC(21).EQ.1) .and. (JOBOPT(1).EQ.'F') )THEN
+       JOBOPT(1)='T'
+      ENDIF
+      END
+
+      SUBROUTINE SET_CONT1(IPHEL,STAVEC,FILE_CONT_1,IPRINT)
+      INTEGER STAVEC(40)
+      REAL FILE_CONT_1(2)
+
+      WRITE(IPHEL,*) 'List name       : PMAX_FILE_DATA'
+      WRITE(IPHEL,*) 'Labels Array    : KINF'
+      WRITE(IPHEL,*) 'List Title(s)  1) ==========================='
+      WRITE(IPHEL,*) '               2) %FILE_CONT 1'
+      WRITE(IPHEL,*) '               3) ==========================='
+      WRITE(IPHEL,*) '               4) Meaning : NGROUP, NCOLS, NR'
+     1 //'OWS, PART,'
+      WRITE(IPHEL,*) '                  HM Density, Bypass Density '
+      CALL SET_RIEGO(IPHEL)
+      WRITE(IPHEL,120) 'NGROUP','NCOLS','NROWS','PART',
+     1 'DenHM','DenByp'
+      WRITE(IPHEL,125) 'Label E','.-.-E-.-.','.-.-E-.-.','.-.-E-.-.',
+     1 '.-.-E-.-.','1-.-E-.-.','.-.-E-.-.'
+      WRITE(IPHEL,130) '   1 HST  1 HST :      0',STAVEC(1),
+     1 STAVEC(8),STAVEC(9), STAVEC(10),
+     2 FILE_CONT_1(1),FILE_CONT_1(2)
+      WRITE(IPHEL,'()')
+      IF(IPRINT > 1)  THEN
+        WRITE(6,*)
+        WRITE(6,*) "CONTENT : NGROUP, NCOLS, NROWS, PART,",
+     1  " HM Density, Bypass Density "
+        WRITE(6,*) "VALUES  :",STAVEC(1),STAVEC(8:10),FILE_CONT_1
+        WRITE(6,*)
+      ENDIF
+  120 FORMAT(27X,A,9X,A,9X,A,10X,A,9X,A,8X,A)
+  125 FORMAT(6X,A,12X,A,3X,A,3X,A,3X,A,3X,A,3X,A)
+  130 FORMAT(A,10X,I2,10X,I2,10X,I2,10X,I2,5X,F7.5,5X,F7.5)
+      END
+
+      SUBROUTINE  SET_CONT2(IPHEL,FILE_CONT_2,NGROUP,IPRINT)
+      INTEGER NGROUP
+      CHARACTER*9 LABEL
+      REAL FILE_CONT_2(NGROUP)
+
+      WRITE(IPHEL,*) 'List name       : PMAX_FILE_DATA'
+      WRITE(IPHEL,*) 'Labels Array    : KINF'
+      WRITE(IPHEL,*) 'List Title(s) 1) ==========================='
+      WRITE(IPHEL,*) '              2) %FILE_CONT 2'
+      WRITE(IPHEL,*) '              3) ==========================='
+      WRITE(IPHEL,*) '              4)Meaning : Lower Energy of Neu'
+     1 //'tron Groups'
+      CALL SET_RIEGO(IPHEL)
+
+      IF(NGROUP .EQ. 8) THEN
+        WRITE(IPHEL,220) 'EMIN','EMIN'
+        WRITE(IPHEL,225) 'Label E'
+        DO I=1, NGROUP
+         WRITE(LABEL,'(A,I1,A)')".-.-E-",I,"-."
+         PRINT*,"LABEL",LABEL
+         WRITE(IPHEL,'(A9,5X)',advance='no')LABEL
+        ENDDO
+        WRITE(IPHEL,230) '   1 HST  1 HST :      0',FILE_CONT_2(1),
+     1 FILE_CONT_2(2)
+      ELSE
+        CALL XABORT ("@D2PHEL: NUMBER OF ENERGY GROUPS MUST BE 2")
+      ENDIF
+
+      IF(IPRINT > 1)  THEN
+        WRITE(6,*)
+        WRITE(6,*) "CONTENT : Lower Energy of Neutron Groups"
+        WRITE(6,*) "VALUES  :",FILE_CONT_2 (1:NGROUP)
+        WRITE(6,*)
+      ENDIF
+
+  220 FORMAT(32X,A,10X,A)
+  225 FORMAT(6X,A,17X)
+  230 FORMAT(A,ES12.5E2,ES12.5E2)
+      END
+
+      SUBROUTINE  SET_CONT3(IPHEL,FILE_CONT_3,IPRINT)
+      REAL FILE_CONT_3(7)
+
+      WRITE(IPHEL,'()')
+      WRITE(IPHEL,*) 'List name       : PMAX_FILE_DATA'
+      WRITE(IPHEL,*) 'Labels Array    : KINF'
+      WRITE(IPHEL,*) 'List Title(s)  1) ==========================='
+      WRITE(IPHEL,*) '               2) %FILE_CONT 3'
+      WRITE(IPHEL,*) '               3) ==========================='
+      WRITE(IPHEL,*) '               4)Meaning : Regions Volume'
+
+      CALL SET_RIEGO(IPHEL)
+
+      WRITE(IPHEL,320) 'VCool','VWatR','VModr','VCnRd','VFuel',
+     1 'VClad','VChan'
+      WRITE(IPHEL,310) 'Label E','1-.-E-.-.','.-.-E-.-.','1-.-E-.-.',
+     1 '1-.-E-.-.','1-.-E-.-.','1-.-E-.-.','1-.-E-.-.'
+      WRITE(IPHEL,390) '   1 HST  1 HST :      0',FILE_CONT_3(1),
+     1  FILE_CONT_3(2),FILE_CONT_3(3),FILE_CONT_3(4),FILE_CONT_3(5),
+     2  FILE_CONT_3(6),FILE_CONT_3(7)
+
+
+      IF(IPRINT > 1)  THEN
+        WRITE(6,*)
+        WRITE(6,*) "CONTENT : VCool, VWatR, VModr, VCnRd, VFuel,",
+     1  " VClad, VChan"
+        WRITE(6,*) "VALUES  :",FILE_CONT_3
+        WRITE(6,*)
+      ENDIF
+
+  310 FORMAT(6X,A,12X,A,3X,A,3X,A,3X,A,3X,A,3X,A,3X,A)
+  320 FORMAT(27X,A,2X,A,9X,A,9X,A,9X,A,9X,A,9X,A,9X,A)
+  390 FORMAT(A,ES12.5E2,ES12.5E2,ES12.5E2,ES12.5E2,
+     1 ES12.5E2,ES12.5E2,ES12.5E2,ES12.5E2)
+      END
+
+      SUBROUTINE  SET_CONT4(IPHEL,FILE_CONT_4,IPRINT)
+      REAL FILE_CONT_4(3)
+
+      WRITE(IPHEL,'()')
+      WRITE(IPHEL,*) 'List name       : PMAX_FILE_DATA'
+      WRITE(IPHEL,*) 'Labels Array    : KINF'
+      WRITE(IPHEL,*) 'List Title(s)  1) ==========================='
+      WRITE(IPHEL,*) '               2) %FILE_CONT 4'
+      WRITE(IPHEL,*) '               3) ==========================='
+      WRITE(IPHEL,*) '               4) Cell Pitch and X,Y Pos of F'
+     1 //'irst Cell'
+
+      CALL SET_RIEGO(IPHEL)
+
+      WRITE(IPHEL,320) 'PITCH','XBE','YBE'
+      WRITE(IPHEL,410) 'Label E','.-.-E-.-.','.-.-E-.-.','.-.-E-.-.'
+      WRITE(IPHEL,390) '   1 HST  1 HST :      0',FILE_CONT_4(1),
+     1  FILE_CONT_4(2),FILE_CONT_4(3)
+
+      IF(IPRINT > 1)  THEN
+        WRITE(6,*)
+        WRITE(6,*) "CONTENT : PITCH ,XBE , YBE"
+        WRITE(6,*) "VALUES  :", FILE_CONT_4
+        WRITE(6,*)
+      ENDIF
+
+  320 FORMAT(24X,A,11X,A,11X,A)
+  390 FORMAT(A,ES12.5E2,ES12.5E2,ES12.5E2)
+  410 FORMAT(6X,A,12X,A,5X,A,5X,A)
+      END
+
+      SUBROUTINE SET_INFO(IPHEL)
+      WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>'
+      WRITE(IPHEL,*) 'Pre-processing for PMAXS Generation'
+      DO I=1, 18
+        WRITE(IPHEL,*) '*'
+      ENDDO
+      WRITE(IPHEL,*) '<<< DRAGON >>> Version: 5.0.0 <<< DRAGON >>>'
+      WRITE(IPHEL,*) 'DRAGON CALCULATION BY J.TAFOREAU'
+
+      WRITE(IPHEL,*) 'HELIOS Cases Used:'
+      WRITE(IPHEL,'()')
+      WRITE(IPHEL,*) '        1) IMP-operator name : kkk'
+      WRITE(IPHEL,*) '        DRAGON case       : kkk'
+      WRITE(IPHEL,*) '        Title(s)      1   : kkk'
+      WRITE(IPHEL,'()')
+      END
+
+      SUBROUTINE  SET_RIEGO(IPDRA)
+      WRITE(IPDRA,'()')
+      WRITE(IPDRA,*) '(R) Area/Face names     :   unlabeled'
+      WRITE(IPDRA,*) '(I) Isotope Identifiers :   unlabeled'
+      WRITE(IPDRA,*) '(E) Path (STATE) idents : *            '
+      WRITE(IPDRA,*) '(G) Group name          :   unlabeled'
+      WRITE(IPDRA,*) '(O) Originating Group   :   unlabeled'
+      WRITE(IPDRA,'()')
+      END
diff --git a/Donjon/src/D2PINP.f b/Donjon/src/D2PINP.f
new file mode 100644
index 0000000..2d7e44d
--- /dev/null
+++ b/Donjon/src/D2PINP.f
@@ -0,0 +1,241 @@
+*DECK D2PINP
+      SUBROUTINE  D2PINP( IPSAP, IPDAT , IPRINT, STAVEC, CRDINF,   NCRD,
+     >                     PKEY,   ISOT,   MESH, USRPAR, USRVAL, USRSTA,
+     >                  USRVAPK,    SAP,    MIC, EXC   ,   SCAT, ADF   ,
+     >                      DEB,   FA_K,   LADD,   LNEW,    MIX,    XSC,
+     >                   JOBOPT, SIGNAT, MIXDIR,    CDF,    GFF,   ADFD,
+     >                     CDFD,    YLD, YLDOPT, LOCYLD,  OTHPK, OTHTYP,
+     >                   OTHVAL,   HDET, OTHVAR,   THCK,   HFLX,   HCUR)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* 1) Recover data from saphyb or multicompo object.
+* 2) Build headers of GenPMAXS and Helios like file
+*
+*Copyright:
+* Copyright (C) 2015 IRSN
+*
+*Author(s): 
+* J. Taforeau
+*
+*Parameters: input/output
+* IPSAP   address of saphyb or multicompo object
+* IPDAT   address of data structure INFO
+* 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
+* 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
+* XSC     XS_CONT recovered from D2P: input
+* DEB     FLAG to indicate the first call to the D2PGEN subroutine
+* USRVAPK value of state prameter set by the user and recoverd from
+*         USER ADD option in D2P:
+* ADF     type of ADF to be selected
+* 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:
+* ISOT    name of isotopes in IPSAP for xenon samarium and promethium
+* 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
+* SIGNAT  signature of the object containing cross sections
+* MIXDIR  directory that contains homogeneous mixture information
+* CDF     type of CDF to be selected
+* GFF     type of GFF to be selected
+* ADFD    name of record for 'DRA' type of ADF
+* CDFD    name of record for 'DRA' type of CDF
+* YLD     user defined values for fission yields (1:I, 2:XE, 3:PM)
+* LOCYLD  value for state parameter on which fission yield will be
+*         calculated
+* YLDOPT  option for fission yields calculation (DEF, MAN, FIX)
+* HDET    name of isotope for the detector cross sections
+* THCK    Thickness of reflector
+* HFLX    Name of the record for the flux
+* HCUR    Name of the record for the current
+*
+*Parameters: 
+* OTHPK   
+* OTHTYP  
+* OTHVAL  
+* OTHVAR  
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPSAP,IPDAT
+      INTEGER NCRD,MIX,FA_K,USRSTA
+      INTEGER IPRINT,DEB
+      REAL THCK
+      INTEGER STAVEC(40),CRDINF(20),USRVAL(12)
+      REAL YLD(3),LOCYLD(5)
+      REAL XSC(3)
+      REAL USRVAPK(12,10),OTHVAR(12)
+      CHARACTER JOBOPT(16)
+      CHARACTER*3 ADF,CDF,GFF,YLDOPT
+      CHARACTER*8 ADFD(4),CDFD(8)
+      CHARACTER*5 MESH
+      CHARACTER*8 PKEY(6),HFLX(2),HCUR(2)
+      CHARACTER*12 ISOT(8), SIGNAT,MIXDIR,USRPAR(12)
+      CHARACTER*12 OTHPK(12), OTHTYP(12), OTHVAL(12),HDET
+      LOGICAL SAP, MIC, EXC,SCAT,LADD,LNEW
+*----
+*  LOCAL VARIABLES
+*----
+      LOGICAL :: LADF=.FALSE.
+      LOGICAL :: LCDF=.FALSE.
+      LOGICAL :: LGFF=.FALSE.
+      LOGICAL :: LYLD=.FALSE.
+      INTEGER NADF,NCDF
+
+      IF (JOBOPT(1)=='T') THEN
+        NADF=STAVEC(13)
+        IF (NADF.NE.XSC(1)) THEN
+         WRITE(6,*)'@D2PINP: INCOHERENT NUMBER OF ADF (',NADF,
+     >   ')','AND NUMBER OF SIDES IN ASSEMBLY (',XSC(1),').'
+         CALL XABORT ("=> CHECK CARD 'ADF' AND 'XS_CONT'")
+        ENDIF
+        IF ((SIGNAT.EQ.'L_SAPHYB').and.(ADF.EQ.'DRA')) THEN
+          WRITE(6,*) "@D2PINP: ADF OF TYPE (",ADF,
+     1     ") NOT YET IMPLEMENTED WITH SAPHYB OBJECT"
+          WRITE(6,*)"=> WARNING :  ADF CALUCLATION IGNORED"
+          LADF = .FALSE.
+          JOBOPT(1)='F'
+        ELSE IF ((SIGNAT.EQ.'L_MULTICOMPO').and.
+     >     ((ADF.EQ.'SEL').OR.(ADF.EQ.'SEL'))) THEN
+          WRITE(6,*) "@D2PINP: ADF OF TYPE (",ADF,
+     1     " NOT YET IMPLEMENTED WITH MULTICOMPO OBJECT"
+          WRITE(6,*)"=> WARNING :  ADF CALUCLATION IGNORED"
+          LADF = .FALSE.
+          JOBOPT(1)='F'
+        ELSE
+          LADF = .TRUE.
+        ENDIF
+      ELSE
+        LADF = .FALSE.
+      ENDIF
+      IF (JOBOPT(10)=='T') THEN
+        NCDF=STAVEC(15)
+        IF (NCDF.NE.XSC(2)) THEN
+         WRITE(6,*)'@D2PINP: INCOHERENT NUMBER OF CDF (',NCDF,
+     >   ')','AND NUMBER OF CORNERS IN ASSEMBLY (',XSC(2),').'
+         CALL XABORT ("=> CHECK CARD 'CDF' AND 'XS_CONT'")
+        ENDIF
+        IF (SIGNAT.EQ.'L_SAPHYB') THEN
+          WRITE(6,*) "@D2PINP: CDF CALCULATION",
+     1     " NOT YET IMPLEMENTED WITH SAPHYB OBJECT"
+          WRITE(6,*)"=> WARNING :  CDF CALUCLATION IGNORED"
+          LCDF = .FALSE.
+          JOBOPT(10)='F'
+        ENDIF
+        IF (CDF.NE. 'DRA') THEN
+         CALL XABORT ("@D2PINP UNKNOW CDF TYPE : "//CDF//'.')
+        ENDIF
+        LCDF = .TRUE.
+      ELSE
+        LCDF = .FALSE.
+      ENDIF
+      IF (JOBOPT(11)=='T') THEN
+        IF (SIGNAT.EQ.'L_SAPHYB') THEN
+          WRITE(6,*) "@D2PINP: GFF CALCULATION",
+     1     " NOT YET IMPLEMENTED WITH SAPHYB OBJECT"
+          WRITE(6,*)"=> WARNING :  GFF CALUCLATION IGNORED"
+          LGFF = .FALSE.
+          JOBOPT(11)='F'
+        ENDIF
+        IF (GFF.NE. 'DRA') THEN
+         CALL XABORT ("@D2PINP UNKNOW GFF TYPE : '"//GFF//"'.")
+        ENDIF
+        LGFF = .TRUE.
+      ELSE
+        LGFF = .FALSE.
+      ENDIF
+
+      IF (JOBOPT(9)=='T') LYLD = .TRUE.
+      IF ((JOBOPT(2)=='T').and.(JOBOPT(9)=='F')) THEN
+          WRITE(6,*) "@D2PINP: JOB_OPT : XE/SM ARE REQUESTED (lxes=T) ",
+     1     "BUT FISSION YIELDS ARE NOT RECOVERED (lyld=F) "
+         WRITE(6,*) "=> THE lyld FLAG IS FORCED TO TRUE"
+         JOBOPT(9)='T'
+         LYLD = .TRUE.
+      ENDIF
+
+      IF((FA_K.EQ.1).OR.(FA_K.EQ.0)) THEN
+*       CASE FOR FUEL PMAXS
+        IF (SIGNAT.EQ.'L_SAPHYB') THEN
+        STAVEC(18)=0
+        WRITE(6,*) "*******    EXTRACTION OF DATA FROM SAPHYB      ****"
+        CALL    D2PSAP (  IPSAP,  IPDAT, STAVEC, CRDINF,   NCRD,   PKEY,
+     >                    ISOT ,   MESH, USRPAR, USRVAL, USRSTA,USRVAPK,
+     >                    SAP  ,    MIC,    EXC,   SCAT,    ADF,   LADD,
+     >                    LNEW ,   LADF, IPRINT,   LYLD,    YLD, YLDOPT,
+     >                    LOCYLD,  HDET                                )
+
+        ELSE  IF (SIGNAT.EQ.'L_MULTICOMPO') THEN
+        STAVEC(18)=1
+        WRITE(6,*) "*******    EXTRACTION OF DATA FROM MULTICOMPO  ****"
+        WRITE(6,*)
+        WRITE(6,*) "DIRECTORY:'",MIXDIR,"' AT MIXUTRE INDEX ",MIX,"."
+        WRITE(6,*) "=> WARNING: CHECK EXISTENCE OF ",MIXDIR,"DIRECTORY."
+        CALL LCMLIB(IPSAP)
+         IF (LADF) THEN
+          WRITE(6,*) "ADF CALCULATION REQUESTED:"
+          WRITE(6,*)"=> WARNING: CHECK EXISTENCE OF ADF RECORDS"
+         ENDIF
+         IF (LCDF) THEN
+          WRITE(6,*) "CDF CALCULATION REQUESTED:"
+          WRITE(6,*)"=> WARNING: CHECK EXISTENCE OF '",CDFD(1:NCDF),
+     >     "' RECORDS"
+         ENDIF
+
+        CALL  D2PMCO   (  IPSAP,  IPDAT, STAVEC, CRDINF,   NCRD,   PKEY,
+     >                    ISOT ,   MESH, USRPAR, USRVAL, USRSTA,USRVAPK,
+     >                    SAP  ,    MIC,    EXC,   SCAT,    ADF,   LADD,
+     >                    LNEW ,   LADF, IPRINT, MIXDIR,    MIX,   LCDF,
+     >                    LGFF ,    CDF,    GFF,   ADFD,   CDFD,  LYLD ,
+     >                      YLD, YLDOPT, LOCYLD,  OTHPK, OTHTYP, OTHVAL,
+     >                   OTHVAR,   THCK,   HFLX,   HCUR                )
+        ELSE
+         CALL XABORT ('@D2PINP: UNKNOWN SIGNATURE')
+        ENDIF
+      ELSE
+        CALL XABORT('@D2PINP: PHASE 1: FUEL OR REFLECTOR CARD EXPECTED')
+      ENDIF
+
+      IF (YLDOPT.EQ.'MAN') THEN
+       DEB = -1
+      ELSE
+       DEB = 0
+      ENDIF
+
+      IF (STAVEC(19).EQ.1) THEN
+       WRITE(6,*)"=> WARNING: THE TEMPERATURE ARE INDIACTED IN K"
+      ENDIF
+
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMPUT(IPDAT,'STATE-VECTOR',40,1,STAVEC)
+
+      END
diff --git a/Donjon/src/D2PMAC.f b/Donjon/src/D2PMAC.f
new file mode 100644
index 0000000..d08bb63
--- /dev/null
+++ b/Donjon/src/D2PMAC.f
@@ -0,0 +1,367 @@
+*DECK D2PMAC
+      SUBROUTINE D2PMAC(  IPDAT, IPMIC , IPRINT,    NBU,   NGP,   NBMIX,
+     >                     NADD,   NANI,  NVAR,  STAIDX,  LADF,    NADF,
+     >                     NTYPE,  LCDF,  NCDF,    LGFF,  NGFF,    NPIN,
+     >                      FLUX                                       )
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover macroscopic cross sections from a microlib object and write
+* cross sections for one branch at a fixed burnup point in the INFO
+* data block.
+*
+*Author(s): 
+* J. Taforeau
+*
+*Parameters: input
+* IPDAT   address of info data block
+* IPMIC   address of the microlib object
+* IPRINT
+* NBU     number of burnup points
+* NBMIX   number of mixturess
+* NBISO   number of isotopes
+* NGP     number of energy groups
+* NADD    number of additional cross sections
+* NDEL    number of delayed neutron groups
+* NANI    number of anisotropy
+* NVAR    number of state variables
+* STAIDX  table of states index order
+* LADF    flag for assembly discontinuity factor
+* NADF    number of assembly discontinuity factor per energy groups
+* NTYPE   number of type of assembly discontinuity factor
+* LCDF    flag for corner discontinuity factor
+* NCDF    number of corner discontinuity factor per energy groups
+* LGFF    flag for group form factor
+* NGFF    number of group form factor per energy groups
+* NPIN    number of pin on each side of the assembly
+*         (note: if NADF, NCDF, NGFF or NPIN are not defined
+*           a fake value of 1 is assigned for allocation memory issue)
+*
+*Parameters: 
+* FLUX
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPDAT,IPMIC
+      INTEGER STAIDX(NVAR)
+      INTEGER NBU,NADD,NVAR,NBMIX,NGP,NANI,NADF,NCDF,NGFF,NPIN
+      LOGICAL LADF,LCDF,LGFF
+      REAL FLUX (NGP)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER   NSTATE
+      PARAMETER (NSTATE=40)
+      TYPE(C_PTR) JPMIC,KPMIC,IPTH,KPTH
+      INTEGER NSCAT,ITYLCM,ILONG,IUPS
+      INTEGER IJJ(NBMIX),NJJ(NBMIX),IPOS(NBMIX)
+      REAL GAR2(NGP,NGP,NBMIX,NANI),GAR3(NBMIX*NGP)
+      REAL XSECT(NGP)                ! TOTAL CROSS SECTIONS
+      REAL KAPPA_FI(NGP)             ! KAPPA FISSION CROSS SECTIONS
+      REAL X_NU_FI(NGP)              ! NU SIGMA FISSION CROSS SECTIONS
+      REAL XTR(NGP)                  ! TRANSPORT CROSS SECTIONS
+      REAL DIFF(NGP)                 ! DIFFUSION COEFF
+      REAL SCAT(NGP)                 ! SCATTERING CROSS SECTIONS
+      !REAL TRANC(NGP)                ! TRANSPORT CORRECTION
+      REAL ABSORPTION(NGP)           ! ABSORPTION CROSS SECTIONS
+      REAL SCAT_MAT(NGP*NGP)         ! SCATTERING MATRIX
+      REAL SCAT_TMP(NGP,NGP,NBMIX,NANI)  ! TEMPORARY SCATTERING MATRIX
+      REAL SIGW00(NGP)
+      DOUBLE PRECISION SUMSCAT(NGP)
+      ! AVERAGE HOMOGENE SURFACIC FLUX (FLUX-INTG/VOLUME) and
+      ! HETEROGENE
+      REAL FLXHOM(NGP),FLXHET(NGP)
+      REAL VOLUME
+      CHARACTER(len=8) ADDXSNAM(NADD)
+      CHARACTER*8 :: HFLX(8) = 'NUL'
+      CHARACTER*8 :: HCUR(8) = 'NUL'
+      CHARACTER CM*2,ADF_T*3,CDF_T*3,GFF_T*3
+      CHARACTER(LEN=8) ADFD(NADF),CDFD(NCDF)
+      CHARACTER(LEN=8) HADF(NTYPE)   ! ADF NAME IN MACROLIB
+      REAL ADF(NADF,NGP)             ! ASSEMBLY AND CORNER DF
+                                     ! NADF=1 for DRA,  NTYPE=1 for SEL
+                                     ! and GET
+      REAL CDF(NCDF,NGP)             ! ASSEMBLY AND CORNER DF
+      REAL GFFC(NGFF,NGP)            ! GROUP FORM FACTORS GFF by mixture
+      REAL KFC(NGFF,NGP)             !   h-factor
+!      REAL VOLG(NGFF)                !   volume of GROUP FORM FACTORS
+      REAL GFF(NPIN,NPIN,NGP)        ! GFF pin by pin
+            ! GFF geometry
+      INTEGER MIXG(NPIN,NPIN)        ! mixture
+
+      CALL LCMSIX(IPMIC,' ',0)
+      CALL LCMSIX(IPMIC,'MACROLIB',1)
+      CALL LCMGET(IPMIC,'VOLUME',VOLUME)
+      IF(NADD.GT.0)CALL LCMGTC(IPMIC,'ADDXSNAME-P0',8,NADD,ADDXSNAM)
+      IF(NBMIX.NE.1) THEN
+         ! SAPHYB MUST CONTAIN ONLY ONE MIXTURES
+         CALL XABORT('D2PMAC: MORE THAN ONE MIXTURE IN SAPHYB')
+      ENDIF
+      JPMIC=LCMGID(IPMIC,'GROUP')
+      SUMSCAT=0.0D0
+      SCAT_TMP(:NGP,:NGP,:NBMIX,:NANI)=0.0
+      ! LOOP OVER ENERGY GROUPS
+      DO IGR=1,NGP
+        KPMIC=LCMGIL(JPMIC,IGR)
+        CALL LCMLEN(KPMIC,'NTOT0',ILONG,ITYLCM)
+        IF(ILONG.NE.NBMIX) THEN
+          CALL XABORT('@D2PMAC: MORE THAN ONE MIXTURE IN SAP/MCO')
+        ENDIF
+        ! RECOVER CROSS SECTIONS INFORMATION
+        CALL LCMGET(KPMIC,'NTOT0',XSECT(IGR))
+        CALL LCMGET(KPMIC,'SIGS00',SCAT(IGR))
+        CALL LCMGET(KPMIC,'SIGW00',SIGW00(IGR))
+       ! CALL LCMGET(KPMIC,'TRANC',TRANC(IGR))
+        CALL LCMGET(KPMIC,'NUSIGF',X_NU_FI(IGR))
+
+        CALL LCMGET(KPMIC,'H-FACTOR',KAPPA_FI(IGR))
+        CALL LCMLEN(KPMIC,'DIFF',ILONG,ITYLCM)
+        IF (ILONG>0) THEN
+         PRINT*,'ILONG DIFF ',ILONG
+         CALL LCMGET(KPMIC,'DIFF',DIFF(IGR))
+         XTR(IGR)=1/(3*DIFF(IGR))
+        ELSE
+         DIFF(:)=0
+         CALL LCMLEN(KPMIC,'NTOT1',ILONG,ITYLCM)
+         IF (ILONG.EQ.NGP) THEN
+          CALL LCMGET(KPMIC,'NTOT1',XTR(IGR))
+          WRITE(6,*) "WARNING : NTOT1 RECOVERED AS TRANSPORT
+     > CROSS SECTION (SUITABLE FOR SPn WITH NG>=2)"
+         ELSE
+          CALL LCMGET(KPMIC,'NTOT0',XTR(IGR))
+          WRITE(6,*) "WARNING : NTOT0 RECOVERED AS TRANSPORT
+     > CROSS SECTION (SUITABLE FOR SPn WITH NG>2)"
+         ENDIF
+        ENDIF
+
+        CALL LCMGET(KPMIC,'FLUX-INTG',FLXHOM(IGR))
+
+        ! INITIALIZATION OF GAR2 VECTOR
+        GAR2(:NGP,:NGP,:NBMIX,:NANI)=0.0
+
+        ! LOOP OVER ANISOTROPY COMPONENT
+        DO IL=1,NANI
+          WRITE(CM,'(I2.2)') IL-1
+          LENGTH=1
+          IF(IL.GT.1) CALL LCMLEN(KPMIC,'SCAT'//CM,LENGTH,ITYLCM)
+          IF(LENGTH.GT.0) THEN
+           CALL LCMGET(KPMIC,'SCAT'//CM,GAR3)
+           CALL LCMGET(KPMIC,'NJJS'//CM,NJJ)
+           CALL LCMGET(KPMIC,'IJJS'//CM,IJJ)
+           CALL LCMGET(KPMIC,'IPOS'//CM,IPOS)
+            ! LOOP OVER MIXTRURE
+            DO IMIL=1,NBMIX
+             IPOSDE=IPOS(IMIL)
+             ! LOOP OVER ENERGY GROUPS
+             DO JGR=IJJ(IMIL),IJJ(IMIL)-NJJ(IMIL)+1,-1
+              GAR2(IGR,JGR,IMIL,IL)=GAR3(IPOSDE) ! IGR <-- JGR
+
+              ! ELEMENTS OF THE SCATTERING MATRIX
+              SCAT_TMP(IGR,JGR,IMIL,IL)=GAR2(IGR,JGR,IMIL,IL)
+              IPOSDE=IPOSDE+1
+             ENDDO
+            ENDDO
+          ENDIF
+        ENDDO
+      ENDDO
+
+
+      ! STORE THE SCATTERING MATRIX CORRESPONDING TO L=0 AND MIX=1
+      ! IN SCAT_MAT
+      NSCAT=1
+      DO J=1, NGP
+         DO I=1, NGP
+
+          SCAT_MAT(NSCAT)=SCAT_TMP(J,I,1,1) ! I <-- J 1<-1 2<-1
+
+          IF (SCAT_MAT(NSCAT)<0) THEN
+           SUMSCAT(J)=SUMSCAT(J)+SCAT_MAT(NSCAT)
+           SCAT_MAT(NSCAT)=0
+           WRITE(6,*) "WARNING : NEGATIVE VALUES FOR SCATTERING MATRIX
+     >     ELEMENT (",J,"->",I,")."
+          ENDIF
+          NSCAT=NSCAT+1
+         ENDDO
+         XTR(J)=XTR(J)+REAL(SUMSCAT(J))
+         SUMSCAT=0.0D0
+
+      ENDDO
+
+      DO I=1, NGP
+       ABSORPTION(I)=XSECT(I)-SCAT(I)
+      ENDDO
+
+      ! STORE CROSS SECTIONS IN INFO/CROSS_SECT/MACROLIB_XS
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'GENPMAXS_INP',1)
+      CALL LCMGET(IPDAT,'IUPS',IUPS)
+      IF ((IUPS.EQ.2).AND.(NGP.EQ.2)) THEN
+       SCAT_MAT(2)=SCAT_MAT(2)-FLXHOM(2)/FLXHOM(1)*SCAT_MAT(3)
+       SCAT_MAT(3)=0.
+      ENDIF
+
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
+
+      IF(STAIDX(NVAR)==1) THEN
+        IPTH=LCMLID(IPDAT,'CROSS_SECT',NBU)
+      ELSE
+        IPTH=LCMGID(IPDAT,'CROSS_SECT')
+      ENDIF
+
+      KPTH=LCMDIL(IPTH,STAIDX(NVAR))
+
+      CALL LCMSIX(KPTH,'MACROLIB_XS',1)
+      CALL LCMPUT(KPTH,'XTR',NGP,2,XTR)
+      CALL LCMPUT(KPTH,'ABSORPTION',NGP,2,ABSORPTION)
+      CALL LCMPUT(KPTH,'X_NU_FI',NGP,2,X_NU_FI)
+      CALL LCMPUT(KPTH,'KAPPA_FI',NGP,2,KAPPA_FI)
+      CALL LCMPUT(KPTH,'SCAT',NGP*NGP,2,SCAT_MAT)
+
+      ! RECOVER THE ASSEMBLY DISCONTINUITY FACTOR IF ADF DRA IS SET
+      ! BY THE USER
+      IF((LADF).OR.(LCDF)) THEN
+        FLXHOM(:)=FLXHOM(:) / VOLUME
+        CALL LCMSIX (IPDAT,' ',0)
+        CALL LCMSIX (IPDAT,'SAPHYB_INFO',1)
+        ADF_T="   "
+        IF(LADF) THEN
+          CALL LCMGTC(IPDAT,'ADF_TYPE',3,ADF_T)
+          IF (ADF_T.EQ.'DRA') THEN
+           CALL LCMGTC(IPDAT,'HADF',8*NADF,1,ADFD)
+          ELSE IF (ADF_T.EQ.'GEN') THEN
+           CALL LCMLEN(IPDAT,'HFLX',NFLX,ITYLCM)
+           CALL LCMGTC(IPDAT,'HFLX',8*NFLX,1,HFLX(1:NFLX))
+           CALL LCMGTC(IPDAT,'HCUR',8*NFLX,1,HCUR(1:NFLX))
+          ENDIF
+        ENDIF
+        CDF_T="   "
+        IF(LCDF) THEN
+          CALL LCMGTC(IPDAT,'CDF_TYPE',3,CDF_T)
+          CALL LCMGTC(IPDAT,'HCDF',8*NCDF,1,CDFD)
+        ENDIF
+        IF((ADF_T(:3) .EQ. 'DRA').OR.(CDF_T(:3) .EQ. 'DRA')
+     >         .OR.(ADF_T(:3) .EQ. 'GEN' ) )THEN
+           ! NADF = 1 or 4, NCDF = 1 or 4
+          CALL LCMSIX(IPMIC,' ',0)
+          CALL LCMSIX(IPMIC,'MACROLIB',1)
+          CALL LCMSIX(IPMIC,'ADF',1)
+          CALL LCMGTC(IPMIC,'HADF',8,NTYPE,HADF)
+          DO ITYPE=1,NTYPE
+            CALL LCMGET(IPMIC,HADF(ITYPE),FLXHET)
+            IF(LADF) THEN
+             IF (ADF_T(:3) .EQ. 'DRA') THEN
+              DO I=1,NADF
+              IF(HADF(ITYPE).EQ.ADFD(I))THEN
+                DO IGR=1, NGP
+                  ADF(I,IGR)= FLXHET(IGR)/FLXHOM(IGR)
+                ENDDO
+              ENDIF
+              ENDDO
+             ELSE IF ((ADF_T(:3) .EQ. 'GEN')) THEN
+              IF(HADF(ITYPE).EQ.HFLX(1))THEN
+               CALL LCMPUT(KPTH,'FLXL',NGP,2,FLXHET)
+              ENDIF
+              IF(HADF(ITYPE).EQ.HFLX(2))THEN
+               CALL LCMPUT(KPTH,'FLXR',NGP,2,FLXHET)
+              ENDIF
+              IF (HADF(ITYPE).EQ.HCUR(1))THEN
+               CALL LCMPUT(KPTH,'CURL',NGP,2,FLXHET)
+              ENDIF
+              IF (HADF(ITYPE).EQ.HCUR(2))THEN
+               CALL LCMPUT(KPTH,'CURR',NGP,2,FLXHET)
+              ENDIF
+             ENDIF
+            ENDIF
+            IF(LCDF) THEN
+              DO I=1,NCDF
+              IF(HADF(ITYPE).EQ.CDFD(I))THEN
+                DO IGR=1, NGP
+                  CDF(I,IGR)= FLXHET(IGR)/FLXHOM(IGR)
+                ENDDO
+              ENDIF
+              ENDDO
+            ENDIF
+          ENDDO
+          IF(LADF) CALL LCMPUT(KPTH,'ADF',NADF*NGP,2,ADF)
+          IF(LCDF) CALL LCMPUT(KPTH,'CDF',NCDF*NGP,2,CDF)
+          IF(IPRINT>1) THEN
+            WRITE(6,*)
+            IF(LADF) WRITE(6,*)"ADF :",ADF
+            IF(LCDF) WRITE(6,*)"CDF :",CDF
+          ENDIF
+        ENDIF
+        FLXHOM(:)=FLXHOM(:) * VOLUME
+      ENDIF
+      IF(LGFF) THEN
+        FLXHOM(:)=FLXHOM(:) / VOLUME
+        CALL LCMSIX (IPDAT,' ',0)
+        CALL LCMSIX (IPDAT,'SAPHYB_INFO',1)
+        CALL LCMGTC(IPDAT,'GFF_TYPE',3,GFF_T)
+
+
+        IF(GFF_T .EQ. 'DRA') THEN
+          CALL LCMSIX(IPMIC,' ',0)
+          CALL LCMSIX(IPMIC,'MACROLIB',1)
+          CALL LCMSIX(IPMIC,'GFF',1)
+          CALL LCMSIX(IPMIC,'GFF-GEOM',1)
+          CALL LCMGET(IPMIC,'MIX',MIXG)
+          CALL LCMSIX(IPMIC,'GFF-GEOM',2)
+          CALL LCMLEN(IPMIC,'NWT0',ILONG,ITYLCM)
+          IF (ILONG .NE. NGP*NGFF) THEN
+           CALL XABORT("@D2PMAC : ERROR IN NUMBER OF GFF IN MCO")
+          ENDIF
+          CALL LCMGET(IPMIC,'NWT0',GFFC)
+!          CALL LCMGET(IPMIC,'VOLUME',VOLG)
+          CALL LCMGET(IPMIC,'H-FACTOR',KFC)
+          DO J=1,NPIN
+            DO I=1,NPIN
+              DO IG=1,NGP
+                GFF(I,J,IG)=GFFC(MIXG(I,J),IG)*KFC(MIXG(I,J),IG)
+     >                      /FLXHOM(IG)/KAPPA_FI(IG)
+              ENDDO
+            ENDDO
+          ENDDO
+
+          IF(IPRINT>1) THEN
+            WRITE(6,*)
+            WRITE(6,*)"GFF                     :"
+            DO IG=1,NGP
+              WRITE(6,*)"Group                     :",IG
+              DO J=1,NPIN
+                WRITE(6,*)GFF(:,J,IG)
+              ENDDO
+            ENDDO
+          ENDIF
+          CALL LCMPUT(KPTH,'GFF',NPIN*NPIN*NGP,2,GFF)
+        ENDIF
+        FLXHOM(:)=FLXHOM(:) * VOLUME
+      ENDIF
+
+      FLUX(:)=FLXHOM(:)
+      CALL LCMSIX(KPTH,' ',0)
+      CALL LCMSIX(IPDAT,' ',0)
+
+      IF(IPRINT>1) THEN
+       WRITE(6,'(A)',advance="no")  "Energy group     :"
+       DO I=1,NGP
+        WRITE(6,'(5X,I12)',advance="no") I
+       ENDDO
+       WRITE(6,*)
+       WRITE(6,'(A,8(5X,ES12.5E2))') "SIGWOO           :",SIGW00
+       WRITE(6,'(A,8(5X,ES12.5E2))') "SIGSOO           :",SCAT
+       WRITE(6,'(A,8(5X,ES12.5E2))') "TOTALE           :",XSECT
+       WRITE(6,'(A,8(5X,ES12.5E2))') "DIFF             :",DIFF
+       WRITE(6,'(A,8(5X,ES12.5E2))') "TRANSPORT        :",XTR
+       WRITE(6,'(A,8(5X,ES12.5E2))') "ABSORPTION       :",ABSORPTION
+       WRITE(6,'(A,8(5X,ES12.5E2))') "NU FISSION       :",X_NU_FI
+       WRITE(6,'(A,8(5X,ES12.5E2))') "KAPPA FISSION    :",KAPPA_FI
+       WRITE(6,'(A,8(5X,ES12.5E2))') "SCATTERING g->g' :"
+       WRITE(6,'(8(5X,ES12.5E2))')SCAT_MAT
+      ENDIF
+      END
diff --git a/Donjon/src/D2PMCO.f b/Donjon/src/D2PMCO.f
new file mode 100644
index 0000000..ed36b3f
--- /dev/null
+++ b/Donjon/src/D2PMCO.f
@@ -0,0 +1,816 @@
+*DECK D2PMCO
+      SUBROUTINE D2PMCO(  IPSAP,  IPDAT, STAVEC, CRDINF,   NCRD,  PKNAM,
+     >                    ISOT ,   MESH, USRPAR, USRVAL, USRSTA,USRVAPK,
+     >                    SAP  ,    MIC,    EXC,   SCAT,    ADF,  LADD ,
+     >                    LNEW ,   LADF, IPRINT, MIXDIR,    MIX,   LCDF,
+     >                    LGFF ,    CDF,    GFF,   ADFD,   CDFD,   LYLD,
+     >                      YLD, YLDOPT, LOCYLD,  OTHPK, OTHTYP, OTHVAL,
+     >                   OTHREA,   THCK,   HFLX,   HCUR                )
+*-----------------------------------------------------------------------
+*
+*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
+* MIXDIR  directory that contains homogeneous mixture information
+* MIX     Index of mixture that contains homogeneous cross sections
+* LCDF    Corner Discontinuity Factors must be recovered
+* LGFF    Group Form Factors must be recovered
+* CDF     type of CDF to be selected
+* GFF     type of GFF to be selected
+* ADFD    name of record for 'DRA' type of ADF
+* CDFD    name of record for 'DRA' type of CDF
+* LYLD    Fission Yield must be recovered
+* YLD     user defined values for fission yields (1:I, 2:XE, 3:PM)
+* LOCYLD  value for state parameter on which fission yield will be
+*         calculated
+* YLDOPT  option for fission yields calculation (DEF, MAN, FIX)
+* OTHREA  real (or integer) value for OTHER parameter
+* LMER    ADF are merged in the cross sections
+* THCK    Thickness of reflector
+* HFLX    Name of the record for the flux
+* HCUR    Name of the record for the current
+*
+*Parameters: 
+* OTHPK   
+* OTHTYP  
+* OTHVAL  
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPSAP,IPDAT
+      INTEGER NCRD,USRSTA,MIX
+      INTEGER IPRINT
+      REAL THCK
+      INTEGER STAVEC(40),CRDINF(20),USRVAL(12),OTHTYP(12)
+      REAL USRVAPK(12,10),YLD(3),LOCYLD(5),OTHREA(12)
+      CHARACTER*3 ADF,CDF,GFF,YLDOPT
+      CHARACTER*8 ADFD(4),CDFD(8),HFLX(2),HCUR(2)
+      CHARACTER*12 USRPAR(12),OTHVALC
+      CHARACTER*5 MESH
+      CHARACTER*12 PKNAM(6),OTHPK(12), OTHVAL(12)
+      CHARACTER*12 ISOT(8), MIXDIR
+      LOGICAL SAP, MIC, EXC,SCAT,LADD,LNEW,LADF,LCDF,LGFF,LYLD
+*----
+*  LOCAL VARIABLES
+*----
+      TYPE(C_PTR)  IPROOT,IPDIR,IPTH,KPTH,IPMCO,JPMCO
+
+      PARAMETER(NSTATE=40)
+      INTEGER :: N_XS = 8
+      INTEGER :: NTOT = 0
+      INTEGER,DIMENSION(6)  :: ORDER_VAL = 0
+      INTEGER DIMMCO(NSTATE),DIMCAL(NSTATE),DIMGEO(NSTATE)
+      INTEGER NPAR,NCALS,NSVAR,NOTH
+      INTEGER NCRD_SAP,NVALTMP(10)
+      INTEGER RKOTH(STAVEC(20))
+      INTEGER :: NOTHTH = 0
+      REAL OTHR(20,20)
+      REAL :: OTHVAR(20) = -1
+      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.
+      LOGICAL :: LOTH(12) =.FALSE.
+      CHARACTER(LEN=12)   PKEY_BARR(6), OTHC(20,20)
+      CHARACTER(LEN=12)   :: OTHVAC(20) = 'NULL        '
+      CHARACTER*12,DIMENSION(6) :: PKREF
+      DATA PKREF/ "BARR","DMOD","CBOR","TCOM","TMOD","BURN"/
+
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: NVAL, RANK,RANK_INDEX,PKIDX
+      CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: PKEY,PKEY_TMP
+      CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: PVALDIR
+      CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: PARFMT
+!      REAL, ALLOCATABLE, DIMENSION(:) :: SV_VAL
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: VALPAR
+
+      IPROOT=IPSAP
+      NOTH=STAVEC(20)
+      LABS(1)=MIC
+      LABS(2)=SAP
+      LABS(3)=EXC
+
+      CALL LCMPUT(IPDAT,'BARR_INFO',NCRD,1,CRDINF)
+      ! RECOVER DIMMCO INFORMATION FROM SAPHYB
+      DIMMCO(:NSTATE)=0
+      CALL LCMSIX(IPSAP,MIXDIR,1)
+      IPDIR=IPSAP
+      CALL LCMGET(IPDIR,'STATE-VECTOR',DIMMCO)
+      NGFF  = DIMMCO(14)
+      IPMCO=LCMGID(IPDIR,'MIXTURES')
+      JPMCO=LCMGIL(IPMCO,MIX)
+      IPMCO=LCMGID(JPMCO,'CALCULATIONS')
+      JPMCO=LCMGIL(IPMCO,1)
+      CALL LCMGET (JPMCO,'STATE-VECTOR',DIMCAL)
+      NPAR  = DIMMCO(5)
+      NMIL  = DIMMCO(1)
+      NCALS = DIMMCO(4)
+      NDEL  = DIMCAL(19)
+      ! RECOVER NPIN FOR GFF
+      NPIN=1
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
+      CALL LCMPUT(IPDAT,'NPAR',1,1,NPAR)
+      CALL LCMSIX(IPDAT,' ',0)
+      IF(LGFF) THEN
+        CALL LCMSIX(JPMCO,'MACROLIB',1)
+        CALL LCMSIX(JPMCO,'GFF',1)
+        CALL LCMSIX(JPMCO,'GFF-GEOM',1)
+        CALL LCMGET(JPMCO,'STATE-VECTOR',DIMGEO)
+        NXG=DIMGEO(3)
+        NYG=DIMGEO(4)
+        IF(NXG.NE. NYG) THEN
+          WRITE(6,*) "@D2PMAC:",
+     1     " NPIN NOT THE SAME X AND Y AXES IN MCO"
+          CALL XABORT("=> NXG .NE. NYG")
+        ENDIF
+        NPIN=NXG
+        CALL LCMSIX(JPMCO,' ',2)
+        CALL LCMSIX(JPMCO,' ',2)
+        CALL LCMSIX(JPMCO,' ',2)
+      ENDIF
+
+      ! INITIALIZATION OF PARAMETERS
+      NSVAR = 0
+      k = 1
+      ! MEMORY ALLOCATION
+      ALLOCATE (PKEY(NPAR))
+      ALLOCATE (NVAL(NPAR))
+      ALLOCATE (PKEY_TMP(NPAR))
+      ALLOCATE (RANK(NPAR))
+      ALLOCATE (RANK_INDEX(NPAR+1))
+      ALLOCATE (PARFMT(NPAR))
+
+      CALL LCMSIX(IPDIR,'GLOBAL',1)
+      CALL LCMGTC(IPDIR,'PARKEY',12,NPAR,PKEY)
+      CALL LCMGTC(IPDIR,'PARFMT',8,NPAR,PARFMT)
+
+      CALL LCMGET(IPDIR,'NVALUE',NVAL)
+      IF(NPAR.GT.10) CALL XABORT('D2PMCO: NVAL OVERFLOW.')
+      NVALTMP(:NPAR)=NVAL(:NPAR)
+
+      ! LOOP OVER STATE VARIABLES OF SAPHYB
+      ! CHECK OF EXISTENCE OF STATE PARAMETER
+
+      DO i=1, NPAR
+        IF ((PKEY(i).NE.'FLUE').AND.(PKEY(i).NE.'TIME')) NTOT=NTOT+1
+        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.
+        ELSE
+         DO j=1,NOTH
+           IF (PKEY(i)==OTHPK(j)) THEN
+            LOTH(j) = .TRUE.
+            SELECT CASE (PARFMT(i))
+            CASE ('REAL')
+             IF (OTHTYP(j) .EQ. 2) GO TO 100
+            CASE ('STRING')
+             IF (OTHTYP(j) .EQ. 3) GO TO 100
+            CASE ('INTEGER')
+             IF (OTHTYP(j) .EQ. 1) GO TO 100
+            CASE DEFAULT
+             WRITE(6,*) '@D2PMCO : UNKNOWN TYPE (',PARFMT(i),') FOR',
+     >       ' PKEY (',PKEY(i),').'
+            CALL XABORT('')
+            END SELECT
+            WRITE(6,*) '@D2PMCO : INCONSITENT TYPE FOR',
+     >       ' PKEY (',PKEY(i),'), TYPE (',PARFMT(i),') EXPECTED.'
+            CALL XABORT ('')
+  100      RKOTH(j)=i
+           EXIT
+           ENDIF
+          ENDDO
+        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,*) "@D2PMCO:",
+     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,*) "@D2PMCO:",
+     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
+      ! STORE THE NAME OF CURENT PKEY IN PKEY_TMP
+      DO i=1, NPAR
+        PKEY_TMP(i)=PKEY(i)
+      ENDDO
+
+      IF(.NOT.LBURN) THEN
+        WRITE(6,*)
+        WRITE(6,*)('WARNING: BURN VARIABLE IS MISSING IN MCO')
+        WRITE(6,*)('=> 0 MWJ/T SINGLE EXPOSURE ASSUMED')
+        WRITE(6,*)
+        DEALLOCATE (PKEY,NVAL)
+        NPAR=NPAR+1
+        ALLOCATE (PKEY(NPAR),NVAL(NPAR))
+        DO i=1, NPAR-1
+          PKEY(i)=PKEY_TMP(i)
+          NVAL(i)=NVALTMP(i)
+        ENDDO
+        PKEY(NPAR)="BURN"
+        NVAL(NPAR)=1
+        DEALLOCATE (PKEY_TMP)
+        ALLOCATE(PKEY_TMP (NPAR))
+        PKEY_TMP=PKEY
+      ENDIF
+      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
+
+      ALLOCATE (PVALDIR(NPAR))
+      ALLOCATE(VALPAR(NPAR,100))
+
+      OTHR(:,:)=0.
+      OTHC(:,:)=''
+
+      DO i=1, NPAR
+        ! NAME OF DIRECTORY IN SAPHYB CONTAINING VALUES OF STATE
+        ! VARIABLES : PKEY(I)
+        IF ((PARFMT(i).NE.'STRING')) THEN
+         IF ((PKEY(i).NE.PKNAM(6))) THEN
+
+          WRITE(PVALDIR(i),'("pval", I8.8)') i
+         ! STORE VALUES IN VALPAR
+          CALL LCMGET(IPDIR,PVALDIR(i),VALPAR(i,1:NVAL(i)))
+
+         ELSE IF(LBURN) THEN
+
+          WRITE(PVALDIR(i),'("pval", I8.8)') i
+         ! STORE VALUES IN VALPAR LBURN
+          CALL LCMGET(IPDIR,PVALDIR(i),VALPAR(i,1:NVAL(i)))
+         ELSE
+         ! STORE VALUES IN VALPAR
+          VALPAR(i,1:NVAL(i))=0.0
+         ENDIF
+        ENDIF
+
+        DO j=1,NOTH
+         IF (LOTH(j).EQV. .FALSE.) THEN
+          WRITE(6,*) '@D2PMCO: UNKNOWN PKEY (',OTHPK(j),') IN MCO'
+          CALL XABORT ('=> PLEASE CHECK MCO CONTENT')
+         ELSE IF (PKEY(i).EQ.OTHPK(j)) THEN
+          WRITE(PVALDIR(i),'("pval", I8.8)') i
+          IF (OTHTYP(j).EQ.3) THEN
+           CALL LCMGTC(IPDIR,PVALDIR(i),12,NVAL(i),OTHC(i,1:NVAL(i)))
+           DO k=1, NVAL(i)
+            IF (OTHC(i,k).EQ.OTHVAL(j)) THEN
+             OTHVAC(j)=OTHVAL(j)
+             EXIT
+            ENDIF
+            IF (k.EQ.NVAL(i)) THEN
+             WRITE (6,*) '@D2PMCO: VALUE (',OTHVAL(j),') FOR PKEY(',
+     >       PKEY(i),') IS OUT OF RANGE'
+             WRITE (6,*) '=> POSSIBLE VALUES ARE :'
+             WRITE (6,'(A12,1X)') OTHC(i,1:NVAL(i))
+             CALL XABORT ("")
+            ENDIF
+           ENDDO
+          ELSE
+           CALL LCMGET(IPDIR,PVALDIR(i),OTHR(i,1:NVAL(i)))
+           DO k=1, NVAL(i)
+            WRITE(OTHVALC,'(f12.5)')OTHR(i,k)
+            IF (OTHVALC.EQ.OTHVAL(j)) THEN
+             OTHVAR(j)=OTHR(i,k)
+             EXIT
+            ENDIF
+            IF (k.EQ.NVAL(i)) THEN
+             OTHVAR(j)=OTHREA(j)
+             WRITE (6,*) 'WARNING : VALUE (',OTHVAL(j),') FOR PKEY(',
+     >       PKEY(i),') IS OUT OF RANGE'
+             WRITE (6,*) '=> POSSIBLE VALUES ARE :'
+             WRITE (6,'(e12.5,1X)') OTHR(i,1:NVAL(i))
+             WRITE (6,*) '=>INTERPOLATION WILL BE NEEDED'
+            ENDIF
+           ENDDO
+
+          ENDIF
+         ENDIF
+        ENDDO
+
+
+        ! CASE OF CONTROL ROD
+        IF(PKEY(i)==PKNAM(1)) THEN
+           RANK(i)=ORDER_VAL(1);
+           RANK_INDEX(ORDER_VAL(1))=i
+
+           IF(LADD) THEN
+            DO UV=1,USRSTA
+             IF(USRPAR(UV)==PKNAM(1)) THEN
+              WRITE(6,*)('@D2PMCO: 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
+
+           IF(LADD) THEN
+            DO UV=1,USRSTA
+             IF(USRPAR(UV)==PKNAM(2)) THEN
+              IF(LNEW) THEN
+              VALPAR(i,1:NVAL(i))=0.0
+              NVAL(i)=0
+              ENDIF
+              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
+           IF(LADD) THEN
+            DO UV=1,USRSTA
+             IF(USRPAR(UV)==PKNAM(3)) THEN
+              IF(LNEW) THEN
+              VALPAR(i,1:NVAL(i))=0.0
+              NVAL(i)=0
+              ENDIF
+              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
+
+           IF(LADD) THEN
+            DO UV=1,USRSTA
+             IF(USRPAR(UV)==PKNAM(4)) THEN
+              IF(LNEW) THEN
+              VALPAR(i,1:NVAL(i))=0.0
+              NVAL(i)=0
+              ENDIF
+              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
+           IF(LADD) THEN
+            DO UV=1,USRSTA
+             IF(USRPAR(UV)==PKNAM(5)) THEN
+              IF(LNEW) THEN
+              VALPAR(i,1:NVAL(i))=0.0
+              NVAL(i)=0
+              ENDIF
+              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
+           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
+               NVAL(i)=0
+               ENDIF
+               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
+        ELSE
+           NOTHTH=NPAR-MAXVAL(ORDER_VAL)
+           IF((PKEY(i)=='FLUE').OR.(PKEY(i)=='TIME')) NOTHTH=NOTHTH-1
+           RANK(i) = NPAR+i
+           RANK_INDEX(NPAR+1)=NPAR+1
+        END IF
+      ENDDO
+
+      ! 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
+        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,'NTOT',1,1,NTOT)
+      CALL LCMPTC(IPDAT,'NAMDIR',12,MIXDIR)
+      CALL LCMPTC(IPDAT,'STATE_VAR',12,NSVAR,PKEY)
+      IF(.NOT.(LBARR)) THEN
+        PKEY_BARR(1)="BARR        "
+        DO j=1, NSVAR
+          PKEY_BARR(j+1)=PKEY(j)
+        ENDDO
+        ! CREATION OF : INFO/SAPHYB_INFO/STATE_VAR
+        CALL LCMPTC(IPDAT,'STATE_VAR',12,NSVAR+1,PKEY_BARR)
+        ! CREATION OF : INFO/SAPHYB_INFO/BARR
+        CALL LCMPUT(IPDAT,'BARR',1,2,1.0)
+        STAVEC(2) = NSVAR + 1 ! NVAR
+!        NSVAR=NSVAR+1
+      ENDIF
+
+       ALLOCATE (PKIDX(STAVEC(2)))
+       PKIDX(:STAVEC(2))=0
+       IF (.NOT. LBARR) PKIDX(STAVEC(2))= -1
+      DO i=1, NSVAR
+        DO j=2,6
+           IF(PKEY(i)==PKNAM(j)) THEN
+           PKIDX(i)=j
+           ENDIF
+        ENDDO
+        IF(PKEY(i)==PKNAM(1)) THEN
+           IF (LBARR) PKIDX(i)=1
+           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,*) "@D2PMCO: 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('D2PMCO: 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,PKREF(PKIDX(i)),
+     1       NVAL(RANK_INDEX(RANK(i))),2,VALPAR(RANK_INDEX(RANK(i)),
+     2       1:NVAL(RANK_INDEX(RANK(i)))))
+          DO l=1,USRSTA
+           IF(USRPAR(l)==PKEY(i)) THEN
+            IF(PKEY(i) =='BARR') THEN
+             CALL XABORT('@D2PMCO: THE CR STATE CANNOT BE SET BY USER')
+            ENDIF
+            IF((USRVAL(l)>1).and.NVAL(RANK_INDEX(RANK(i)))==1) THEN
+             WRITE(6,*)"@D2PMCO: IMPOSSIBLE TO DEFINE USER MESHING",
+     1        " FOR ",PKEY(i)
+             CALL XABORT ('ONLY ONE VALUE IS CONTAINED IN THE MCO')
+            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,PKREF(PKIDX(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,PKREF(PKIDX(i)),
+     1     NVAL(RANK_INDEX(RANK(i))),2,VALPAR(RANK_INDEX(RANK(i)),
+     2     1:NVAL(RANK_INDEX(RANK(i)))) )
+        ENDIF
+       ENDDO
+
+      CALL LCMPUT(IPDAT,'PKIDX',STAVEC(2),1,PKIDX)
+      IF (NOTH>0) THEN
+       CALL LCMPTC(IPDAT,'OTHPK',12,NOTH,OTHPK)
+       CALL LCMPUT(IPDAT,'OTHTYP',NOTH,1,OTHTYP)
+       CALL LCMPTC(IPDAT,'OTHVAC',12,NOTH,OTHVAC)
+       CALL LCMPUT(IPDAT,'OTHVAR',NOTH,2,OTHVAR)
+      ENDIF
+      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
+      IF (LADF) THEN
+       CALL LCMPTC(IPDAT,'ADF_TYPE',3,ADF)
+       IF (ADF.EQ.'DRA') THEN
+         CALL LCMPTC(IPDAT,'HADF',8,STAVEC(13),ADFD)
+       ELSE IF (ADF.EQ.'GEN') THEN
+         CALL LCMPTC(IPDAT,'HFLX',8,2,HFLX)
+         CALL LCMPTC(IPDAT,'HCUR',8,2,HCUR)
+         CALL LCMPUT(IPDAT,'THCK',2,1,THCK)
+       ENDIF
+      ENDIF
+
+      IF (LCDF) THEN
+       CALL LCMPTC(IPDAT,'CDF_TYPE',3,CDF)
+       CALL LCMPTC(IPDAT,'HCDF',8,STAVEC(15),CDFD)
+      ENDIF
+
+      IF (LGFF) CALL LCMPTC(IPDAT,'GFF_TYPE',3,GFF)
+
+      IF (LYLD) THEN
+       CALL LCMPTC(IPDAT,'YLD_OPT',3,YLDOPT)
+       CALL LCMPUT(IPDAT,'YLD_FIX',3,2,YLD)
+       CALL LCMPUT(IPDAT,'YLD_LOC',5,2,LOCYLD)
+      ENDIF
+      CALL LCMPUT(IPDAT,'LABS', 3,5,LABS)
+      CALL LCMPUT(IPDAT,'SCAT', 1,5,SCAT)
+      CALL LCMSIX(IPDAT,'ISOTOPES',1)
+      CALL LCMPTC(IPDAT,'XE135',12,ISOT(1))
+      CALL LCMPTC(IPDAT,'SM149',12,ISOT(2))
+      CALL LCMPTC(IPDAT,'I135',12,ISOT(3))
+      CALL LCMPTC(IPDAT,'PM149',12,ISOT(4))
+      CALL LCMPTC(IPDAT,'PM148',12,ISOT(5))
+      CALL LCMPTC(IPDAT,'PM148M',12,ISOT(6))
+      CALL LCMPTC(IPDAT,'ND147',12,ISOT(7))
+      CALL LCMPTC(IPDAT,'PM147',12,ISOT(8))
+
+      ! SET THE IPDAT/STAVEC
+      STAVEC(1) = DIMMCO(2)                    ! NGROUP
+      STAVEC(3) = N_XS                         ! N_XS
+      STAVEC(6) = NCRD                         ! NCOMPO
+
+      STAVEC(7) = NDEL                         ! NDLAY
+
+      STAVEC(16)= NGFF                         ! GFF(NGFF,NG)
+      STAVEC(17)= NPIN                         ! GFFP(NPIN,NPIN,NG)
+
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMPUT(IPDAT,'STATE-VECTOR',40,1,STAVEC)
+      CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
+      CALL LCMPUT(IPDAT,'MIX',1,1,MIX)
+
+      IPTH=LCMLID(IPDAT,'PKEY_INFO',6)
+      DO J=1, 6
+         KPTH=LCMDIL(IPTH,J)
+         IF(J==1) THEN
+           CALL LCMPTC(KPTH,'NAME',12,PKNAM(1))
+           CALL LCMPUT(KPTH,'LFLAG',1,5,LBARR)
+         ELSE IF(J==2)THEN
+           IF(LDMOD) CALL LCMPTC(KPTH,'NAME',12,PKNAM(2))
+           CALL LCMPUT(KPTH,'LFLAG',1,5,LDMOD)
+         ELSE IF(J==3) THEN
+           IF(LCBOR) CALL LCMPTC(KPTH,'NAME',12,PKNAM(3))
+           CALL LCMPUT(KPTH,'LFLAG',1,5,LCBOR)
+         ELSE IF(J==4)THEN
+           IF(LTCOM) CALL LCMPTC(KPTH,'NAME',12,PKNAM(4))
+           CALL LCMPUT(KPTH,'LFLAG',1,5,LTCOM)
+         ELSE IF(J==5)THEN
+           IF(LTMOD) CALL LCMPTC(KPTH,'NAME',12,PKNAM(5))
+           CALL LCMPUT(KPTH,'LFLAG',1,5,LTMOD)
+         ELSE IF(J==6) THEN
+           CALL LCMPTC(KPTH,'NAME',12,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 MULTICOMPO RECOVERED **********"
+         WRITE(6,*) " DIRECTORY NAME   : ", MIXDIR
+         WRITE(6,*) " INDEX OF MIXTURE : ", MIX
+         WRITE(6,*)
+         WRITE(6,*) "******* CONTENT OF MULTICOMPO RECOVERED **********"
+         WRITE(6,*)
+         WRITE(6,*)"NB OF STATE VARIBALE IN MCO      :", NPAR
+         WRITE(6,*)"NB OF STATE VARIABLES RECOGNIZED :", NSVAR
+         WRITE(6,*)"NAME OF STATE VARIABLES IN MCO   :", PKEY_TMP
+         WRITE(6,*)"RECOGNIZED STATE VARIABLES       :",PKEY(1:NSVAR)
+         IF (NOTH.GE.1) THEN
+         WRITE(6,*)"OTHER STATE VARIABLES            :",OTHPK(1:NOTH)
+         WRITE(6,*)"OTHER STATE  VALUES              :",OTHVAL(1:NOTH)
+         ENDIF
+         IF(NOTHTH.NE.NOTH) THEN
+         WRITE(6,*) "=> WARNING: UNRECOGNIZED VARIABLES !"
+         WRITE(6,*) "==>PLEASE USE THE PKEY CARD OF D2P: MODULE"
+         CALL XABORT("")
+         ENDIF
+         WRITE(6,*) "FLAG FOR 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"
+          IF(ADF .EQ. 'GEN')  WRITE(6,*) "TYPE OF ADF : GENPMAXS"
+         ENDIF
+         IF (STAVEC(21).EQ.1) THEN
+          WRITE(6,*)'WARNING => ADF ARE INTEGRATED IN CROSS SECTIONS'
+         ENDIF
+         WRITE(6,*) "CORNER DISCONTINUITY FACTORS             : ", LCDF
+         IF(LCDF) THEN
+          IF(CDF .EQ. 'DRA')  WRITE(6,*) "TYPE OF CDF : DRAGON"
+         ENDIF
+         WRITE(6,*) "GROUP FORM FACTORS                       : ", LGFF
+         IF(LGFF) THEN
+          IF(GFF .EQ. 'DRA')  WRITE(6,*) "TYPE OF GFF : DRAGON"
+         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)," PARAMETER :",
+     1    NVAL(RANK_INDEX(RANK(i)))
+          WRITE(6,*) "VALUES FOR ",PKEY(i)," PARAMETER :",
+     1    VALPAR(RANK_INDEX(RANK(i)),1:NVAL(RANK_INDEX(RANK(i))))
+          WRITE(6,*)
+         ENDDO
+        WRITE(6,*)
+        WRITE(6,*) "NAME OF FISSION PRODUCTS FOR FISSION YIELD :"
+        WRITE(6,*) "XE135  : ",ISOT(1)
+        WRITE(6,*) "SM149  : ",ISOT(2)
+        WRITE(6,*) "I135   : ",ISOT(3)
+        WRITE(6,*) "PM149  : ",ISOT(4)
+        WRITE(6,*) "PM148  : ",ISOT(5)
+        WRITE(6,*) "PM148M : ",ISOT(6)
+        WRITE(6,*) "ND147  : ",ISOT(7)
+        WRITE(6,*) "PM147  : ",ISOT(8)
+        WRITE(6,*)
+        IF (LYLD) THEN
+         WRITE(6,*) "OPTION FOR FISSION YIELD RECOVERY: ",YLDOPT
+         IF (STAVEC(22)>0) THEN
+         WRITE(6,*)"CORRECTION FOR SAMARIUM PRODUCTION IS APPLIED"
+         ENDIF
+          IF (YLDOPT.EQ.'MAN')THEN
+           WRITE(6,*)"LOCAL CONDITIONS SET BY THE USER :"
+           DO I=1,5
+            IF (LOCYLD(I).NE.-1) THEN
+             WRITE(6,*) PKNAM(I)," = ",LOCYLD(I)
+            ENDIF
+           ENDDO
+          ENDIF
+        ENDIF
+
+        WRITE(6,*)
+      ENDIF
+      ! free memory
+      DEALLOCATE (PKEY)
+      DEALLOCATE (PKIDX)
+      DEALLOCATE (NVAL)
+      DEALLOCATE (PVALDIR)
+      DEALLOCATE (PKEY_TMP)
+      DEALLOCATE (RANK)
+      DEALLOCATE (RANK_INDEX)
+      DEALLOCATE (VALPAR)
+      DEALLOCATE (PARFMT)
+      RETURN
+      END
diff --git a/Donjon/src/D2PMIC.f b/Donjon/src/D2PMIC.f
new file mode 100644
index 0000000..c1f2a1d
--- /dev/null
+++ b/Donjon/src/D2PMIC.f
@@ -0,0 +1,279 @@
+*DECK D2PMIC
+      SUBROUTINE D2PMIC(  IPDAT, IPMIC , IPRINT,    NGP, NBMIX, NBISO,
+     >                      NED,   NVAR, STAIDX,   LXES,  LDET,  LCOR,
+     >                     FLUX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover microscopic cross sections from a microlib object and write
+* cross sections for one branch at a fixed burnup point in the INFO
+* data block
+*
+*Author(s): 
+* J. Taforeau
+*
+*Parameters: input
+* IPDAT   address of info data block
+* IPMIC   address of the microlib object
+* NBMIX   number of mixturess
+* NBISO   number of isotopes
+* NED     number of P0 additional XS
+* NGP     number of energy groups
+* NVAR    number of state variables
+* STAIDX  table of states index order
+*
+*Parameters: 
+* IPRINT   
+* NGP      
+* LXES     
+* LDET     
+* LCOR     
+* FLUX     
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPDAT,IPMIC
+      INTEGER NBMIX,NBISO,NED,NGP,NVAR
+      INTEGER STAIDX(NVAR)
+      REAL FLUX(NGP)
+      LOGICAL LDET,LXES,LCOR
+*----
+*  LOCAL VARIABLES
+*----
+      TYPE(C_PTR) IPTH,KPTH,JPMIC
+      INTEGER :: iXE = 0
+      INTEGER :: iSM = 0
+      INTEGER :: IMR = 0
+      INTEGER :: iDT = 0
+      INTEGER ,DIMENSION(5) :: iCHAIN = 0
+      INTEGER :: DEB = -999
+      REAL XEND,SMND,MRND
+      REAL XSECT(NGP),XENG(NGP),SMNG(NGP),SCAT(NGP),DET(NGP)
+      REAL NFTOT(NGP),N2N(NGP)
+      REAL :: NUM = 0.
+      REAL :: DENO = 0.
+      REAL DEN(NBISO)
+      REAL NGXS(5,NGP),RPHI,YLDPM
+      CHARACTER(LEN=12) HUSE(NBISO),ISOTNAME(NBISO)
+      CHARACTER*8 XSNAM(12)
+      ! RECOVER ONLY EIGHT FIRST CHARACTER OF ISOTOPES
+      CHARACTER(LEN=8) ISOTOPES(2),HDET,SMCHAIN(5)
+
+      CALL LCMSIX (IPDAT,' ',0)
+      CALL LCMSIX (IPDAT,'SAPHYB_INFO',1)
+      CALL LCMSIX (IPDAT,'ISOTOPES',1)
+      CALL LCMGTC (IPDAT,'XE135',12,ISOTOPES(1))
+      CALL LCMGTC (IPDAT,'SM149',12,ISOTOPES(2))
+      CALL LCMGTC (IPDAT,'PM148',12,SMCHAIN(1))
+      CALL LCMGTC (IPDAT,'PM148M',12,SMCHAIN(2))
+      CALL LCMGTC (IPDAT,'PM149',12,SMCHAIN(3))
+      CALL LCMGTC (IPDAT,'PM147',12,SMCHAIN(4))
+      CALL LCMGTC (IPDAT,'ND147',12,SMCHAIN(5))
+      IF (LDET) CALL LCMGTC (IPDAT,'DET',12,HDET)
+
+      IF(NBMIX.NE.1) THEN
+        CALL XABORT('@D2P: MORE THAN ONE MIXTRURE IN SAPHYB')
+      ENDIF
+      IF(NED.GT.12) THEN
+        CALL XABORT('@D2P: MORE THAN 12 ADDITIONAL ISOTOPES')
+      ENDIF
+      
+      CALL LCMSIX(IPMIC,' ',0)
+      CALL LCMGET(IPMIC,'ISOTOPESDENS',DEN)
+      CALL LCMGTC(IPMIC,'ISOTOPESUSED',12,NBISO,HUSE)
+      CALL LCMGTC(IPMIC,'ISOTOPERNAME',12,NBISO,ISOTNAME)
+      CALL LCMGTC(IPMIC,'ADDXSNAME-P0',8,NED,XSNAM)
+
+      DO I=1,NBISO
+         IF(INDEX(HUSE(I),ISOTOPES(1))>0) iXE=I
+         IF(INDEX(HUSE(I),ISOTOPES(2))>0) iSM=I
+         IF(INDEX(HUSE(I),'*MAC*RES')>0) iMR=I
+         IF (INDEX(HUSE(I),SMCHAIN(1))>0) iCHAIN(1)=I
+         IF (INDEX(HUSE(I),SMCHAIN(2))>0) iCHAIN(2)=I
+         IF (INDEX(HUSE(I),SMCHAIN(3))>0) iCHAIN(3)=I
+         IF (INDEX(HUSE(I),SMCHAIN(4))>0) iCHAIN(4)=I
+         IF (INDEX(HUSE(I),SMCHAIN(5))>0) iCHAIN(5)=I
+         IF (LDET) THEN
+            IF(INDEX(HUSE(I),HDET)>0) iDT=I
+         ENDIF
+      ENDDO
+
+      IF (LXES) THEN
+       ! CHECK THE EXISTENCE OF XE AND SM ISOTOPES
+
+       IF(iXE==0) THEN
+         CALL XABORT('@D2PMIC: XE MUST BE A PARTICULARIZED ISOTOPE')
+       ELSE IF(iSM==0) THEN
+         CALL XABORT('@D2PMIC: SM MUST BE A PARTICULARIZED ISOTOPE')
+       ENDIF
+       XEND=DEN(iXE)
+       SMND=DEN(iSM)
+       MRND=DEN(iMR)
+       CALL LCMSIX(IPMIC,' ',0)
+       ! PROCESS MICROSCOPIC TOTAL XS INFORMATION FOR XE
+       JPMIC=LCMGID(IPMIC,'ISOTOPESLIST')
+       IPMIC=LCMGIL(JPMIC,iXE)
+
+       CALL LCMLEN(IPMIC,'NTOT0',ILONG,ITYLCM)
+
+       IF(ILONG.NE.NGP) THEN
+         CALL XABORT('@D2PMIC: INCONSISTENT NUMBERS OF ENERGY GROUP')
+       ENDIF
+       ! CALCULATION OF MICROSCOPIC ABSORPTION CROSS SECTIONS OF XE
+       CALL LCMGET(IPMIC,'NTOT0',XSECT)
+       CALL LCMGET(IPMIC,'SIGS00',SCAT)
+       DO I=1, NGP
+         XENG(I)=(XSECT(I)-SCAT(I))
+         IF (XENG(I)<0) THEN
+         XENG(I)= 0.
+          WRITE(6,*) '@D2PMIC: WARNING : XE NEGATIVE CROSS SECTION',
+     >    '=> ZERO CROSS SECTION ASSUMED'
+         ENDIF
+       ENDDO
+
+       ! PROCESS MICROSCOPIC TOTAL XS INFORMATION FOR SM
+       CALL LCMSIX(IPMIC,' ',0)
+       JPMIC=LCMGID(IPMIC,'ISOTOPESLIST')
+       IPMIC=LCMGIL(JPMIC,iSM)
+       CALL LCMLEN(IPMIC,'NTOT0',ILONG,ITYLCM)
+       IF(ILONG.NE.NGP) THEN
+         CALL XABORT('@D2PMIC: MORE THAN ONE MIXTRURE IN SAPHYB')
+       ENDIF
+       XSECT(:NGP)=0.0
+       SCAT(:NGP)=0.0
+
+       ! CALCULATION OF MICROSCOPIC ABSORPTION CROSS SECTIONS OF SM
+       CALL LCMGET(IPMIC,'NTOT0',XSECT)
+       CALL LCMGET(IPMIC,'SIGS00',SCAT)
+       DO I=1, NGP
+         SMNG(I)=(XSECT(I)-SCAT(I))
+         IF (SMNG(I)<0) THEN
+          SMNG(I)= 0.
+          WRITE(6,*) '@D2PMIC: WARNING : SM NEGATIVE CROSS SECTION',
+     >    '=> ZERO CROSS SECTION ASSUMED'
+         ENDIF
+       ENDDO
+      ENDIF
+
+      IF (LCOR.OR.LXES) THEN
+       ! RECOVER FISSION CROSS SECTION OF MACROSCOPIC RESIDUAL
+       CALL LCMSIX(IPMIC,' ',0)
+       JPMIC=LCMGID(IPMIC,'ISOTOPESLIST')
+       IPMIC=LCMGIL(JPMIC,iMR)
+       CALL LCMLEN(IPMIC,'NFTOT',ILONG,ITYLCM)
+       CALL LCMGET(IPMIC,'N2N',N2N)
+       IF(ILONG.NE.NGP) THEN
+         CALL XABORT('@D2PMIC: MORE THAN ONE MIXTRURE IN SAPHYB')
+       ENDIF
+
+       NFTOT(:NGP)=0
+       CALL LCMGET(IPMIC,'NFTOT',NFTOT)
+
+       NFTOT(:)=NFTOT(:)*MRND
+       CALL LCMSIX(IPMIC,' ',0)
+      ENDIF
+
+      IF (LCOR) THEN
+       RPHI=FLUX(1)/FLUX(2)
+       DO I=1,4
+        JPMIC=LCMGID(IPMIC,'ISOTOPESLIST')
+        IPMIC=LCMGIL(JPMIC,iCHAIN(I))
+        CALL LCMGET(IPMIC,'NG',NGXS(I,:))
+        CALL LCMSIX(IPMIC,' ',0)
+       ENDDO
+       NUM=0.
+       DO I=1,2
+       NUM=NUM+DEN(iCHAIN(I))*(NGXS(I,1)*RPHI+NGXS(I,2))
+       ENDDO
+       DENO=NFTOT(1)*RPHI+NFTOT(2)
+
+       CALL LCMSIX(IPDAT,' ',0)
+       CALL LCMSIX(IPDAT,'GENPMAXS_INP',1)
+       CALL LCMGET(IPDAT,'FLAG',DEB)
+       CALL LCMSIX(IPDAT,' ',0)
+       IPTH=LCMGID(IPDAT,'TH_DATA')
+       KPTH=LCMDIL(IPTH,STAIDX(NVAR))
+       CALL LCMGET(KPTH,'YLDPm',YLDPM)
+       DENO=DENO*YLDPM
+       YLDPM=YLDPM*(1+(NUM/DENO))
+       IF (DEB.EQ.-999) THEN
+        CALL XABORT ("@D2PMIC : PROBLEM IN YIELD CORRECTION")
+       ELSE IF (DEB<0) THEN
+        CALL LCMPUT(KPTH,'YLDPm',1,2,YLDPM)
+       ENDIF
+
+      ENDIF
+
+
+      IF (LDET) THEN
+       IF(iDT==0) THEN
+         WRITE(6,*) '@D2PMIC: UNKNOWN ISOTOPE (',HDET,') FOR DETECTOR',
+     >   ' CROSS SECTIONS'
+         CALL XABORT ('=> PLEASE USE THE DET CARD IN D2P:')
+       ENDIF
+       CALL LCMSIX(IPMIC,' ',0)
+
+       JPMIC=LCMGID(IPMIC,'ISOTOPESLIST')
+       IPMIC=LCMGIL(JPMIC,iDT)
+       CALL LCMLEN(IPMIC,'NFTOT',ILONG,ITYLCM)
+              PRINT*,'ICI'
+       IF(ILONG.NE.NGP) THEN
+         CALL XABORT('@D2PMIC: INCONSISTENT NUMBERS OF ENERGY GROUP')
+       ENDIF
+       ! CALCULATION OF MICROSCOPIC ABSORPTION CROSS SECTIONS OF XE
+       CALL LCMGET(IPMIC,'NFTOT',DET)
+       CALL LCMSIX(IPMIC,' ',0)
+      ENDIF
+
+       CALL LCMSIX(IPDAT,' ',0)
+       CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
+       IPTH=LCMGID(IPDAT,'CROSS_SECT')
+       KPTH=LCMDIL(IPTH,STAIDX(NVAR))
+
+
+      CALL LCMSIX(KPTH,'MACROLIB_XS',1)
+      IF (LXES) CALL LCMPUT(KPTH,'SFI',NGP,2,NFTOT)
+      CALL LCMSIX(KPTH,' ',2)
+      CALL LCMSIX(KPTH,'MICROLIB_XS',1)
+      IF (LXES) THEN
+       CALL LCMPUT(KPTH,'XENG',NGP,2,XENG)
+       CALL LCMPUT(KPTH,'SMNG',NGP,2,SMNG)
+       CALL LCMPUT(KPTH,'XEND',1,2,XEND)
+       CALL LCMPUT(KPTH,'SMND',1,2,SMND)
+      ENDIF
+      IF (LDET) CALL LCMPUT(KPTH,'DET',NGP,2,DET)
+      CALL LCMSIX(KPTH,' ',0)
+
+
+
+      IF(IPRINT > 1)  THEN
+       WRITE(6,*)
+       WRITE(6,*) "**************************************************"
+       WRITE(6,*) "*                     SUMMARY                    *"
+       WRITE(6,*) "**************************************************"
+       WRITE(6,*)
+       WRITE(6,*) "****      MICROSCOPIC cross sections       ****"
+       IF (LDET) THEN
+        WRITE(6,*) "DETECTOR                :",DET
+       ENDIF
+       IF (LXES) THEN
+        WRITE(6,*) "XENON ABSORPTION        :",XENG
+        WRITE(6,*) "SAMARIUM ABSORPTION     :",SMNG
+        WRITE(6,*) "XENON NUMBER DENSITY    :",XEND
+        WRITE(6,*) "SAMARIUM NUMBER DENSITY :",SMND
+        WRITE(6,*)
+        WRITE(6,*) "****  MACROSCOPIC cross sections(1:NGP) ****"
+        WRITE(6,*) "FISSION                 :",NFTOT
+        WRITE(6,*) "MAC*RES* NUMBER DENSITY :",MRND
+       ENDIF
+
+       IF (LCOR) THEN
+        WRITE(6,*) "PM149 FISSION YIELD CORRECTED:",YLDPM
+       ENDIF
+      ENDIF
+      END
diff --git a/Donjon/src/D2PMUL.f b/Donjon/src/D2PMUL.f
new file mode 100644
index 0000000..25ffd02
--- /dev/null
+++ b/Donjon/src/D2PMUL.f
@@ -0,0 +1,161 @@
+*DECK D2PMUL
+      SUBROUTINE D2PMUL(  IPMUL,  IPDAT, STAVEC,    MIX, IPRINT        )
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover the global stated variable data contained in the Multicompo
+* object (for reflector cross sections)
+*
+*Author(s): 
+* J. Taforeau
+*
+*Parameters: input
+* IPDAT   address of the INFO data block
+* IPMUL   address of the MULTICOMPO object
+* STAVEC  various parameters associated with the IPDAT structure
+* MIX     index of mixture on which XS are to be extracted (only for
+*         reflector cases)
+* IPRINT  control the printing on screen
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMUL, IPDAT
+      INTEGER IPRINT
+      INTEGER MIX    ! MIX = 1 (RADIAL); MIX = 2 (LOW) ; MIX = 3 (TOP)
+      INTEGER STAVEC(40)
+*----
+*  LOCAL VARIABLES
+*----
+      TYPE(C_PTR) IPROOT,IPTH,KPTH
+      PARAMETER(NSTATE=40)
+      ! DEFAULT CR DC PC TF
+      INTEGER :: NPAR = 5
+      ! NUMBER OF CROSS SECTIONS TO BE RECOVERED
+      INTEGER :: N_XS = 8
+      ! NUMBER OF CB VALUES CONTAINED IN MULTICOMPO
+      INTEGER CB_NB
+      ! NUMBER OF VALUES FOR EACH DEFAULT STATES VARIABLES
+      INTEGER NVAL(5)
+      ! VALUES FOR EACH DEFAULT STATES VARIABLES
+      REAL VALPAR(5,100)
+      ! NAME OF PKEY
+      CHARACTER (len=4) PKEY(5)
+      ! NAME OF PKEY FOR BORON CONCENTRATION (MUST BE C-BORE)
+      CHARACTER(LEN=6) CB_name
+      ! VALUES FOR BORON CONCENTRATION
+      REAL, ALLOCATABLE, DIMENSION(:) :: VAL_CB
+
+      STAVEC(1)=2
+      STAVEC(2)=NPAR
+      STAVEC(3)=N_XS
+      STAVEC(4)=1
+      STAVEC(5)=2
+      STAVEC(6)=1
+      STAVEC(7)=0
+
+      IPROOT=IPMUL
+      ! MOVING AND RECOVER INFORMATION FROM MULTICOMPO
+      CALL LCMSIX(IPMUL,'default',1)
+      CALL LCMSIX(IPMUL,'GLOBAL',1)
+      CALL LCMGTC(IPMUL,'PARKEY',6,CB_name)
+      ! CHECK IF PKEY FOR BORON CONCENTRATION IS C-BORE
+      IF(CB_name.NE.'C-BORE') THEN
+        CALL XABORT('@D2PMUL: ONLY C-BORE PKEY EXPECTED')
+      ENDIF
+      ! RECOVER BORON CONCENTRATION VALUES
+      CALL LCMLEN(IPMUL,'pval00000001',CB_NB,ITYLCM)
+      ALLOCATE (VAL_CB(CB_NB))
+      CALL LCMGET(IPMUL,'pval00000001',VAL_CB)
+
+      ! CREATION OF INFO/SAPHYB_INFO/ CONTENT
+      CALL LCMPUT(IPDAT,'BARR_INFO',1,1,1)
+      CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
+      CALL LCMPUT(IPDAT,'MIX',1,1,MIX)
+
+      ! ATTRIBUTION OF DEFAULT VALUES FOR OTHER STATE VARIABLES THAN
+      ! C_BORE
+      PKEY(1)='BARR'           ! CONTROL ROD
+      PKEY(2)='DMOD'           ! MODERATOR DENSITY
+      PKEY(3)='CBOR'           ! BORON CONCENTRATION
+      PKEY(4)='TCOM'           ! FUEL TEMPERATURE
+      PKEY(5)='BURN'           ! BURN UP
+      CALL LCMPTC(IPDAT,'STATE_VAR',4,5,PKEY)
+      ! ALL STATE VARIABLE (EXCEPT CBOR) ARE FIXED
+      NVAL(1)=1
+      NVAL(2)=1
+      NVAL(3)= CB_NB
+      NVAL(4)=1
+      NVAL(5)=1
+      VALPAR(1,1) = 1       ! NO CONTROL ROD IS INSERTED
+      VALPAR(3,1:CB_NB) = VAL_CB
+      VALPAR(2,1) = 0.75206 ! DEFAULT MODERATOR DENSITY= 0.75206 G/CM3
+      VALPAR(4,1) = 560     ! FUEL TEMPERATURE= 560 Celsius
+      VALPAR(5,1) = 0       ! BURN-UP= 0 MWJ/T
+
+      ! CREATION OF INFO/SAPHYB_INFO/SVNAME
+      ! LOOP OVER STATE VARIABLE
+      DO i=1, NPAR
+        CALL  LCMPUT(IPDAT,PKEY(i),NVAL(i),2,VALPAR(i,1:NVAL(i)))
+      ENDDO
+
+      CALL LCMSIX(IPDAT,' ',0)
+      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 LCMPTC(KPTH,"NAME",8,"BARR    ")
+           CALL LCMPUT(KPTH,"LFLAG",1,5,.TRUE.)
+         ELSE IF(J==2)THEN
+           CALL LCMPTC(KPTH,"NAME",8,"DMOD    ")
+           CALL LCMPUT(KPTH,"LFLAG",1,5,.TRUE.)
+         ELSE IF(J==3) THEN
+           CALL LCMPTC(KPTH,"NAME",8,"CBOR    ")
+           CALL LCMPUT(KPTH,"LFLAG",1,5,.TRUE.)
+         ELSE IF(J==4)THEN
+           CALL LCMPTC(KPTH,"NAME",8,"TCOM    ")
+           CALL LCMPUT(KPTH,"LFLAG",1,5,.TRUE.)
+         ELSE IF(J==5)THEN
+           CALL LCMPTC(KPTH,"NAME",8,"TMOD    ")
+           CALL LCMPUT(KPTH,"LFLAG",1,5,.FALSE.)
+         ELSE IF(J==6) THEN
+           CALL LCMPTC(KPTH,"NAME",8,"BURN    ")
+           CALL LCMPUT(KPTH,"LFLAG",1,5,.TRUE.)
+         ENDIF
+      ENDDO
+      ! CREATION OF :
+      ! INFO/HELIOS_HEAD/ DIRECTORY
+      ! INFO/GENPMAXS_INP/ DIRECTORY
+
+      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 MULTICOMPO RECOVERED *********"
+         WRITE(6,*)
+         WRITE(6,*) "NUMBER OF STATE VARIABLES :", NPAR
+         WRITE(6,*) "NAME OF STATE VARIABLES :", PKEY
+         WRITE(6,*)
+         DO i=1, NPAR
+          WRITE(6,*) "NUMBER OF VALUES FOR ",PKEY(i)," PARAMETERS :",
+     1    NVAL(i)
+          WRITE(6,*) "VALUES FOR ",PKEY(i)," PARAMETERS :",
+     1    VALPAR(i,1:NVAL(i))
+          WRITE(6,*)
+         ENDDO
+        WRITE(6,*)
+      ENDIF
+
+      ! FREE MEMORY
+      DEALLOCATE (VAL_CB)
+      END
diff --git a/Donjon/src/D2PPRC.f b/Donjon/src/D2PPRC.f
new file mode 100644
index 0000000..1e989bb
--- /dev/null
+++ b/Donjon/src/D2PPRC.f
@@ -0,0 +1,290 @@
+      SUBROUTINE D2PPRC ( IPDAT,IPPRC, HEQUI, HMASL, ISOTVAL, ISOTOPT,
+     >                     LMEM,IPRINT,MIXDIR,JOBOPT                 )
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Build a procedure file for the interpolation of cross sections
+*
+*Author(s): 
+* J. Taforeau
+*
+*Parameters: input
+* IPDAT   adress of info data block
+* HEQUI   name of the equivalence record in the saphyb|MCO object
+* HMASL   name of heavy metal density record in the saphyb|MCO object
+* ISOTVAL concentration of particularized isotopes
+* ISOTOPT otpion for paticularised isotopes
+*
+*Parameters: 
+* IPPRC    
+* LMEM     
+* IPRINT   
+* MIXDIR   
+* JOBOPT   
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPDAT,IPTH,KPTH
+      INTEGER IPPRC,PK,IPRINT
+      CHARACTER*4 HEQUI,HMASL
+      CHARACTER*1 ISOTOPT,JOBOPT(14)
+      CHARACTER*12,ISOTOPES(8)
+      REAL ISOTVAL
+      LOGICAL LMEM,LFLAG(6)
+*----
+*  LOCAL VARIABLES
+*----
+      CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: PKEY
+      CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: OTHPK
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: OTHTYP
+      CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: OTHVAC
+      REAL, ALLOCATABLE, DIMENSION(:) :: OTHVAR
+      CHARACTER*12 PKNAM(6),MIXDIR
+      INTEGER STAVEC(40),NVAR,ITYP,NOTH
+      INTEGER :: NTOT = 0
+      INTEGER :: NPKEY = 0
+      INTEGER :: ORDER(6) = -1
+      CHARACTER*6 :: NAMSAP='XSLIB'
+      CHARACTER*4,DIMENSION(6) :: REFNAM
+      DATA REFNAM/ "BARR","DMOD","CBOR","TCOM","TMOD","BURN"/
+
+      WRITE(IPPRC,*)'!************************************************'
+      WRITE(IPPRC,*)'!    Auto Generation of input file for D2P      *'
+      WRITE(IPPRC,*)'! - Recovering of information from D2P PHASE 1  *'
+      WRITE(IPPRC,*)'! - call to the interpolation module(SCR|NCR)   *'
+      WRITE(IPPRC,*)'! - call of D2P for PHASE 2 and 3               *'
+      WRITE(IPPRC,*)'! Author(s) : J. TAFOREAU (2016)                *'
+      WRITE(IPPRC,*)'!************************************************'
+      WRITE(IPPRC,*)
+
+      WRITE(IPPRC,*)" SEQ_ASCII GENPMAXS :: FILE 'GENPMAXS.inp' ; "
+      WRITE(IPPRC,*)" SEQ_ASCII HELIOS :: FILE 'HELIOS.dra' ; "
+      WRITE(IPPRC,*)" XSM_FILE XSLIB :: FILE 'XSLIB' ;  "
+      WRITE(IPPRC,*)" XSM_FILE D2PINFO :: FILE 'Info.xsm' ; "
+      WRITE(IPPRC,*)" LINKED_LIST INFO ; "
+      IF (LMEM) THEN
+       WRITE(IPPRC,*)'LINKED_LIST XSL ; '
+       NAMSAP='XSL'
+      ENDIF
+
+      WRITE(IPPRC,*)'LINKED_LIST Micro ; '
+      WRITE(IPPRC,*)'MODULE END: D2P: SCR: NCR: GREP: DELETE: UTL: ;'
+      WRITE(IPPRC,*)
+      WRITE(IPPRC,*)'!************************************************'
+      WRITE(IPPRC,*)'!  STEP 0 :   Initializing state parameters     *'
+      WRITE(IPPRC,*)'!************************************************'
+      WRITE(IPPRC,*)
+
+      CALL LCMGET(IPDAT,'STATE-VECTOR',STAVEC)
+      NVAR=STAVEC(2)
+      ITYP=STAVEC(18)
+      NOTH=STAVEC(20)
+      ALLOCATE(PKEY(NVAR))
+      ALLOCATE(OTHPK(NOTH),OTHTYP(NOTH),OTHVAC(NOTH),OTHVAR(NOTH))
+      CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
+      CALL LCMGTC(IPDAT,'ISOTOPES',12,4,ISOTOPES)
+      CALL LCMGTC(IPDAT,'STATE_VAR',12,NVAR,PKEY)
+      CALL LCMGET(IPDAT,'NTOT',NTOT)
+      IF (NOTH>0) THEN
+       CALL LCMGTC(IPDAT,'OTHPK',12,NOTH,OTHPK)
+       CALL LCMGET(IPDAT,'OTHTYP',OTHTYP)
+       CALL LCMGTC(IPDAT,'OTHVAC',12,NOTH,OTHVAC)
+       CALL LCMGET(IPDAT,'OTHVAR',OTHVAR)
+      ENDIF
+
+      DO PK=1, 6
+        IPTH=LCMGID(IPDAT,'PKEY_INFO')
+        KPTH=LCMDIL(IPTH,PK)
+        CALL LCMGET(KPTH,'LFLAG',LFLAG(PK))
+        IF(LFLAG(PK)) THEN
+         NPKEY=NPKEY+1
+         CALL LCMGTC(KPTH,'NAME',12,PKNAM(PK))
+         CALL LCMGTC(KPTH,'NAME',12,PKNAM(PK))
+         WRITE(IPPRC,*) 'STRING  ',
+     >    REFNAM(PK),' := "',TRIM(PKNAM(PK)),'" ; '
+         WRITE(IPPRC,*) 'REAL    ',REFNAM(PK),'_VAL     ; '
+         DO I=1,NVAR
+          IF (PKNAM(PK).EQ.PKEY(I)) THEN
+          ORDER(PK)=I
+          ENDIF
+         ENDDO
+        ENDIF
+      ENDDO
+
+      IF (NTOT.NE.(NOTH+NPKEY)) THEN
+       WRITE(6,*) "@D2PPROC: INCONSISTENT D2P INPUT DATA WITH",
+     > "XS LIBRARY"
+       WRITE(6,*) "D2P INPUT DATA     : "
+       WRITE(6,*) "    STATE VARIABLE : ", NPKEY
+       WRITE(6,*) "    OTHER VARIABLE : ", NOTH
+       WRITE(6,*) "D2P  TOTAL         = ", NPKEY+NOTH
+       WRITE(6,*) "XS LIBRARY CONTENT = ", NTOT
+       CALL XABORT ("=>PLEASE USE THE D2P CARD 'PKEY'AND/OR 'OTHER'")
+      ENDIF
+
+      IF (NPKEY .EQ. 0) THEN
+       WRITE(6,*) "@D2PPROC : NUMBER OF STATE VARIABLES IS ZERO"
+       CALL XABORT ("=> PLEASE CHECK THE D2P DATA INPUT ")
+      ENDIF
+      WRITE(IPPRC,*)'INFO := D2PINFO ; '
+      IF (LMEM) WRITE(IPPRC,*)'XSL := XSLIB ;'
+      WRITE(IPPRC,*)'INTEGER NVAR := ',NPKEY,' ; '
+      WRITE(IPPRC,*)'INTEGER STOP REWIND ITER := 0 0 0 ; '
+
+      WRITE(IPPRC,*)
+      WRITE(IPPRC,*)'WHILE STOP 1 <> DO'
+
+      WRITE(IPPRC,*)
+      WRITE(IPPRC,*)'!************************************************'
+      WRITE(IPPRC,*)'!  STEP 1 :   recovering state parameters       *'
+      WRITE(IPPRC,*)'!************************************************'
+      WRITE(IPPRC,*)
+
+      DO PK=1, 6
+      IF (LFLAG(PK)) THEN
+       WRITE(IPPRC,*) "GREP: INFO :: STEP UP 'BRANCH_INFO'"
+       WRITE(IPPRC,*) "GETVAL  STATE ",ORDER(PK)," NVAL 1 >>",
+     >  REFNAM(PK),"_VAL<< ;"
+      ENDIF
+      ENDDO
+
+      WRITE(IPPRC,*)
+      WRITE(IPPRC,*)'!************************************************'
+      WRITE(IPPRC,*)'!  STEP 2 :   interpolation of cross sections   *'
+      WRITE(IPPRC,*)'!  warning => check the isotopes names          *'
+      WRITE(IPPRC,*)'!************************************************'
+      WRITE(IPPRC,*)
+
+      WRITE(IPPRC,*)'EVALUATE ITER := ITER 1 + ;'
+      IF (ITYP.EQ.0) WRITE(IPPRC,*)'  Micro := SCR: ',NAMSAP,' ::'
+      IF (ITYP.EQ.1) WRITE(IPPRC,*)'  Micro := NCR: ',NAMSAP,' ::'
+      WRITE(IPPRC,*)'   EDIT ',IPRINT
+      IF (ITYP.EQ.0) THEN
+       IF (HEQUI.NE.'NONE') WRITE(IPPRC,*)'   EQUI ',HEQUI
+       IF (HMASL.NE.'NONE') WRITE(IPPRC,*)'   MASL ',HMASL
+      ENDIF
+
+      WRITE(IPPRC,*)'   MICRO LINEAR NMIX 1'
+      IF (ITYP.EQ.0)WRITE(IPPRC,*)'   SAPHYB ',NAMSAP
+      IF (ITYP.EQ.1)WRITE(IPPRC,*)'   COMPO ',NAMSAP,' ',
+     >              TRIM(MIXDIR)
+
+      WRITE(IPPRC,*)'   MIX 1'
+      DO IOTH=1,NOTH
+      WRITE(IPPRC,'(A,A)',advance='no')'     SET LINEAR ',
+     > TRIM(OTHPK(IOTH))
+      SELECT CASE (OTHTYP(IOTH))
+       CASE (1)
+        WRITE(IPPRC,*) ' ',INT(OTHVAR(IOTH))
+       CASE (2)
+        WRITE(IPPRC,*) ' ',OTHVAR(IOTH)
+       CASE (3)
+        WRITE(IPPRC,*) " '", TRIM(OTHVAC(IOTH)),"'"
+      END SELECT
+      ENDDO
+      DO PK=1,6
+       IF (LFLAG(PK)) THEN
+      WRITE(IPPRC,*)'     SET LINEAR <<',REFNAM(PK),'>> <<',
+     >               REFNAM(PK),'_VAL>>'
+       ENDIF
+      ENDDO
+
+      IF (JOBOPT(2).EQ.'T') THEN
+       CALL LCMSIX(IPDAT,'',0)
+       CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
+       CALL LCMSIX(IPDAT,'ISOTOPES',1)
+       CALL LCMGTC(IPDAT,'XE135',12,ISOTOPES(1))
+       CALL LCMGTC(IPDAT,'I135',12,ISOTOPES(2))
+       CALL LCMGTC(IPDAT,'SM149',12,ISOTOPES(3))
+       CALL LCMGTC(IPDAT,'PM149',12,ISOTOPES(4))
+       CALL LCMGTC(IPDAT,'PM148',12,ISOTOPES(5))
+       CALL LCMGTC(IPDAT,'PM148M',12,ISOTOPES(6))
+       CALL LCMGTC(IPDAT,'ND147',12,ISOTOPES(7))
+       CALL LCMGTC(IPDAT,'PM147',12,ISOTOPES(8))
+       WRITE(IPPRC,*)'     MICRO ALL'
+
+      DO I=1,8
+      SELECT CASE (ISOTOPT)
+      CASE ('*')
+       WRITE(IPPRC,*)"     '",TRIM(ISOTOPES(I)),"'  *"
+      CASE DEFAULT
+       IF ((I.EQ.1).OR.(I.EQ.3).OR.(I.EQ.8)) THEN
+         WRITE(IPPRC,*)"     '",TRIM(ISOTOPES(I)),"'  *"
+       ELSE
+        WRITE(IPPRC,*)"     '",TRIM(ISOTOPES(I)),"'",ISOTVAL
+       ENDIF
+      END SELECT
+      ENDDO
+      ENDIF
+      WRITE(IPPRC,*)'    ENDMIX'
+
+      IF ((JOBOPT(9).EQ.'T').AND.(ITYP.EQ.0) ) THEN
+       WRITE(IPPRC,*)"    CHAIN"
+       WRITE(IPPRC,*)"     ",TRIM(ISOTOPES(2)),"  NG 0.0"
+       WRITE(IPPRC,*)"     ",TRIM(ISOTOPES(7)),"  NG 0.0"
+       WRITE(IPPRC,*)"     ",TRIM(ISOTOPES(1)),
+     >  "  NG 0.0 FROM DECAY 1.0E+00 ",TRIM(ISOTOPES(2))
+       WRITE(IPPRC,*)"     ",TRIM(ISOTOPES(8)),
+     >  "  NG 0.0 FROM DECAY 1.0E+00 ",TRIM(ISOTOPES(7))
+       WRITE(IPPRC,*)"     ",TRIM(ISOTOPES(5)),
+     >  "  NG 0.0 FROM NG    5.3E-01 ",TRIM(ISOTOPES(8))
+       WRITE(IPPRC,*)"     ",TRIM(ISOTOPES(6)),
+     >  " NG 0.0 FROM NG    4.7E-01 ",TRIM(ISOTOPES(8))
+       WRITE(IPPRC,*)"     ",TRIM(ISOTOPES(4)),
+     > "  NG 0.0 FROM NG    1.0E+00 ",TRIM(ISOTOPES(5)),
+     > " NG 1.0E+00 ",TRIM(ISOTOPES(6))
+       WRITE(IPPRC,*)"     ",TRIM(ISOTOPES(3)),
+     >  "  NG 0.0 FROM DECAY 1.0E+00 ",TRIM(ISOTOPES(4))
+       WRITE(IPPRC,*)"      MACR     NFTOT 0.0"
+       WRITE(IPPRC,*)"    ENDCHAIN"
+      ENDIF
+      WRITE(IPPRC,*)'    ;'
+      WRITE(IPPRC,*)
+      WRITE(IPPRC,*)'!************************************************'
+      WRITE(IPPRC,*)'!  STEP 3 :   branching calculation             *'
+      WRITE(IPPRC,*)'!************************************************'
+      WRITE(IPPRC,*)
+      WRITE(IPPRC,*)"IF ITER 1 = THEN "
+      WRITE(IPPRC,*)"HELIOS GENPMAXS INFO Micro := D2P: "
+      WRITE(IPPRC,*)"Micro INFO ",
+     >  NAMSAP," ::"
+      WRITE(IPPRC,*)"PHASE 2 EDIT",IPRINT,";"
+      WRITE(IPPRC,*)"ELSE"
+      WRITE(IPPRC,*)"HELIOS GENPMAXS INFO Micro := D2P: "
+      WRITE(IPPRC,*)"Micro INFO GENPMAXS ",
+     >  NAMSAP," HELIOS ::"
+      WRITE(IPPRC,*)"PHASE 2 EDIT",IPRINT,";"
+      WRITE(IPPRC,*)
+      WRITE(IPPRC,*)"ENDIF ;"
+      WRITE(IPPRC,*)"Micro := DELETE: Micro ;"
+      WRITE(IPPRC,*)
+      WRITE(IPPRC,*)"GREP: INFO :: STEP UP 'BRANCH_INFO'"
+      WRITE(IPPRC,*)"GETVAL REWIND 1 NVAL 1 >>REWIND<< ;"
+
+      WRITE(IPPRC,*)'!************************************************'
+      WRITE(IPPRC,*)'!  STEP 4 :   storing the current branch        *'
+      WRITE(IPPRC,*)'!************************************************'
+      WRITE(IPPRC,*)
+      WRITE(IPPRC,*)"IF REWIND 1 = THEN"
+      WRITE(IPPRC,*)
+      WRITE(IPPRC,*)" HELIOS GENPMAXS INFO := D2P: INFO "
+      WRITE(IPPRC,*)" GENPMAXS HELIOS ::"
+      WRITE(IPPRC,*)" PHASE 3 EDIT",IPRINT," ;"
+
+      WRITE(IPPRC,*)" GREP: INFO :: STEP UP 'BRANCH_INFO'"
+      WRITE(IPPRC,*)" GETVAL STOP 1 NVAL 1 >>STOP<< ;"
+
+      WRITE(IPPRC,*)"ENDIF ;"
+      WRITE(IPPRC,*)
+      WRITE(IPPRC,*)"ENDWHILE ;"
+      WRITE(IPPRC,*)
+      WRITE(IPPRC,*)"END: ;"
+      WRITE(IPPRC,*)"QUIT ."
+      DEALLOCATE(PKEY)
+      DEALLOCATE(OTHPK,OTHTYP,OTHVAC,OTHVAR)
+      END
diff --git a/Donjon/src/D2PREF.f b/Donjon/src/D2PREF.f
new file mode 100644
index 0000000..0ea9a2b
--- /dev/null
+++ b/Donjon/src/D2PREF.f
@@ -0,0 +1,145 @@
+*DECK D2PREF
+      SUBROUTINE D2PREF( IPDAT,   NVAR,   CRDINF,   NCRD,  GRID,  PKIDX,
+     >                   PKNAM, IPRINT                                 )
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Select the reference state. This routine determine the reference state
+* for all cases of meshing
+*
+*Author(s): 
+* J. Taforeau
+*
+*Parameters: input
+* IPDAT   address of info data block
+* NVAR    number of state variables
+* CRDINF  control rod compostition array
+* NCRD    number of crontrol rod comosition
+* GRID    type of griddind for branching calculation
+*
+*Parameters: 
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPDAT
+      INTEGER NVAR,NBR,NCRD,GRID
+      INTEGER CRDINF(NCRD)
+      INTEGER PKIDX(NVAR)
+      CHARACTER*12 PKNAM(6)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER ITYLCM,i,IDX
+      INTEGER :: IP = 2
+      INTEGER STAIDX(NVAR),REFIDX(NVAR)
+      INTEGER NVALPA(NVAR)
+      REAL STATE(NVAR) ,REFSTA(NVAR-1),HSTSTA(NVAR-1)
+      REAL VALPAR(NVAR,100)
+      CHARACTER(LEN=12) PKEY(NVAR),BARNAM
+      CHARACTER*12,DIMENSION(6) :: PKREF
+      DATA PKREF/ "BARR","DMOD","CBOR","TCOM","TMOD","BURN"/
+      ! RECOVER INFORMATION FROM INFO DATA BLOCK
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
+      CALL LCMGTC(IPDAT,'STATE_VAR',12,NVAR,PKEY)
+
+      !INITIALIZATION OF THE NUMBER OF BRANCHES TO BE CALCULATED
+
+      VALPAR(:NVAR,:100)=0.0
+      NBR=1
+      DO i=1, NVAR
+         IF (PKIDX(i).EQ.-1) THEN
+          IDX=1
+         ELSE
+          IDX=PKIDX(i)
+         ENDIF
+         CALL LCMLEN(IPDAT,PKREF(IDX),NVALPA(i),ITYLCM)
+         CALL LCMGET(IPDAT,PKREF(IDX),VALPAR(i,1:NVALPA(i)))
+      ENDDO
+
+      DO i=1, NVAR
+         IF (PKIDX(i).EQ.-1) THEN
+          IDX=1
+         ELSE
+          IDX=PKIDX(i)
+         ENDIF
+        ! ATTRIBUTION OF VALUES FOR THE BARR PARAMETERS
+         IF (PKREF(IDX)==PKREF(1)) THEN
+          BARNAM=PKNAM(1)
+          REFSTA(1)= CRDINF(1)
+          HSTSTA(1)= CRDINF(1)
+          REFIDX(1)=1         ! INITIALIZATION OF BARR REFERENCE INDEX
+          STATE(1)=CRDINF(1)  ! ATTRIBUTION OF  CONTROL ROD COMPOSITION
+          STAIDX(1)=1    ! ATTRIBUTION OF  CONTROL ROD COMPOSITION INDEX
+          NBR=NBR*NVALPA(i)   ! CALCULATION OF NUMBER OF BRANCHES
+         ! IDEM FOR BURN PARAMETERS
+         ELSE IF (PKREF(IDX)==PKREF(6)) THEN
+          STATE(NVAR)=VALPAR(i,1)
+          STAIDX(NVAR)=1
+          REFIDX(NVAR)=1
+          !IDEM FOR OTHER PARAMETERS
+         ! EXIT
+
+         ELSE
+
+         ! THE REFERENCE STATES IS SET TO THE MIDDLE VALUE IN THE LIST
+          REFSTA(IP)=VALPAR(i,NINT(NVALPA(i)/2.0))
+          HSTSTA(IP)= VALPAR(i,NINT(NVALPA(i)/2.0))
+          REFIDX(IP)=NINT(NVALPA(i)/2.0)
+          STATE(IP)=REFSTA(IP)
+          STAIDX(IP)=NINT(NVALPA(i)/2.0)
+          NBR=NBR*NVALPA(i)
+          IP=IP+1
+         ENDIF
+      ENDDO
+
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
+      CALL LCMPUT(IPDAT,'PRINT',1,1,1)
+
+      IF((NBR>9999).OR.(GRID==0)) THEN
+         ! IN THE CASE WHERE THE NUMBER OF BRANCHES EXCEED 999, A
+         ! DEFAULT BANCHING CALCULATION IS CALLED
+         GRID = 0
+         CALL D2PDEF( IPDAT,  PKEY, VALPAR,   NVALPA,  STAIDX, REFIDX,
+     >                REFSTA,HSTSTA,  STATE,   CRDINF,    NCRD,  NVAR,
+     >                PKIDX ,IPRINT                                  )
+      ELSE
+         ! UPDATE THE INFO DATA BLOCK
+         ! WITH THE INITIAL MESHING FROMSAPHYB
+         CALL LCMSIX(IPDAT,' ',0)
+         CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
+         CALL LCMPTC(IPDAT,'BRANCH',12,BARNAM)
+         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,'REF_INDEX',NVAR,1,REFIDX)
+         CALL LCMPUT(IPDAT,'BRANCH_NB',1,1,NBR)
+         CALL LCMPUT(IPDAT,'STATE',NVAR,2,STATE)
+         CALL LCMPUT(IPDAT,'STATE_INDEX',NVAR,1,STAIDX)
+         CALL LCMPUT(IPDAT,'BRANCH_INDEX',1,1,1)
+         CALL LCMPUT(IPDAT,'REWIND',1,1,1)
+         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) : N"
+          IF(GRID==4) WRITE(6,*) "MESHING: NEW GRID WITH ADDITIONAL PTS"
+          IF(GRID==3) WRITE(6,*) "MESHING: SAP/MCO WITH ADDITIONAL PTS"
+          IF(GRID==2) WRITE(6,*) "MESHING: USER DEFINED "
+          IF(GRID==1) WRITE(6,*) "MESHING: SAP/MCO "
+          WRITE(6,*) "STATE PARAMETERS : ",PKEY(1:NVAR)
+          WRITE(6,*) "REFERENCE STATES VALUES :", REFSTA
+          WRITE(6,*) "INITIAL STATES VALUES :", STATE
+          WRITE(6,*) "INITIAL STATES INDEX VALUES :", STAIDX
+         ENDIF
+
+      ENDIF
+      END
diff --git a/Donjon/src/D2PREO.f b/Donjon/src/D2PREO.f
new file mode 100644
index 0000000..c118c7a
--- /dev/null
+++ b/Donjon/src/D2PREO.f
@@ -0,0 +1,64 @@
+*DECK D2PREO
+      SUBROUTINE D2PREO(IPDAT,VALPAR,IND,NPAR,NVAL,IPRINT)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* take into account the meanning of the control rod composition in
+* Saphyb, attribute to each value of control rod the corresponding value
+* in GENMAPXS formalism
+*
+*Author(s): 
+* J. Taforeau
+*
+*Parameters: input
+* IPDAT   address of the INFO data block
+* VALPAR  vector of values for each state variable
+* IND     index of the control rod parameter
+* NPAR    number of state variables
+* NVAL    number of values for control rod parameter
+* IPRINT  control the printing on screen
+*
+*Parameters: 
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPDAT
+      INTEGER NVAL
+      REAL VALPAR(NPAR,100)
+*----
+*  LOCAL VARIABLES
+*----
+      ! USER INPUT: MEANING OF BARR PARAMETERS : LOCATED AT INFO/CRDINF
+      INTEGER CRDINF(NVAL)
+
+      ! RECOVER CRDINF DATA BLOCK
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMGET(IPDAT,'BARR_INFO',CRDINF)
+
+      DO I=1, NVAL
+        VALPAR(IND,I)=CRDINF(I)
+        IF (CRDINF(I)<0) THEN
+          CALL XABORT('@D2PREO: CONTROL ROD COMPO MUST BE POSITIVE')
+        ENDIF
+      ENDDO
+      ! ATTRIBUTION OF CRDINF TO THE BARR PARAMETERS
+
+      CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
+
+      ! EDIT THE LISTING FILE
+      IF(IPRINT > 1)  THEN
+        WRITE(6,*)
+        WRITE(6,*) "******  CONTROL ROD COMPOSITION (IN SAPHYB) ******"
+        WRITE(6,*)
+        WRITE(6,*) "UNRODDED CROSS SECTIONS :",VALPAR(IND,1)
+        DO J=2, NVAL
+         WRITE(6,*) "RODDED COMPOSITION ",J-1,": ",VALPAR(IND,J)
+        ENDDO
+        WRITE(6,*)
+      ENDIF
+      END
diff --git a/Donjon/src/D2PRFL.f b/Donjon/src/D2PRFL.f
new file mode 100644
index 0000000..d9d6429
--- /dev/null
+++ b/Donjon/src/D2PRFL.f
@@ -0,0 +1,262 @@
+*DECK D2PRFL
+      SUBROUTINE D2PRFL(  IPDAT, IPMIC , IPRINT,    NBU,   NGP,   NBMIX,
+     >                    NANI,   NVAR,  STAIDX,   LADF,  NADF,   NTYPE)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover macroscopic and microscopic cross sections from a microlib
+* object and write cross sections for one branch at a fixed burnup point
+* in the INFO data block.
+* WARNING: 04/2014 The information recovered by this routine is exactly
+* the same than GET_MACROLIB_XS but is used for reflector case, in this
+* case the following reactions are set to zero :
+*  DET(IGR) = 0
+*  SFI(IGR) = 0
+*  KAPPA_FI(IGR)= 0
+*  FLUX(IGR) = 0
+*  VELINV(IGR) = 0
+*  CHI_SPEC(IGR) = 0
+*  X_NU_FI(IGR) = 0
+*  KAPPA_FI(IGR) = 0
+*  XENG(IGR)=0
+*  SMNG(IGR)=0
+* NB : for reflector case, the upscattering is fixed to zero
+*
+*Author(s): 
+* J. Taforeau
+*
+*Parameters: input
+* IPDAT   address of info data block
+* IPMIC   address of the microlib object
+* NBU     number of burnup points
+* NBMIX   number of mixturess
+* NGP     number of energy groups
+* NANI    number of anisotropy
+* NVAR    number of state variables
+* STAIDX  table of states index order
+* NADF    number of ADF to be recovered
+* NTYPE   number  of adf type
+* LADF    flag for adf
+*
+*Parameters: 
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPDAT,IPMIC
+      INTEGER STAIDX(NVAR)
+      INTEGER NBU,NVAR,NBMIX,NGP,NANI,NADF,NTYPE
+      LOGICAL LADF
+*----
+*  LOCAL VARIABLES
+*----
+      TYPE(C_PTR) JPMIC,KPMIC,IPTH,KPTH
+      INTEGER NSCAT,MIX
+      INTEGER IJJ(NBMIX),NJJ(NBMIX),IPOS(NBMIX)
+      REAL GAR2(NGP,NGP,NBMIX,NANI),GAR3(NBMIX*NGP)
+      REAL XSECT(NGP,NBMIX)          ! TOTAL CROSS SECTIONS
+      REAL KAPPA_FI(NGP)             ! KAPPA FISSION CROSS SECTIONS
+      REAL X_NU_FI(NGP)              ! NU SIGMA FISSION CROSS SECTIONS
+      REAL XTR(NGP)                  ! TRANSPORT CROSS SECTIONS
+      REAL DIFF(NGP,NBMIX)           ! DIFFUSION COEFF
+      REAL SCAT(NGP,NBMIX)           ! SCATTERING CROSS SECTIONS
+      REAL DET(NGP)                  ! DETECTOR CROSS SECTIONS
+      REAL SFI(NGP)                  ! FISSION CROSS SECTIONS
+      REAL ABSORPTION(NGP)           ! ABSORPTION CROSS SECTIONS
+      REAL SCAT_MAT(NGP*NGP)         ! SCATTERING MATRIX
+      REAL SCAT_TMP(NGP,NGP,NBMIX,NANI)  ! TEMPORARY SCATTERING MATRIX
+      REAL FLUX(NGP)
+      REAL VELINV(NGP)
+      REAL XENG(NGP)
+      REAL CHI_SPEC(NGP),VOLUME(NBMIX)
+      REAL SMNG(NGP),FLXHET(NGP*NBMIX),FLXHOM(NGP,NBMIX)
+      REAL FLXL(NGP),FLXR(NGP),CURL(NGP),CURR(NGP)
+      REAL ADF(NADF,NGP)
+      CHARACTER CM*2,ADF_T*3
+      CHARACTER*8 ADFD(NADF),HADF(NTYPE),HFLX(2),HCUR(2)
+      IF(IPRINT > 0)  THEN
+        WRITE(6,*)
+        WRITE(6,*) "****** RECOVER REFLECTOR CROSS SECTIONS ******"
+      ENDIF
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
+      IF(LADF) THEN
+       ADF_T="   "
+       CALL LCMGTC(IPDAT,'ADF_TYPE',3,ADF_T)
+       IF ((ADF_T.NE.'DRA').AND.(ADF_T.NE.'GEN')) THEN
+        WRITE(6,*)'@D2PRFL:',ADF_T,'ADF NOT SUPPORTED ',
+     >  'WITH REFL CALCULATION'
+        CALL XABORT('')
+       ENDIF
+       IF ((ADF_T.EQ.'DRA')) THEN
+        CALL LCMGTC(IPDAT,'HADF',8,NADF,ADFD)
+       ELSE IF ((ADF_T.EQ.'GEN')) THEN
+        CALL LCMGTC(IPDAT,'HFLX',8,2,HFLX)
+        CALL LCMGTC(IPDAT,'HCUR',8,2,HCUR)
+       ENDIF
+
+      ENDIF
+
+      CALL LCMGET(IPDAT,'MIX',MIX)
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPMIC,' ',0)
+      CALL LCMSIX(IPMIC,'MACROLIB',1)
+      CALL LCMGET(IPMIC,'VOLUME',VOLUME)
+
+      IF (LADF) THEN
+        CALL LCMSIX(IPMIC,'ADF',1)
+        CALL LCMGTC(IPMIC,'HADF',8,NTYPE,HADF)
+        ITYPE=1
+       IF ((ADF_T.EQ.'DRA')) THEN
+        DO ITYPE=1,NTYPE
+         CALL LCMGET(IPMIC,HADF(ITYPE),FLXHET)
+         DO I=1,NADF
+          IF(HADF(ITYPE).EQ.ADFD(I))THEN
+           DO IGR=1, NGP
+             ADF(I,IGR)= FLXHET((IGR-1)*NBMIX+MIX)
+           ENDDO
+          ENDIF
+         ENDDO
+        ENDDO
+       ELSE IF ((ADF_T.EQ.'GEN')) THEN
+        DO ITYPE=1,NTYPE
+         CALL LCMGET(IPMIC,HADF(ITYPE),FLXHET)
+         IF(HADF(ITYPE).EQ.HFLX(1))THEN
+          FLXL(:)=FLXHET
+         ENDIF
+         IF (HADF(ITYPE).EQ.HFLX(2))THEN
+          FLXR(:)=FLXHET
+         ENDIF
+         IF (HADF(ITYPE).EQ.HCUR(1))THEN
+          CURL(:)=FLXHET
+         ENDIF
+         IF (HADF(ITYPE).EQ.HCUR(2))THEN
+          CURR(:)=FLXHET
+         ENDIF
+        ENDDO
+       ENDIF
+       CALL LCMSIX(IPMIC,'',2)
+
+      ENDIF
+
+      JPMIC=LCMGID(IPMIC,'GROUP')
+
+      !  RECOVER CROSS SECTIONS INFORMATION
+      DO IGR=1,NGP
+       WRITE(6,'(/28H PROCESS ENERGY GROUP NUMBER,I4)') IGR
+       KPMIC=LCMGIL(JPMIC,IGR)
+       CALL LCMLEN(KPMIC,'NTOT0',ILONG,ITYLCM)
+
+       IF(ILONG.NE.NBMIX) THEN
+         CALL XABORT('D2P: MORE THAN ONE MIXTURE IN SAPHYB')
+       ENDIF
+       CALL LCMGET(KPMIC,'FLUX-INTG',FLXHOM(IGR,1:NBMIX))
+       CALL LCMGET(KPMIC,'NTOT0',XSECT(IGR,1:NBMIX))
+       CALL LCMGET(KPMIC,'SIGS00',SCAT(IGR,1:NBMIX))
+       CALL LCMGET(KPMIC,'DIFF',DIFF(IGR,1:NBMIX))
+       ABSORPTION(IGR)=XSECT(IGR,MIX)-SCAT(IGR,MIX)
+       IF (LADF) ADF(:,IGR)= VOLUME * ADF(:,IGR) / FLXHOM(IGR,MIX)
+       DET(IGR) = 0
+       SFI(IGR) = 0
+       KAPPA_FI(IGR)= 0
+       FLUX(IGR) = 0
+       VELINV(IGR) = 0
+       CHI_SPEC(IGR) = 0
+       X_NU_FI(IGR) = 0
+       KAPPA_FI(IGR) = 0
+       XENG(IGR)=0
+       SMNG(IGR)=0
+       XTR(IGR)=1/(3*DIFF(IGR,MIX))
+
+       GAR2(:NGP,:NGP,:NBMIX,:NANI)=0.0
+       DO IL=1,NANI
+          WRITE(CM,'(I2.2)') IL-1
+          LENGTH=1
+          IF(IL.GT.1) CALL LCMLEN(KPMIC,'SCAT'//CM,LENGTH,ITYLCM)
+          IF(LENGTH.GT.0) THEN
+           CALL LCMGET(KPMIC,'SCAT'//CM,GAR3)
+           CALL LCMGET(KPMIC,'NJJS'//CM,NJJ)
+           CALL LCMGET(KPMIC,'IJJS'//CM,IJJ)
+           CALL LCMGET(KPMIC,'IPOS'//CM,IPOS)
+           DO IMIL=1,NBMIX
+            IPOSDE=IPOS(IMIL)
+            DO JGR=IJJ(IMIL),IJJ(IMIL)-NJJ(IMIL)+1,-1
+             GAR2(IGR,JGR,IMIL,IL)=GAR3(IPOSDE) ! IGR <-- JGR
+             SCAT_TMP(IGR,JGR,IMIL,IL)=GAR2(IGR,JGR,IMIL,IL)
+             IPOSDE=IPOSDE+1
+            ENDDO
+           ENDDO
+          ENDIF
+         ENDDO
+      ENDDO
+
+      NSCAT=1
+      DO J=1, NGP
+         DO I=1, NGP
+          SCAT_MAT(NSCAT)=SCAT_TMP(I,J,MIX,1) ! I <-- J
+          IF(NSCAT==3) SCAT_MAT(NSCAT)=0
+          NSCAT=NSCAT+1
+         ENDDO
+      ENDDO
+
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
+      IF(STAIDX(NVAR)==1) THEN
+        IPTH=LCMLID(IPDAT,'CROSS_SECT',NBU)
+      ELSE
+        IPTH=LCMGID(IPDAT,'CROSS_SECT')
+      ENDIF
+
+      KPTH=LCMDIL(IPTH,STAIDX(NVAR))
+      CALL LCMSIX(KPTH,'MICROLIB_XS',1)
+
+      CALL LCMPUT(KPTH,'XENG',NGP,2,XENG)
+      CALL LCMPUT(KPTH,'SMNG',NGP,2,SMNG)
+
+      CALL LCMSIX(KPTH,' ',2)
+      CALL LCMSIX(KPTH,'MACROLIB_XS',1)
+
+      CALL LCMPUT(KPTH,'XTR',NGP,2,XTR)
+      CALL LCMPUT(KPTH,'ABSORPTION',NGP,2,ABSORPTION)
+      CALL LCMPUT(KPTH,'X_NU_FI',NGP,2,X_NU_FI)
+      CALL LCMPUT(KPTH,'KAPPA_FI',NGP,2,KAPPA_FI)
+      CALL LCMPUT(KPTH,'SFI',NGP,2,SFI)
+      CALL LCMPUT(KPTH,'DET',NGP,2,DET)
+      CALL LCMPUT(KPTH,'SCAT',NGP*NGP,2,SCAT_MAT)
+      IF (LADF) THEN
+       IF (ADF_T.EQ.'DRA') THEN
+        CALL LCMPUT(KPTH,'ADF',NADF*NGP,2,ADF)
+       ELSE IF (ADF_T.EQ.'GEN') THEN
+        CALL LCMPUT(KPTH,'FLXL',NGP,2,FLXL)
+        CALL LCMPUT(KPTH,'FLXR',NGP,2,FLXR)
+        CALL LCMPUT(KPTH,'CURL',NGP,2,CURL)
+        CALL LCMPUT(KPTH,'CURR',NGP,2,CURR)
+       ENDIF
+      ENDIF
+      IF(IPRINT>1) THEN
+         WRITE(6,*)
+         WRITE(6,*) "**** MACROSCOPIC cross sections (1:NGP) ****"
+         WRITE(6,*) "TOTALE                  :",XSECT(:,MIX)
+         WRITE(6,*) "DIFFUSION               :",DIFF(:,MIX)
+         WRITE(6,*) "TRANSPORT               :",XTR
+         WRITE(6,*) "ABSORPTION              :",ABSORPTION
+         WRITE(6,*) "NU FISSION              :",X_NU_FI
+         WRITE(6,*) "KAPPA FISSION           :",KAPPA_FI
+         WRITE(6,*) "DETECTOR                :",DET
+         WRITE(6,*) "SCATTERING (g to g')    :",SCAT_MAT
+         IF (LADF) THEN
+          IF (ADF_T.EQ.'DRA') THEN
+           WRITE(6,*) "ADF([N/E/W/S]||[W/E])   :",ADF
+          ELSE IF (ADF_T.EQ.'GEN') THEN
+           WRITE(6,*) "WEST FLUX BOUNDARY      :",FLXL
+           WRITE(6,*) "EST FLUX BOUNDARY       :",FLXR
+           WRITE(6,*) "WEST CURRENT BOUNDARY   :",CURL
+           WRITE(6,*) "EST CURRENT BOUNDARY    :",CURR
+          ENDIF
+         ENDIF
+      ENDIF
+      END
diff --git a/Donjon/src/D2PSAP.f b/Donjon/src/D2PSAP.f
new file mode 100644
index 0000000..ff3b5eb
--- /dev/null
+++ b/Donjon/src/D2PSAP.f
@@ -0,0 +1,655 @@
+*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,   LYLD,    YLD, YLDOPT,
+     >                   LOCYLD,   HDET                                )
+*
+*-----------------------------------------------------------------------
+*
+*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
+* LYLD    Fission Yield must be recovered
+* YLD     user defined values for fission yields (1:I, 2:XE, 3:PM)
+* LOCYLD  value for state parameter on which fission yield will be
+*         calculated
+* YLDOPT  option for fission yields calculation (DEF, MAN, FIX)
+* HDET    name of isotope for the detector cross sections
+*
+*-----------------------------------------------------------------------
+*
+      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),YLD(3),LOCYLD(5)
+      CHARACTER*3 ADF,YLDOPT
+      CHARACTER*12 USRPAR(12)
+      CHARACTER*5 MESH
+      CHARACTER*12 PKNAM(6)
+      CHARACTER*12 ISOT(8)
+      LOGICAL SAP, MIC, EXC,SCAT,LADD,LNEW,LADF,LYLD
+      CHARACTER*12 HDET
+*----
+*  LOCAL VARIABLES
+*----
+      TYPE(C_PTR)  IPROOT,IPTH,KPTH
+
+      PARAMETER(NDIMSAP=50)
+      INTEGER :: N_XS = 8
+      INTEGER,DIMENSION(6)  :: ORDER_VAL = 0
+      INTEGER DIMSAP(NDIMSAP)
+      INTEGER NPAR,NCALS,NSVAR,NBREA,ITYLCM,VALTOT
+      INTEGER NCRD_SAP,NVALTMP(10)
+      INTEGER i, j, k, l , n, UV,ILONG
+      INTEGER :: NTOT = 0
+      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=12)   PKEY_BARR(6)
+      CHARACTER*12,DIMENSION(6) :: PKREF
+      DATA PKREF/ "BARR","DMOD","CBOR","TCOM","TMOD","BURN"/
+
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: NVAL,RANK,RANK_INDEX,PKIDX
+      CHARACTER(LEN=12), 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
+      DIMSAP(:NDIMSAP)=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),NVAL(NPAR),RANK(NPAR))
+      ALLOCATE (PKEY_TMP(NPAR),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 LCMLEN(IPSAP,'PARKEY',ILONG,ITYLCM)
+      CALL LCMGTC(IPSAP,'PARKEY',4,NPAR,PKEY)
+      CALL LCMGET(IPSAP,'NVALUE',NVAL)
+      IF(NPAR.GT.10) CALL XABORT('D2PSAP: NVAL OVERFLOW.')
+      NVALTMP(:NPAR)=NVAL(:NPAR)
+      CALL LCMSIX(IPSAP,' ',0)
+      CALL LCMSIX(IPSAP,'paramvaleurs',1)
+      ! LOOP OVER STATE VARIABLES OF SAPHYB
+      ! CHECK OF EXISTENCE OF STATE PARAMETER
+      PKEY (1:NPAR) (5:12) = "        "
+
+      DO i=1, NPAR
+        IF ((PKEY(i).NE.'FLUE').AND.(PKEY(i).NE.'TIME')) NTOT=NTOT+1
+        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
+      DO i=1, NPAR
+        PKEY_TMP(i)=PKEY(i)
+      ENDDO
+
+      IF(.NOT.LBURN) THEN
+        WRITE(6,*)
+        WRITE(6,*)('WARNING: BURN VARIABLE IS MISSING IN MCO')
+        WRITE(6,*)('=> 0 MWJ/T SINGLE EXPOSURE IS ASSUMED')
+        WRITE(6,*)
+        DEALLOCATE (PKEY,NVAL)
+        NPAR=NPAR+1
+        ALLOCATE (PKEY(NPAR),NVAL(NPAR))
+        DO i=1, NPAR-1
+          PKEY(i)=PKEY_TMP(i)
+          NVAL(i)=NVALTMP(i)
+        ENDDO
+        PKEY(NPAR)="BURN"
+        NVAL(NPAR)=1
+        DEALLOCATE (PKEY_TMP)
+        ALLOCATE(PKEY_TMP (NPAR))
+        PKEY_TMP=PKEY
+      ENDIF
+
+      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
+
+      ALLOCATE (PVALDIR(NPAR),VALPAR(NPAR,100))
+
+      DO i=1, NPAR
+        ! NAME OF DIRECTORY IN SAPHYB CONTAINING VALUES OF STATE
+        IF ((PKEY(i).NE.PKNAM(6))) THEN
+         WRITE(PVALDIR(i),'("pval", I8)') i
+         CALL LCMGET(IPSAP,PVALDIR(i),VALPAR(i,1:NVAL(i)))
+        ELSE IF(LBURN) THEN
+         WRITE(PVALDIR(i),'("pval", I8)') i
+         CALL LCMGET(IPSAP,PVALDIR(i),VALPAR(i,1:NVAL(i)))
+        ELSE
+         VALPAR(i,1:NVAL(i))=0.0
+        ENDIF
+        ! 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
+        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
+        ELSE
+           RANK(i) = NPAR+i
+           RANK_INDEX(NPAR+1)=NPAR+1
+        END IF
+      ENDDO
+
+      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,'NTOT',1,1,NTOT)
+      CALL LCMPTC(IPDAT,'STATE_VAR',12,NSVAR,PKEY)
+      IF(.NOT.(LBARR)) THEN
+        PKEY_BARR(1)="BARR        "
+        DO j=1, NSVAR
+          PKEY_BARR(j+1)=PKEY(j)
+        ENDDO
+        ! CREATION OF : INFO/SAPHYB_INFO/STATE_VAR
+        CALL LCMPTC(IPDAT,'STATE_VAR',12,NSVAR+1,PKEY_BARR)
+        ! CREATION OF : INFO/SAPHYB_INFO/BARR
+        CALL LCMPUT(IPDAT,'BARR',1,2,1.0)
+        STAVEC(2) = NSVAR + 1 ! NVAR
+!        NSVAR=NSVAR+1
+      ENDIF
+
+      ALLOCATE (PKIDX(STAVEC(2)))
+      PKIDX(:STAVEC(2))=0
+      IF (.NOT. LBARR) PKIDX(STAVEC(2))= -1
+
+      DO i=1, NSVAR
+        DO j=2,6
+           IF(PKEY(i)==PKNAM(j)) THEN
+            PKIDX(i)=j
+           ENDIF
+        ENDDO
+        IF(PKEY(i)==PKNAM(1)) THEN
+           IF (LBARR) PKIDX(i)=1
+           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('')
+           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,PKREF(PKIDX(i)),
+     1       NVAL(RANK_INDEX(RANK(i))),2,VALPAR(RANK_INDEX(RANK(i)),
+     2       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 BY 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,PKREF(PKIDX(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,PKREF(PKIDX(i)),
+     1     NVAL(RANK_INDEX(RANK(i))),2,VALPAR(RANK_INDEX(RANK(i)),
+     2     1:NVAL(RANK_INDEX(RANK(i)))) )
+        ENDIF
+      ENDDO
+
+      CALL LCMPUT(IPDAT,'PKIDX',STAVEC(2),1,PKIDX)
+
+      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
+      IF (LYLD) THEN
+       CALL LCMPTC(IPDAT,'YLD_OPT',3,YLDOPT)
+       CALL LCMPUT(IPDAT,'YLD_FIX',3,2,YLD)
+       CALL LCMPUT(IPDAT,'YLD_LOC',5,2,LOCYLD)
+      ENDIF
+
+      CALL LCMPTC(IPDAT,'ADF',3,ADF)
+      CALL LCMPUT(IPDAT,'LABS', 3,5,LABS)
+      CALL LCMPUT(IPDAT,'SCAT', 1,5,SCAT)
+      CALL LCMSIX(IPDAT,'ISOTOPES',1)
+      CALL LCMPTC(IPDAT,'XE135',12,ISOT(1))
+      CALL LCMPTC(IPDAT,'SM149',12,ISOT(2))
+      CALL LCMPTC(IPDAT,'I135',12,ISOT(3))
+      CALL LCMPTC(IPDAT,'PM149',12,ISOT(4))
+      CALL LCMPTC(IPDAT,'PM148',12,ISOT(5))
+      CALL LCMPTC(IPDAT,'PM148M',12,ISOT(6))
+      CALL LCMPTC(IPDAT,'ND147',12,ISOT(7))
+      CALL LCMPTC(IPDAT,'PM147',12,ISOT(8))
+      CALL LCMPTC(IPDAT,'DET',12,HDET)
+      ! 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 LCMPTC(KPTH,'NAME',12,PKNAM(1))
+           CALL LCMPUT(KPTH,'LFLAG',1,5,LBARR)
+         ELSE IF(J==2)THEN
+           IF(LDMOD) CALL LCMPTC(KPTH,'NAME',12,PKNAM(2))
+           CALL LCMPUT(KPTH,'LFLAG',1,5,LDMOD)
+         ELSE IF(J==3) THEN
+           IF(LCBOR) CALL LCMPTC(KPTH,'NAME',12,PKNAM(3))
+           CALL LCMPUT(KPTH,'LFLAG',1,5,LCBOR)
+         ELSE IF(J==4)THEN
+           IF(LTCOM) CALL LCMPTC(KPTH,'NAME',12,PKNAM(4))
+           CALL LCMPUT(KPTH,'LFLAG',1,5,LTCOM)
+         ELSE IF(J==5)THEN
+           IF(LTMOD) CALL LCMPTC(KPTH,'NAME',12,PKNAM(5))
+           CALL LCMPUT(KPTH,'LFLAG',1,5,LTMOD)
+         ELSE IF(J==6) THEN
+           CALL LCMPTC(KPTH,'NAME',12,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,*) "FLAG FOR 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
+         IF (STAVEC(21).EQ.1) THEN
+         WRITE(6,*)'WARNING => ADF ARE INTEGRATED IN CROSS SECTIONS'
+         CALL XABORT('STOP')
+         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)," PARAMETER :",
+     1    NVAL(RANK_INDEX(RANK(i)))
+          WRITE(6,*) "VALUES FOR ",PKEY(i)," PARAMETER :",
+     1    VALPAR(RANK_INDEX(RANK(i)),1:NVAL(RANK_INDEX(RANK(i))))
+          WRITE(6,*)
+         ENDDO
+        WRITE(6,*)
+        WRITE(6,*) "NAME OF FISSION PRODUCTS FOR FISSION YIELD :"
+        WRITE(6,*) "XE135  : ",ISOT(1)
+        WRITE(6,*) "SM149  : ",ISOT(2)
+        WRITE(6,*) "I135   : ",ISOT(3)
+        WRITE(6,*) "PM149  : ",ISOT(4)
+        WRITE(6,*) "PM148  : ",ISOT(5)
+        WRITE(6,*) "PM148M : ",ISOT(6)
+        WRITE(6,*) "ND147  : ",ISOT(7)
+        WRITE(6,*) "PM147  : ",ISOT(8)
+        WRITE(6,*)
+
+        IF (LYLD) THEN
+         WRITE(6,*) "OPTION FOR FISSION YIELD RECOVERY: ",YLDOPT
+         IF (STAVEC(22)>0) THEN
+          WRITE(6,*)"CORRECTION FOR SAMARIUM PRODUCTION IS APPLIED"
+         ENDIF
+          IF (YLDOPT.EQ.'MAN')THEN
+           WRITE(6,*)"LOCAL CONDITIONS SET BY THE USER :"
+           DO I=1,5
+            IF (LOCYLD(I).NE.-1) THEN
+             WRITE(6,*) PKNAM(I)," = ",LOCYLD(I)
+            ENDIF
+           ENDDO
+          ENDIF
+        ENDIF
+        WRITE(6,*)
+      ENDIF
+
+      ! free memory
+      DEALLOCATE (PKIDX)
+      DEALLOCATE (SV_VAL)
+      DEALLOCATE (VALPAR,PVALDIR)
+      DEALLOCATE (NOMREA)
+      DEALLOCATE (RANK_INDEX,PKEY_TMP)
+      DEALLOCATE (RANK,NVAL,PKEY)
+      RETURN
+      END
diff --git a/Donjon/src/D2PSEL.f b/Donjon/src/D2PSEL.f
new file mode 100644
index 0000000..2e459bc
--- /dev/null
+++ b/Donjon/src/D2PSEL.f
@@ -0,0 +1,397 @@
+*DECK D2PSEL
+      SUBROUTINE D2PSEL( IPDAT,  IPINP, STAVEC,BRANCH,  ITBRAN, STAIDX,
+     >                    NVAR, JOBOPT,    DEB,  FC1  ,    FC2,    FC3,
+     >                    FC4,   XSC,   IPRINT                        )
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Select the next branch calculation . This routine determines also
+* when to stop the calculation and updates the INFO data block.
+*
+*Author(s): 
+* J. Taforeau
+*
+*Parameters: input
+* IPDAT   address of info data block
+* IPINP   file unit of the GENPMAXS input file
+* JOBOPT  array for JOBOPT configuration
+* NGP     number of energy groups
+* BRANCH  nature of the current branch ( CR, DC, CB, TC, TM etc )
+* ITBRAN  index of the current branch
+* STAIDX  array of state variables index
+* NVAR    number of state variables
+* STAVEC  various parameters associated with the IPDAT structure
+* DEB     flag for D2PGEN
+*
+*Parameters: 
+* FC1     
+* FC2     
+* FC3     
+* FC4     
+* XSC     
+* IPRINT  
+* X       
+* 
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPDAT
+      INTEGER IPINP,STAVEC(40),NVAR,ITBRAN,IPRINT,DEB
+      INTEGER STAIDX(NVAR)
+      CHARACTER*4 BRANCH
+      CHARACTER JOBOPT(16)
+*----
+*  LOCAL VRAIABLES
+*----
+      TYPE(C_PTR) IPTH,KPTH
+      INTEGER CHANGE,ITYLCM,BRAIDX,PK
+      INTEGER FA_K
+      INTEGER :: IP = 0
+      INTEGER NVAL(NVAR),REFIDX(NVAR)
+      ! VALUES OF CURRENT STATE VARIABLE ( IE FOR THE CURRENT BRANCH
+      ! CALCULATION)
+      REAL  STATE(NVAR)
+      ! VALUES OF THE CHOOSEN REFERENCE STATE VARIABLES
+      REAL  REFSTA(NVAR)
+      ! VALUES OF STATES VARIABLES IN SAPHYB
+      REAL  VALPAR(NVAR,100)
+      REAL SFAC,BFAC,IUPS,VERS,XESM
+      CHARACTER*12 BARNAM
+      CHARACTER*12 PKEY(NVAR),PKNAM(6)
+      CHARACTER FILNAM*12,COM*40
+      CHARACTER*16 JOBTIT
+      CHARACTER*1 DER
+      CHARACTER*12,DIMENSION(6) :: PKREF
+      DATA PKREF/ "BARR","DMOD","CBOR","TCOM","TMOD","BURN"/
+      LOGICAL :: BRANCH_STOP = .FALSE.
+      LOGICAL :: ONE_VAL = .FALSE.
+      LOGICAL LFLAG(6)
+
+      VALPAR(:NVAR,:100)=0.0
+      ! RECOVER INFORMATION FROM INFO data block
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
+      CALL LCMGTC(IPDAT,'STATE_VAR',12,NVAR,PKEY)
+      DO PK=1, 6
+        IPTH=LCMGID(IPDAT,'PKEY_INFO')
+        KPTH=LCMDIL(IPTH,PK)
+        CALL LCMGET(KPTH,'LFLAG',LFLAG(PK))
+        IF (PK == 1 .OR. PK==6)THEN
+         CALL LCMGTC(KPTH,'NAME',12,PKNAM(PK))
+        ELSE
+         IF(LFLAG(PK)) CALL LCMGTC(KPTH,'NAME',12,PKNAM(PK))
+        ENDIF
+      ENDDO
+
+      BARNAM=PKNAM(1)
+      IP=0
+      IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 0'
+      ! RECOVER VALUES FOR STATE VARIABLES
+      DO i=1,6
+         IF (LFLAG(i).OR. i==1 .OR. i==6) THEN
+          IP=IP+1
+          CALL LCMLEN(IPDAT,PKREF(i),NVAL(IP),ITYLCM)
+          CALL LCMGET(IPDAT,PKREF(i),VALPAR(IP,1:NVAL(IP)))
+         ENDIF
+      ENDDO
+
+      ! RECOVER INFORMATION ABOUT THE CURRENT BRANCH CALCULATION
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
+      CALL LCMGET(IPDAT,'STATE',STATE)
+      CALL LCMGET(IPDAT,'REF_INDEX',REFIDX)
+      CALL LCMGET(IPDAT,'REF_STATE',REFSTA)
+      CALL LCMGET(IPDAT,'BRANCH_INDEX',BRAIDX)
+
+      DO i=1, NVAR
+
+        IF(BRANCH==PKEY(i)(:4)) THEN
+        BRAIDX=i
+!        IF (PKEY(i)(:4) == 'C-BO') CALL XABORT( 'STOP BRANCH')
+        ENDIF
+      ENDDO
+
+      ! initialization of the flag: CHANGE
+      CHANGE=1
+   30 DO i=1, NVAR
+       IF(i<=BRAIDX) THEN
+
+        IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 1'
+        ! A NEW BRANCH TYPE MUST BE SET IF THE CURRENT VALUE OF A
+        ! GIVEN STATE VARIABLE IS THE LAST OF THE LIST
+        IF(STAIDX(i)==NVAL(i)) THEN
+           IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 2'
+           ! WE KEEP THE FLAG CHANGE TO 1
+           CHANGE=CHANGE*1
+        ELSE
+          IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 3'
+          ! IF THE BRANCH INDEX CORREPOND TO THE LAST "REAL" STATE
+          ! VARIABLE (IE THE STATE VARIABLE BEFORE BURN)
+         IF((BRAIDX==NVAR-1)) THEN
+            IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 4'
+            ! THE CHANGE FLAG MUST BE SET TO FALSE
+           CHANGE=0
+           IF(NVAL(BRAIDX)==1) THEN
+             IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 5'
+             ! EXCEPT IF THERE IS ONLY ONE VALUE FOR THE STATE VARIABLE
+             ! IN THIS CASE THE CHANGE FLAG IS RESET TO 1
+             CHANGE=1
+           ENDIF
+         ELSE
+           ! IN OTHER CASE WE CONTINUE THE CURRENT BRANCH TYPE
+           ! CALCULATION
+           IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 6'
+           CHANGE=0
+           IF(NVAL(BRAIDX)==1) THEN
+             ! EXCEPT IF THERE IS ONLY ONE VALUE FOR THE STATE VARIABLE
+             ! IN THIS CASE THE CHANGE FLAG IS RESET TO 1
+             CHANGE=1
+           IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 7'
+           ENDIF
+         ENDIF
+        ENDIF
+       ENDIF
+      ENDDO
+      ONE_VAL=.FALSE.
+
+      IF(CHANGE==1) THEN
+         IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 8'
+         IF(NVAL(BRAIDX+1)==1 .and. (BRAIDX >.1))THEN
+          IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 9'
+          IF((BRAIDX+1)<(NVAR)) THEN
+           IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 10'
+           BRAIDX=BRAIDX+1
+           IF(NVAL(BRAIDX)==1) THEN
+             IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 11'
+            IF(BRAIDX==NVAR-1) THEN
+             IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 12'
+             BRANCH_STOP=.TRUE.
+            ELSE
+              IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 13'
+              ONE_VAL=.TRUE.
+            ENDIF
+           ENDIF
+          ELSE
+           IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 14'
+           BRANCH_STOP=.TRUE.
+          ENDIF
+         ENDIF
+
+         IF(ONE_VAL) GO TO 30
+
+         IF((BRAIDX+1)<(NVAR)) THEN
+          IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 15'
+          ! UPDATE OF THE INDEX OF THE BRANCH TYPE
+          BRAIDX=BRAIDX+1
+          ! UPDATE OF THE BRANCH TYPE
+          BRANCH=PKEY(BRAIDX) (:4)
+          ! INITIALIZATION OF THE INDEX OF THE BRANCH TYPE
+          ITBRAN=1
+          DO i=1,NVAR
+           IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 16'
+           IF(i<=BRAIDX) THEN
+            IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 17'
+            !INITIALIZATION AT THE FIRST VALUE OF STATE PARAMETERS
+            STATE(i)=VALPAR(i,1)
+            ! INITIALIZATION AT THE FIRST ORDER NUMBERS OF STATE
+            ! PARAMETERS
+            STAIDX(i)=1
+            ! CASE WHERE THE REFERENCE VALUE IS THE FIRST VALUE
+            ! (IE WHEN NVAL(BRAIDX) = 2)
+            IF(i==BRAIDX) THEN
+             IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 18'
+             IF(STAIDX(i)==REFIDX(i)) THEN
+              IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 19'
+              STAIDX(i)=2
+              STATE(i)=VALPAR(i,2)
+             ENDIF
+            ENDIF
+           ELSE
+            IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 20'
+            ! INITIALIZATION AT REFERENCE VALUES OF STATE PARAMETERS
+            STATE(i)=VALPAR(i,REFIDX(i))
+            ! INITIALIZATION AT REFERENCE ORDER NUMBERS OF STATE
+            ! PARAMETERS
+            STAIDX(i)=REFIDX(i)
+           ENDIF
+          ENDDO
+          IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 21'
+          CALL LCMSIX(IPDAT,' ',0)
+          CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
+          ! THE FLAG STOP IS SET TO FALSE (IE THE BRANCHING CALCULATION
+          ! MUST CONTINUE)
+          CALL LCMPUT(IPDAT,'STOP',1,1,0)
+        ELSE
+          IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 22'
+          BRANCH_STOP=.TRUE.
+        ENDIF
+
+        IF(BRANCH_STOP) THEN
+         IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 23'
+         CALL LCMSIX(IPDAT,' ',0)
+         CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
+         ! THE FLAG STOP IS SET TO TRUE (IE THE BRANCHING CALCULATION
+         ! MUST STOP)
+         CALL LCMPUT(IPDAT,'STOP',1,1,1)
+         CALL LCMSIX(IPDAT,' ',0)
+         CALL LCMSIX(IPDAT,'GENPMAXS_INP',1)
+         ! THE FLAG FOR WRITTING THE GENPMAXS.INP IS SET TO 2
+         CALL LCMPUT(IPDAT,'FLAG',1,1,2)
+         ! 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                        )
+
+        ENDIF
+      ELSE
+        ! update of the index of the branch type
+        IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 24'
+        ITBRAN=ITBRAN+1
+        ! CASE WHERE THE STATE VARIABLE VALUE CORRESPOND TO THE
+        ! REFERENCE STATE VALUE
+        IF(STATE(BRAIDX)==REFSTA(BRAIDX)) THEN
+          IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 25'
+          ! we skip the reference value'
+          STAIDX(BRAIDX)=STAIDX(BRAIDX)+1
+          IF(NVAL(BRAIDX)>=1) THEN
+           IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 26'
+           ! the new value for the state variable is the next in the
+           ! list
+           STATE(BRAIDX)=VALPAR(BRAIDX,STAIDX(BRAIDX))
+          ENDIF
+        ELSE
+
+          IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 27'
+          ! POSITIONNING OF THE LOOP INDEX AT THE CURRENT BRANCH TYPE
+          ! CALCULATION
+          i=BRAIDX
+          ! DECREASE THE INDEX WHILE THE STATE VARIABLE IS BARR
+          DO WHILE (i>0)
+          IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 28'
+          ! IF THE CURRENT VALUE OF STATE VARIABLE IS THE LAST OF THE
+          ! LIST
+           IF(STAIDX(i)==NVAL(i)) THEN
+            IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 29'
+            IF(NVAL(i)>2) THEN
+             IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 30'
+             ! RESET OF THE ORDER NUMBERS FOR THE STATE VALUE
+             STAIDX(i)=1
+             ! ATTRIBUTION OF THE FIRST VALUE OF THE LIST TO THE STATE
+             STATE(i)=VALPAR(i,STAIDX(i))
+            ELSE
+             IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 31'
+             j=i-1
+             ! INCREASE THE ORDER NUMBERS OF THE VALUE OF THIS STATE
+             STAIDX(j)=STAIDX(j)+1
+             ! ATTRIBUTION OF THE STATE(J) VALUES
+             STATE(j)=VALPAR(j,STAIDX(j))
+             ! WHILE J>0 (IE THE STATE VARIABLE EXISTS)
+             DO WHILE (STAIDX(j)>NVAL(j).and.j>0)
+              IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 32'
+              ! IF THE STATE VARAIBLE IS NOT BARR: INITIALIZATION OF THE
+              ! ORDER NUMBERS
+              IF(j>1)STAIDX(j)=1
+              ! IF THE STATE VARAIBLE IS NOT BARR: ATTRIBUTION OF THE
+              ! STATE VARIABLE VALUE
+              IF(j>1)STATE(j)=VALPAR(j,STAIDX(j))
+              ! DECREASE THE J PARAMETERS
+              j=j-1
+              ! IF THE STATE PRAMETER EXISTS: UPDATE THE ORDER NUMBERS
+              IF(j>0)STAIDX(j)=STAIDX(j)+1
+              ! IF THE STATE PRAMETER EXISTS: ATTRIBUTION OF THE STATE
+              ! VARIABLE VALUE
+              IF(j>0)STATE(j)=VALPAR(j,STAIDX(j))
+              ! EXIT OF THE IF CONDITION
+             ENDDO
+             IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 33'
+             EXIT
+            ENDIF
+           ELSE IF(NVAL(i)==2) THEN
+            IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 34'
+            IF(PKEY(i).NE.BARNAM)THEN
+             IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 35'
+             IF(STAIDX(i-1).NE.NVAL(i-1)) THEN
+              IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 36'
+              j=i-1
+              ! INCREASE THE ORDER NUMBERS OF THE VALUE OF THIS STATE
+              STAIDX(j)=STAIDX(j)+1
+              ! ATTRIBUTION OF THE STATE(J) VALUES
+              STATE(j)=VALPAR(j,STAIDX(j))
+              EXIT
+             ELSE
+              IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 37'
+              ! IF THE BRANCH TYPE IS BARR OR THE CURRENT STATE VALUE I$
+              STAIDX(i)=STAIDX(i)+1
+              IF(i>1)STAIDX(i-1)=1
+              STATE(i)=VALPAR(i,STAIDX(i))
+              IF(i>1)STATE(i-1)=VALPAR(i-1,STAIDX(i-1))
+              EXIT
+             ENDIF
+            ELSE
+             IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 38'
+             IF(STAIDX(i).NE.NVAL(i)) THEN
+              IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 39'
+              j=i
+              ! INCREASE THE ORDER NUMBERS OF THE VALUE OF THIS STATE
+              STAIDX(j)=STAIDX(j)+1
+              ! ATTRIBUTION OF THE STATE(J) VALUES
+              STATE(j)=VALPAR(j,STAIDX(j))
+              EXIT
+             ENDIF
+            ENDIF
+           ELSE
+
+            ! IF THE BRANCH TYPE IS BARR OR THE CURRENT STATE VALUE IS
+            ! NOT THE LAST OF THE LIST
+            STAIDX(i)=STAIDX(i)+1
+            IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 40'
+            IF((STAIDX(i)==REFIDX(i)).and.(BRANCH.NE.BARNAM)) THEN
+             IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 41'
+             ! IF IT IS THE REFERENCE VALUE BUT NOT THE BARR REF VALUE
+             ! UPDATE THE ORDER NUMBERS OF STATE VARIABLE VALUE
+             IF(i==BRAIDX) STAIDX(i)=STAIDX(i)+1
+            ENDIF
+            ! ATTRIBUTION OF THE STATE VARIABLE VALUE
+            STATE(i)=VALPAR(i,STAIDX(i))
+            EXIT
+           ENDIF
+           IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 42'
+           i=i-1
+          ENDDO
+        ENDIF
+      ENDIF
+      IF (IPRINT>100) WRITE(6,*) '@D2PSEL : STEP 43'
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
+      IF((BRANCH .NE.BARNAM(:4)).and.NVAL(BRAIDX)==1) THEN
+        CALL LCMPUT(IPDAT,'PRINT',1,1,0)
+      ELSE
+        CALL LCMPUT(IPDAT,'PRINT',1,1,1)
+      ENDIF
+
+      CALL LCMPTC(IPDAT,'BRANCH',4,BRANCH)
+      CALL LCMPUT(IPDAT,'BRANCH_IT',1,1,ITBRAN)
+      CALL LCMPUT(IPDAT,'STATE',NVAR,2,STATE)
+      CALL LCMPUT(IPDAT,'STATE_INDEX',NVAR,1,STAIDX)
+      CALL LCMPUT(IPDAT,'BRANCH_INDEX',1,1,BRAIDX)
+
+      IF(IPRINT > 0)  THEN
+         WRITE(6,*)
+         WRITE(6,*) "**** SELECTING THE NEXT BRANCH CALCULATION ****"
+         WRITE(6,*) "******     NEXT BRANCH CHARACTERISTICS    *****"
+         WRITE(6,*) "BRANCH TYPE         :",BRANCH
+         WRITE(6,*) "BRANCH INDEX        :",BRAIDX
+         WRITE(6,*) "BRANCH ITERATION    :",ITBRAN
+         WRITE(6,*) "STATE VARIABLE NAME :",PKEY
+         WRITE(6,*) "BRANCH STATE VALUES :",STATE
+         WRITE(6,*) "BRANCH STATE INDEX  :",STAIDX
+      ENDIF
+      CALL LCMSIX(IPDAT,' ',0)
+
+      END
diff --git a/Donjon/src/D2PSOI.f b/Donjon/src/D2PSOI.f
new file mode 100644
index 0000000..8a7a14d
--- /dev/null
+++ b/Donjon/src/D2PSOI.f
@@ -0,0 +1,42 @@
+*DECK D2PSOI
+      SUBROUTINE D2PSOI(TAB,DIMTAB)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Sort D2PSOR state variable integer array to match GENPMAXS order, in
+* ascendent order
+*
+*Author(s): 
+* J. Taforeau
+*
+*Parameters: input
+* TAB     vector of rank index of state variables
+* DIMTAB  dimension of TAB
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER DIMTAB
+      INTEGER TAB(DIMTAB)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER Rtmp
+      INTEGER :: I, J
+
+      DO I = 2, DIMTAB
+         Rtmp = TAB(I)
+         DO J = I-1, 1, -1
+          IF (Rtmp < TAB(J)) THEN
+           TAB(J+1) = TAB(J)
+          ELSE
+           EXIT
+          ENDIF
+         ENDDO
+         TAB(J+1) = Rtmp
+      ENDDO
+      RETURN
+      END
diff --git a/Donjon/src/D2PSOR.f b/Donjon/src/D2PSOR.f
new file mode 100644
index 0000000..f56f49d
--- /dev/null
+++ b/Donjon/src/D2PSOR.f
@@ -0,0 +1,42 @@
+*DECK D2PSOR
+      SUBROUTINE D2PSOR(TAB,DIMTAB)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Sort D2PSOR state variable real array to match GENPMAXS order, in
+* ascendent order
+*
+*Author(s): 
+* J. Taforeau
+*
+*Parameters: input
+* TAB     vector of rank index of state variables
+* DIMTAB  dimension of TAB
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER DIMTAB
+      REAL TAB(DIMTAB)
+*----
+*  LOCAL VARIABLES
+*----
+      REAL Rtmp
+      INTEGER :: I, J
+
+      DO I = 2, DIMTAB
+         Rtmp = TAB(I)
+         DO J = I-1, 1, -1
+          IF (Rtmp < TAB(J)) THEN
+           TAB(J+1) = TAB(J)
+          ELSE
+           EXIT
+          ENDIF
+         ENDDO
+         TAB(J+1) = Rtmp
+      ENDDO
+      RETURN
+      END
diff --git a/Donjon/src/D2PTH.f b/Donjon/src/D2PTH.f
new file mode 100644
index 0000000..ffb6a46
--- /dev/null
+++ b/Donjon/src/D2PTH.f
@@ -0,0 +1,268 @@
+*DECK D2PTH
+      SUBROUTINE D2PTH(  IPDAT, IPMIC , IPRINT,    NBU,   NGP,    NBMIX,
+     >                   NFISS,   NDEL,   NVAR, STAIDX,JOBOPT,     FLAG)
+
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover T/H inveariant data block and store in INFO/TH_DATA/
+* WARNING: These data are extracted only if the corresponding flag is
+* set to T in the GENPMAXS_INP/JOBOPT vector.
+* NB 1 : The data for T/H are recovered from the reference state,  the
+* branching calculation not includes the TH informations.
+* NB 3 : The Helios format cannot recover the CHID (delay neutron
+* fission spectrum), it is fixed to default values even if JOBOPT(6)=T.
+* NB 4 : The Helios format cannot recover the Decay Heat Data (DBET and
+* DLAM in GenPMAXS), it is fixed to default values even if JOBOPT(14)=T.
+*
+*Author(s): 
+* J. Taforeau
+*
+*Parameters: input
+* IPDAT   address of the INFO data block
+* IPMIC   address of the MICROLIB object
+* IPPRINT control the printing on screen
+* NGP     number of energy groups
+* NBU     number of burnup point in IPSAP
+* NVAR    number of state parameters in INFO data block
+* NDEL    number of delaued neutron groups
+* NBMIX   number of mixtrures  in IPSAP
+* NFISS   number of fissile isotopes
+* STAIDX  index of state variables
+* FLAG    End of a bran calculation (=-1: branch for yields calculation)
+*
+*Parameters: 
+* IPRINT  
+* JOBOPT  
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPDAT,IPMIC
+      INTEGER IPRINT,NVAR,NBU, NBMIX,NGP
+      INTEGER NFISS,NDEL
+      INTEGER STAIDX(NVAR)
+      INTEGER FLAG
+*----
+*  LOCAL VARIABLES
+*----
+      TYPE(C_PTR) JPMIC,KPMIC,IPTH,KPTH
+      PARAMETER(NSTATE=40)
+      INTEGER DSTATE(NSTATE)
+      INTEGER NDFI,NDFP,MR,MI,MI_REAL,ITYLCM
+      INTEGER :: I_PF = 0
+      INTEGER :: iso = 1
+      REAL YLDI,YLDXe,YLDPm
+      REAL CHI(NFISS,NGP)
+      REAL OVERV(NGP),BURN(NBU), STATE(NVAR)
+      REAL FLX(NGP),NUSIGF_D(NDEL,NGP),NUSIGF(NGP)
+      REAL BETA_D(NDEL,NFISS),LAMBDA_D(NDEL,NFISS)
+      REAL NUM(NDEL)
+      REAL :: DEN = 0.0
+      CHARACTER*12 ISOTOPES(4)
+      CHARACTER*1 JOBOPT(16)
+      CHARACTER*8 NUSID
+      CHARACTER*3 YLDOPT
+      REAL YLDFIX(3)
+
+
+      REAL, ALLOCATABLE, DIMENSION(:) :: DEPLETE_ENER,DEPLETE_DECA
+      REAL, ALLOCATABLE, DIMENSION(:) :: FISSIONYIELD
+      CHARACTER(len=12),ALLOCATABLE, DIMENSION(:) :: ISOTOPERNAME
+      CHARACTER(len=12),ALLOCATABLE, DIMENSION(:) :: ISOTOPESDEPL,PF
+
+      IF(IPRINT > 1)  THEN
+         WRITE(6,*)
+         WRITE(6,*) "**************************************************"
+         WRITE(6,*) "*               T/H INVARIANT BLOCK              *"
+         WRITE(6,*) "**************************************************"
+         WRITE(6,*)
+      ENDIF
+
+      CALL LCMSIX(IPMIC,' ',0)
+      CALL LCMSIX(IPMIC,'MACROLIB',1)
+
+      IF(JOBOPT(13)=='T') CALL LCMGET(IPMIC,'LAMBDA-D',LAMBDA_D)
+
+
+
+      JPMIC=LCMGID(IPMIC,'GROUP')
+
+      IF(NBMIX.NE.1) THEN
+        CALL XABORT('@D2PTH: MORE THAN ONE MIXTURE IN SAPHYB')
+      ENDIF
+      IF(NFISS.NE.1) THEN
+        CALL XABORT('@D2PTH: MORE THAN 1 FISSILE ISOTOPE IN MACROLIB')
+      ENDIF
+
+      DO IGR=1,NGP
+        KPMIC=LCMGIL(JPMIC,IGR)
+        IF(JOBOPT(7)=='T')CALL LCMGET(KPMIC,'OVERV',OVERV(IGR))
+        IF(JOBOPT(5)=='T')CALL LCMGET(KPMIC,'CHI',CHI(1:NFISS,IGR))
+        IF(JOBOPT(12)=='T') THEN
+         CALL LCMGET(KPMIC,'NUSIGF',NUSIGF(IGR))
+         CALL LCMGET(KPMIC,'FLUX-INTG',FLX(IGR))
+         DO ND=1,NDEL
+           WRITE(NUSID,' (A6, I2.2)') 'NUSIGF', ND
+           CALL LCMGET(KPMIC,NUSID,NUSIGF_D(ND,IGR))
+         ENDDO
+        ENDIF
+      ENDDO
+
+      IF(JOBOPT(12)=='T') THEN
+        DO ND=1,NDEL
+
+           DEN=0.
+           NUM(ND)=0.0
+          DO IGR= 1,NGP
+           DEN=DEN+NUSIGF(IGR)*FLX(IGR)
+           NUM(ND)=NUM(ND)+NUSIGF_D(ND,IGR)*FLX(IGR)
+          ENDDO
+           BETA_D(ND,NFISS)=NUM(ND)/DEN
+         ENDDO
+!        CALL XABORT ('STOP TEST')
+      ENDIF
+      IF(JOBOPT(9)=='T') THEN
+
+        CALL LCMSIX(IPDAT,' ',0)
+        CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
+        CALL LCMGTC(IPDAT,'YLD_OPT',3,YLDOPT)
+
+        CALL LCMGET(IPDAT,'YLD_FIX',YLDFIX)
+
+        IF ((YLDOPT=='REF').OR.(YLDOPT=='MAN')) THEN
+         CALL LCMSIX(IPMIC,' ',0)
+         CALL LCMLEN(IPMIC,'ISOTOPESDENS',MI_REAL,ITYLCM)
+         CALL LCMLEN(IPMIC,'ISOTOPERNAME',MI,ITYLCM)
+         ALLOCATE (ISOTOPERNAME(MI))
+         CALL LCMGTC(IPMIC,'ISOTOPERNAME',12,MI,ISOTOPERNAME)
+         CALL LCMLEN(IPMIC,'DEPL-CHAIN',ILONG,ITYLCM)
+         IF (ILONG.EQ.0) THEN
+          YLDI=YLDFIX(1)
+          YLDXe=YLDFIX(2)
+          YLDPm=YLDFIX(3)
+           WRITE(6,*)"@D2PTH : NO RECORD DEPL-CHAIN IN SAP/MCO :"
+           WRITE(6,*)"=> DEFAULT VALUES FOR FISSION YLDS CONSIDERED"
+         ELSE
+          CALL LCMSIX(IPMIC,'DEPL-CHAIN',1)
+          CALL LCMGET(IPMIC,'STATE-VECTOR',DSTATE)
+
+          NDEPL = DSTATE(1)
+          NDFI = DSTATE(2)
+          NDFP = DSTATE(3)
+          MR = DSTATE(8)
+
+          ALLOCATE (FISSIONYIELD(NDFI*NDFP), DEPLETE_ENER(NDEPL*MR))
+          ALLOCATE (ISOTOPESDEPL(NDEPL), PF(NDEPL),DEPLETE_DECA(NDEPL))
+          CALL LCMGET(IPMIC,'DEPLETE-DECA',DEPLETE_DECA)
+          CALL LCMGET(IPMIC,'DEPLETE-ENER',DEPLETE_ENER)
+          CALL LCMGTC(IPMIC,'ISOTOPESDEPL',12,NDEPL,ISOTOPESDEPL)
+
+          IF ((NDFI.EQ.0 ).OR. (NDFP .EQ. 0)) THEN
+           WRITE(6,*) "@D2PTH : NUMBER OF DIRECT FISSILE ISOTOPES",
+     1     " OR FISSION FRAGMENT IS ZERO"
+           CALL XABORT('=> PLEASE TURN OFF THE LYLD FLAG IN JOB_OPT'
+     >    //' OR USE THE "YLD FIX" OPTION' )
+          ENDIF
+          CALL LCMGET(IPMIC,'FISSIONYIELD',FISSIONYIELD)
+
+
+          I_PF=0
+          iso=1
+
+          CALL LCMSIX(IPDAT,' ',0)
+          CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
+          CALL LCMGET(IPDAT,'BURN',BURN)
+          CALL LCMSIX (IPDAT,'ISOTOPES',1)
+          CALL LCMGTC (IPDAT,'XE135',12,ISOTOPES(1))
+          CALL LCMGTC (IPDAT,'SM149',12,ISOTOPES(2))
+          CALL LCMGTC (IPDAT,'I135',12,ISOTOPES(3))
+          CALL LCMGTC (IPDAT,'PM149',12,ISOTOPES(4))
+
+          DO iso=1, NDEPL
+            IF(INDEX(ISOTOPESDEPL(iso), 'MACR')==0) THEN
+
+             I_PF=I_PF+1
+             PF(I_PF)=ISOTOPESDEPL(iso)
+             IF(PF(I_PF)==ISOTOPES(3)) YLDI=FISSIONYIELD(I_PF)
+             IF(PF(I_PF)==ISOTOPES(1)) YLDXe=FISSIONYIELD(I_PF)
+             IF(PF(I_PF)==ISOTOPES(4)) YLDPm=FISSIONYIELD(I_PF)
+            ENDIF
+          ENDDO
+
+          IF(IPRINT > 1)  THEN
+           WRITE(6,*)"********* STATE VECTOR INFORMATION *************"
+           WRITE(6,*)
+           WRITE(6,*)"Number of isotopes (MI)                  : ",MI
+           WRITE(6,*)"Number of groups (NGP)                   : ",NGP
+           WRITE(6,*)"Number of fissile isotopes (NFISS)       : ",NFISS
+           WRITE(6,*)"Number of delayed neutron groups (NDEL)  : ",NDEL
+           WRITE(6,*)"Number of depleted isotopes (NDEPL)      : ",NDEPL
+           WRITE(6,*)"Number of direct fissile isotopes (NDFI) : ",NDFI
+           WRITE(6,*)"Number of fission fragments (NDFP)       : ",NDFP
+           WRITE(6,*)"Maximum number of depleting reactions(MR): ",MR
+           WRITE(6,*)
+           WRITE(6,*)"**************** ISOTOPE NAME ******************"
+           WRITE(6,*)
+           WRITE(6,'(10A12)')ISOTOPERNAME(1:MI_REAL)
+           WRITE(6,*)
+          ENDIF
+          DEALLOCATE (ISOTOPERNAME)
+          DEALLOCATE (FISSIONYIELD,ISOTOPESDEPL,PF)
+          DEALLOCATE (DEPLETE_ENER,DEPLETE_DECA)
+         ENDIF
+        ELSE IF (YLDOPT=='FIX') THEN
+         YLDI=YLDFIX(1)
+         YLDXe=YLDFIX(2)
+         YLDPm=YLDFIX(3)
+        ENDIF
+      ENDIF
+
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
+      CALL LCMGET(IPDAT,'STATE',STATE)
+      CALL LCMSIX(IPDAT,' ',0)
+
+      IF(STAIDX(NVAR)==1) THEN
+        IPTH=LCMLID(IPDAT,'TH_DATA',NBU)
+      ELSE
+        IPTH=LCMGID(IPDAT,'TH_DATA')
+      ENDIF
+
+      KPTH=LCMDIL(IPTH,STAIDX(NVAR))
+
+      IF(JOBOPT(13)=='T') THEN
+        CALL LCMPUT(KPTH,'LAMBDA',NDEL*NFISS,2,LAMBDA_D)
+      ENDIF
+      IF(JOBOPT(9)=='T') THEN
+       IF((YLDOPT.EQ.'FIX').OR.(YLDOPT.EQ.'REF')) THEN
+        CALL LCMPUT(KPTH,'YLDPm',1,2,YLDPm)
+        CALL LCMPUT(KPTH,'YLDXe',1,2,YLDXe)
+        CALL LCMPUT(KPTH,'YLDI',1,2,YLDI)
+       ELSE IF ((YLDOPT.EQ.'MAN').AND.(FLAG.EQ.-1)) THEN
+        CALL LCMPUT(KPTH,'YLDPm',1,2,YLDPm)
+        CALL LCMPUT(KPTH,'YLDXe',1,2,YLDXe)
+        CALL LCMPUT(KPTH,'YLDI',1,2,YLDI)
+       ENDIF
+      ENDIF
+
+      IF(JOBOPT(7)=='T')CALL LCMPUT(KPTH,'OVERV',NGP,2,OVERV)
+      IF(JOBOPT(5)=='T')CALL LCMPUT(KPTH,'CHI',NFISS*NGP,2,CHI)
+      IF(JOBOPT(12)=='T')CALL LCMPUT(KPTH,'BETA',NDEL*NFISS,2,BETA_D)
+      IF(IPRINT > 1)  THEN
+        WRITE(6,*) "**************** T/H INFORMATION *****************"
+        IF(JOBOPT(5)=='T') WRITE(6,*) "CHI(NFISS,NGP)     :",CHI
+        IF(JOBOPT(7)=='T') WRITE(6,*) "OVERV(NGP)         :",OVERV
+        IF(JOBOPT(13)=='T')WRITE(6,*) "LAMBDA(NDEL,NFISS) :",LAMBDA_D
+        IF(JOBOPT(12)=='T')WRITE(6,*) "BETA(NDEL,NFISS)   :",BETA_D
+        IF(JOBOPT(9)=='T') WRITE(6,*) "PM-149 YIELD       :",YLDPm
+        IF(JOBOPT(9)=='T') WRITE(6,*) "XE-135 YIELD       :",YLDXe
+        IF(JOBOPT(9)=='T') WRITE(6,*) "I-135 YIELD        :",YLDI
+        WRITE(6,*)
+      ENDIF
+
+      END
diff --git a/Donjon/src/D2PXS.f b/Donjon/src/D2PXS.f
new file mode 100644
index 0000000..48db05b
--- /dev/null
+++ b/Donjon/src/D2PXS.f
@@ -0,0 +1,295 @@
+*DECK D2PXS
+      SUBROUTINE D2PXS (IPDAT,IPMIC,IPSAP,STAVEC,SIGNAT,MIXDIR,
+     >                 JOBOPT,IPRINT)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover cross sections from a microlib object and write cross
+* sections for one branch at a fixed burnup point in the INFO data
+* block.
+*
+*Author(s): 
+* J. Taforeau
+*
+*Parameters: input
+* IPDAT   address of info data block
+* IPSAP   address of the saphyb object
+* IPMIC   address of the microlib object
+* STAVEC  various parameters associated with the IPDAT structure
+* SIGNAT  signature of the object containing cross sections
+* MIXDIR  directory that contains homogeneous mixture information
+* IPRINT  control the printing on screen
+*
+*Parameters: 
+* JOBOPT  
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPDAT,IPMIC,IPSAP
+      INTEGER STAVEC(40),IPRINT
+      CHARACTER*12 SIGNAT,MIXDIR
+*----
+*  LOCAL VARIABLES
+*----
+      ! INDEX OF CURRENT VALUE FOR EACH STATE VARIABLES
+      PARAMETER(NSTATE=40)
+      INTEGER STAIDX (STAVEC(2)),ISTATE(NSTATE)
+      INTEGER DIMSAP(50)
+      INTEGER ITBRA,NSF,ITR
+      INTEGER ::NREA = 0
+      INTEGER :: NISO = 0
+      INTEGER ::NMIL = 0
+      INTEGER ::NBISO = 0
+      INTEGER ::NANI = 0
+      INTEGER ::NFISS = 0
+      INTEGER :: NADD = 0
+      INTEGER :: NBMIX = 0
+      INTEGER :: NMAC = 0
+      INTEGER :: NADRX = 0
+      INTEGER :: NPAR = 0
+      INTEGER :: NDEL = 0
+      INTEGER :: ISPH = 0
+      ! INDICATES THE END OF A BRANCH CALCULATION (REW=1), AND A
+      ! DEFAULT MESHING (GRID)
+      INTEGER REW,GRID
+      ! NUMBER OF STATES VARIABLES
+      INTEGER NVAR
+      ! NUMBER OF BURNUP POINTS
+      INTEGER NBU,NGP
+      INTEGER :: NADF = 1
+      INTEGER :: NCDF = 1
+      INTEGER :: NGFF = 1
+      INTEGER :: NPIN = 1
+      INTEGER :: NTYPE = 1
+      INTEGER FLAG
+      INTEGER ICOR
+      REAL    STATE(STAVEC(2)),BURN(STAVEC(4)),REFSTA(STAVEC(2)-1)
+      ! DATSRC BLOCK OF INFO/GENPMAXS DIRECTORY
+      REAL DATSRC(5),FLUX(STAVEC(1))
+      ! STATE VARIABLE NAMES
+      CHARACTER(len=12) STAVAR(STAVEC(2))
+      CHARACTER JOBOPT(16)
+
+      CHARACTER*4 BRANCH
+      CHARACTER*3 ADF_T,CDF_T,GFF_T
+      LOGICAL LABS(3),SCAT
+      LOGICAL :: LADF = .FALSE.
+      LOGICAL :: LCDF = .FALSE.
+      LOGICAL :: LGFF = .FALSE.
+      LOGICAL :: LXES = .FALSE.
+      LOGICAL :: LDET = .FALSE.
+      LOGICAL :: LTH  = .FALSE.
+      LOGICAL :: LCOR = .FALSE.
+
+
+      ! INITIALIZATION OF PARAMETERS
+      NVAR=STAVEC(2)
+      NBU=STAVEC(4)
+      GRID=STAVEC(5)
+      NGP=STAVEC(1)
+      NSF=STAVEC(11)
+      ICOR=STAVEC(22)
+
+      ! RECOVER INFORMATION FROM INFO date block
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'GENPMAXS_INP',1)
+      CALL LCMGET(IPDAT,'FLAG',FLAG)
+      CALL LCMGET(IPDAT,'DAT_SRC',DATSRC)
+
+
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'SAPHYB_INFO',1)
+
+      IF (ICOR>0) LCOR=.TRUE.
+      IF(JOBOPT(1)=='T') THEN
+         CALL LCMGTC(IPDAT,'ADF_TYPE',3,ADF_T)
+         LADF = .TRUE.
+         IF((ADF_T.EQ.'SEL').OR.(ADF_T.EQ.'GET')) THEN
+          STAVEC(13)=NSF
+          STAVEC(14)=1
+         ENDIF
+         IF((ADF_T.EQ. 'DRA').OR.(ADF_T.EQ. 'GEN'))THEN
+          STAVEC(13)=1
+          CALL LCMSIX(IPMIC,' ',0)
+          CALL LCMSIX(IPMIC,'MACROLIB',1)
+          CALL LCMSIX(IPMIC,'ADF',1)
+          CALL LCMGET(IPMIC,'NTYPE',STAVEC(14))
+         ENDIF
+         NADF=STAVEC(13)
+         NTYPE=STAVEC(14)
+      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')) THEN
+        LTH =.TRUE.
+      ENDIF
+
+      IF(JOBOPT(10)=='T') THEN
+         CALL LCMGTC(IPDAT,'CDF_TYPE',3,CDF_T)
+         LCDF = .TRUE.
+         IF(CDF_T.EQ. 'DRA')THEN
+          CALL LCMSIX(IPMIC,' ',0)
+          CALL LCMSIX(IPMIC,'MACROLIB',1)
+          CALL LCMSIX(IPMIC,'ADF',1)
+          CALL LCMGET(IPMIC,'NTYPE',STAVEC(14))
+         ENDIF
+         NCDF=STAVEC(15)
+         NTYPE=STAVEC(14)
+      ENDIF
+      IF(JOBOPT(11)=='T') THEN
+         CALL LCMGTC(IPDAT,'GFF_TYPE',3,GFF_T)
+         LGFF = .TRUE.
+         NGFF=STAVEC(16)
+         NPIN=STAVEC(17)
+      ENDIF
+
+      IF(DATSRC(3).NE.0.0) THEN
+        CALL LCMGET(IPDAT,'LABS',LABS)
+        CALL LCMGET(IPDAT,'SCAT',SCAT)
+      ENDIF
+
+      CALL LCMGTC(IPDAT,'STATE_VAR',12,NVAR,STAVAR)
+      CALL LCMGET(IPDAT,'BURN',BURN)
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
+      CALL LCMGET(IPDAT,'REWIND',REW)
+      CALL LCMGTC(IPDAT,'BRANCH',4,BRANCH)
+      CALL LCMGET(IPDAT,'BRANCH_IT',ITBRA)
+
+      CALL LCMGET(IPDAT,'STATE_INDEX',STAIDX)
+      CALL LCMGET(IPDAT,'STATE',STATE)
+      CALL LCMSIX(IPMIC,' ',0)
+      CALL LCMGET(IPMIC,'STATE-VECTOR',ISTATE)
+
+      NBISO=ISTATE(2)         ! NUMBER OF ISOTOPES
+      NDEL=ISTATE(19)         ! NUMBER OF DELAYED NEUTRON GROUPS
+
+      IF(NDEL.NE.STAVEC(7)) THEN
+         WRITE(6,*) "@D2PXS: ERROR IN NUMBER OF DELAYED NEUTRON GROUPS"
+         WRITE(6,*) "THE NUMBER OF DELAYED NEUTRON GROUPS IN SAP (",
+     1   STAVEC(7),") IS DIFFERENT FROM MICROLIB (",NDEL,")"
+         CALL XABORT('@D2PXS: DELAYED NEUTRON DATA ERROR')
+      ENDIF
+
+      ISTATE(:NSTATE)=0
+      CALL LCMSIX(IPMIC,' ',0)
+      CALL LCMSIX(IPMIC,'MACROLIB',1)
+      CALL LCMGET(IPMIC,'STATE-VECTOR',ISTATE)
+
+      NBMIX=ISTATE(2)          ! NUMBER OF MIXTURESS
+      NANI=ISTATE(3)           ! SCATTERING ANISOTROPY
+      NADD=ISTATE(5)           ! NUMBER OF ADDITIONAL CROSS SECTIONS
+      NFISS=ISTATE(4)          ! NUMBER OF FISSILE ISOTOPES
+      ITR=ISTATE(6)            ! TRANSPORT CORRECTION OTPION
+      NED=ISTATE(13)           ! NUMBER OF P0 ADDITIONAL XS
+      ISPH=ISTATE(14)
+
+      IF(IPRINT > 0)  THEN
+         WRITE(6,*)
+         WRITE(6,*) "******     BRANCH CHARACTERISTICS     ******"
+         WRITE(6,*) "BRANCH TYPE         :",BRANCH
+         WRITE(6,*) "BRANCH INDEX        :",ITBRA
+         WRITE(6,*) "STATE VARIABLE NAME :",STAVAR
+         WRITE(6,*) "BRANCH STATE VALUES :",STATE
+      ENDIF
+
+      IF(DATSRC(3)==0.0) THEN
+        CALL D2PRFL(  IPDAT, IPMIC , IPRINT,    NBU,   NGP,   NBMIX,
+     >                NANI,   NVAR,  STAIDX,   LADF,  NADF,   NTYPE)
+      ELSE IF(DATSRC(3) == 1.0) THEN
+        ! CASE FOR FUEL CROSS SECTIONS
+        CALL LCMSIX(IPSAP,' ',0)
+        DIMSAP(:50)=0
+        IF (SIGNAT .EQ. 'L_SAPHYB') THEN
+         CALL LCMGET(IPSAP,'DIMSAP',DIMSAP)  ! recover DIMSAP info
+         NREA=DIMSAP(4)       ! NUMBER OF REACTIONS
+         NISO=DIMSAP(5)       ! NUMBER OF PARTICULARIZED ISOTOPES
+         NMAC=DIMSAP(6)       ! NUMBER OF MACROSCOPIC SETS
+         NMIL=DIMSAP(7)       ! NUMBER OF MIXTURES
+         NPAR=DIMSAP(8)       ! NUMBER OF STATE VARIABLE IN SAPHYB
+         NADRX=DIMSAP(18)     ! CONCERN CROSS SECTIONS
+                        ! (INCLUDING FLUE AND TIME)
+        ELSE
+         CALL LCMSIX(IPSAP,' ',0)
+         CALL LCMSIX(IPSAP,MIXDIR,1)
+         CALL LCMGET(IPSAP,'STATE-VECTOR',DIMSAP)
+         NMIL = DIMSAP(1)
+        ENDIF
+        IF(STAVEC(1).NE.ISTATE(1)) THEN
+          CALL XABORT("@D2PBRA: INCOHERENT NUMBER OF ENERGY GROUPS ")
+        ENDIF
+
+
+        IF(NMIL.NE.NBMIX) THEN
+         CALL XABORT("@D2PBRA: DIFFERENT NUMBER OF MIX ")
+         ENDIF
+
+        ! RECOVER MACROLIB CROSS SECTIONS FROM SAPHYB
+        CALL D2PMAC(     IPDAT, IPMIC , IPRINT,    NBU,   NGP,   NBMIX,
+     >                    NADD,   NANI,  NVAR,  STAIDX,  LADF,    NADF,
+     >                    NTYPE,  LCDF,  NCDF,    LGFF,    NGFF,  NPIN,
+     >                     FLUX                                       )
+
+        IF(LTH) THEN
+          ICOR=STAVEC(22)
+          ! RECOVER THE T/H INVARIANT BLOCK (OPTIONAL IN PMAXS FILES)
+          CALL D2PTH(    IPDAT, IPMIC , IPRINT,    NBU,   NGP,   NBMIX,
+     >                   NFISS,   NDEL,   NVAR, STAIDX,JOBOPT,    FLAG)
+        ENDIF
+
+        IF((LXES).OR.(LDET).OR.(LCOR)) THEN
+          ! RECOVER MICROSCOPIC CROSS SECTIONS FROM SAPHYB
+          CALL D2PMIC  (  IPDAT, IPMIC , IPRINT,    NGP,  NBMIX, NBISO,
+     >                      NED,   NVAR, STAIDX,   LXES,   LDET,  LCOR,
+     >                     FLUX                                       )
+        ENDIF
+
+        IF((GRID<2).and. (SIGNAT .EQ. 'L_SAPHYB')) THEN
+
+          ! RECOVER THE DIVERS DIRECTORY OF SAPHYB
+          CALL D2PDIV(    IPDAT, IPSAP , IPRINT,    NGP,   NBU,   NVAR,
+     >                     GRID,   NPAR,   NREA,   NISO,  NMAC,   NMIL,
+     >                     NANI,  NADRX, STAIDX,  STATE, STAVAR,   NSF,
+     >                     LABS,   SCAT,   LADF                       )
+        ENDIF
+
+
+      ENDIF
+
+      IF(REW.EQ.NBU) THEN
+        ! REINITIALIZATION OF INDEX
+        IF (FLAG.EQ.-1) THEN
+         CALL LCMSIX(IPDAT,' ',0)
+         CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
+         CALL LCMGET(IPDAT,'REF_STATE',REFSTA)
+         STATE(1:NVAR-1)=REFSTA(:)
+         FLAG=0
+         CALL LCMPUT(IPDAT,'FLAG',1,1,FLAG)
+        ENDIF
+         STAIDX(NVAR)= 1
+         REW = 1
+         STATE(NVAR)=BURN(1)
+
+
+      ELSE
+        !  UPDATE THE INDEX FOR THE CALCULATION OF THE NEXT BRANCH
+        REW=0
+        STAIDX(NVAR)= STAIDX(NVAR)+1
+        REW = STAIDX(NVAR)
+        STATE(NVAR)=BURN(STAIDX(NVAR))
+      ENDIF
+
+      ! STORE NEW VALUES OF BRANCH CALCULATION
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
+      CALL LCMPUT(IPDAT,'REWIND',1,1,REW)
+      CALL LCMPUT(IPDAT,'STATE',NVAR,2,STATE)
+      CALL LCMPUT(IPDAT,'STATE_INDEX',NVAR,1,STAIDX)
+      END
diff --git a/Donjon/src/D2PXSA.f b/Donjon/src/D2PXSA.f
new file mode 100644
index 0000000..316188c
--- /dev/null
+++ b/Donjon/src/D2PXSA.f
@@ -0,0 +1,315 @@
+*DECK D2PXSA
+      SUBROUTINE D2PXSA(IPDAT,IPSAP,ICAL,IPRINT,NGP,NREA,NISO,NMAC,
+     1 NMIL,NANI,NVAR,NADRX,STAIDX,B2,ADF_T,NSF,LABS,SCAT,LADF)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover FISSION cross sections of an elementary calculation and store
+* in INFO/BRANCH_INFO/MACROLIB_XS/SFI.
+* WARNING: the GET_SFI_XS subroutine cannot recover FISSION XS in the
+* case where cross sections are ineterpolated by the SCR: module
+*
+*Author(s): 
+* J. Taforeau
+*
+*Parameters: input
+* IPDAT   address of the INFO data block
+* ICAL    number of the elementary calculation in which fission cross
+*         sections is to be recovered
+* IPSAP   address of the Saphyb object
+* NGP     number of group energies in Saphyb
+* NREA    number of reactions in Saphyb
+* NISO    number of isotopes in Saphyb
+* NMAC    number of macros in Saphyb
+* NMIL    number of mixtures in Saphyb
+* NANI    number of Legendre orders in Saphyb
+* NADRX   concerne cross section vector (ADRX)
+* STAIDX  index of current branch state values
+* NSF     number of elements of the tranfert matrix
+* LABS    content of absorption xs LABS(1) : ABS XS = TOTAL - SIGS00 ;
+*         LABS(2) abs xs recovered from sap ; LABS (3)  abs xs recovered
+*         from SAP minus excess xs
+
+*Parameters: output
+* SFI     fission cross sections of the current BRANCH:
+*         INFO/BRANCH_INFO/MACROLIB_XS/SFI
+*
+*Parameters: 
+* IPRINT  
+* NVAR    
+* B2      
+* ADF_T   
+* SCAT    
+* LADF    
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPDAT,IPSAP
+      INTEGER ICAL,IPRINT,NGP,NREA,NISO,NMAC, NMIL,NANI,NVAR,
+     1 STAIDX(NVAR),NSF,NADRX
+      REAL B2
+      CHARACTER*3 ADF_T
+      LOGICAL LABS(3),SCAT,LADF
+*----
+*  LOCAL VARIABLES
+*----
+      TYPE(C_PTR) IPTH,KPTH
+      ! order numbers of current : reaction , isotope, macro
+      INTEGER iprf,isot,imil,imac,iabs,iexc,idif,itra
+      INTEGER idifc
+      INTEGER ani, il, nj, ii, it, i1,i2, j1, j2, iadc,g
+      INTEGER ND
+      ! location of excess cross sections in RDATAX
+      INTEGER ADR_EXC
+      ! location of absorption cross sections in RDATAX
+      INTEGER ADR_ABS
+      ! location of profil cross sections in RDATAX
+      INTEGER ADR_PRF
+      ! location of TRANSFERT cross sections in RDATAX
+      INTEGER ADR_TRA
+      INTEGER ADR_DIF
+      ! number of group energies in Saphyb
+      INTEGER NG
+      ! type of data recovered from GANLIB subroutines
+      INTEGER ITYLCM
+      ! name of : isotopes, macros
+      CHARACTER(LEN=8) NOM_MAC(NMAC)
+      ! name of reactions
+      CHARACTER(LEN=10) NOM_REA(NREA)
+      ! residual macro
+      INTEGER RESMAC(NMIL)
+      ! 3rd index of ADRX
+      INTEGER ISADRX(NMIL)
+      ! number of elements in RADATAX
+      INTEGER LENGDX(NMIL)
+      ! name of total macro
+      INTEGER TOTMAC(NMIL)
+      ! number of elements in IDATAP
+      INTEGER LENGDP(NMIL)
+      ! contains the adress of the 1st element in RDATAX
+      INTEGER ADRX (NREA+2,NISO+NMAC,NADRX)
+      REAL ABSORPTION(NGP)
+      REAL TRANSFERT (NANI,NGP*NGP)
+      REAL DIFC(NGP)
+      CHARACTER(LEN=12) CALDIR
+      INTEGER fagg, lagg,fdgg,wgal,fag,lag   ! CF SAPHTOOL MANUAL
+      INTEGER fdg(NGP),adr(NGP+1)            ! CF SAPHTOOL MANUAL
+      INTEGER NSCAT
+      REAL CURRN(NSF,NGP,2)
+      REAL SRFLX(NSF,NGP)
+      REAL ZAFLX(NMIL,NGP)
+      DOUBLE PRECISION RPAR (6,NSF)
+      INTEGER IPAR (3,NSF)
+      REAL ADF(NGP,NSF,10)
+      REAL SCAT_MAT(NGP*NGP)
+      ! transfert matrix
+      INTEGER ,ALLOCATABLE, DIMENSION(:) :: IDATAP
+      ! contains values of cross sections of an elementary calculation
+      REAL,ALLOCATABLE, DIMENSION(:) :: RDATAX
+
+      TRANSFERT(:,:) = 0
+
+      WRITE(CALDIR,'("calc", I8)') ICAL
+      CALL LCMSIX(IPSAP,' ',0)
+      CALL LCMSIX(IPSAP,'contenu',1)
+      IF(NMIL.NE.1) THEN
+        ! the number of mixtures must be equal to one for converting
+        ! Saphyb into PMAXS format
+        CALL XABORT('@D2P: MORE THAN ONE MIXTRURE IN SAPHYB')
+      ENDIF
+      CALL LCMGTC(IPSAP,'NOMREA',10,NREA,NOM_REA)
+      CALL LCMGTC(IPSAP,'NOMMAC',8,NMAC,NOM_MAC)
+      CALL LCMGET(IPSAP,'RESMAC',RESMAC)
+      CALL LCMGET(IPSAP,'TOTMAC',TOTMAC)
+      CALL LCMSIX(IPSAP,' ',0)
+
+      CALL LCMSIX(IPSAP,'adresses',1)
+      CALL LCMGET(IPSAP,'ADRX',ADRX)
+      CALL LCMSIX(IPSAP,' ',0)
+      CALL LCMSIX(IPSAP,CALDIR,1)
+      CALL LCMSIX(IPSAP,'info',1)
+      CALL LCMGET(IPSAP,'ISADRX',ISADRX)
+      CALL LCMGET(IPSAP,'LENGDX',LENGDX)
+      CALL LCMGET(IPSAP,'LENGDP',LENGDP)
+      ALLOCATE (RDATAX(LENGDX(1)),IDATAP(LENGDP(1)))
+      imac=0
+      IF(RESMAC(1).NE.0) THEN
+        imac=RESMAC(1)      ! recover name of residual macro
+      ELSE IF(TOTMAC(1).NE.0) THEN
+        imac=TOTMAC(1)      ! recover name of total macro
+      ELSE
+        CALL XABORT('@D2P: NO MACRO DEFINED')
+      ENDIF
+      isot=NISO+imac     ! we interest in macro fission cross sections
+      imil=1             ! set the mixtures number to 1
+      iprf=0
+      iexc=0
+      iabs=0
+      idif=0
+      iadc=0
+      itra=0
+      idifc=0
+      !TEST HFATC
+      NSCAT=1
+
+      DO ir=1,NREA
+        ! store the order numbers of PROFIL matrix
+        IF((SCAT) .and. NOM_REA(ir)=="PROFIL") iprf=ir
+        IF((SCAT) .and. NOM_REA(ir)=="DIFFUSION") idif=ir
+        IF((SCAT) .and. NOM_REA(ir)=="TRANSFERT") itra=ir
+        IF(NOM_REA(ir)=="NU*FISSION") iabs=ir
+        ! store the order numbers of EXCESS matrix
+        IF(LABS(3).and. NOM_REA(ir)=="EXCESS")  iexc=ir
+        IF((LADF) .and. NOM_REA(ir)=="FUITES") idifc=ir
+      ENDDO
+      IF(iabs==0) CALL XABORT ('@D2P: NO ABSORPTION XS AVAILABLE')
+      IF(LABS(3).and.iexc==0) THEN
+        CALL XABORT('@D2P: NO EXCESS XS AVAILABLE')
+      ENDIF
+      IF(SCAT .and. iprf==0) THEN
+        CALL XABORT('@D2P: NO PROFIL XS AVAILABLE')
+      ENDIF
+      IF(SCAT .and. idif==0) THEN
+        CALL XABORT('@D2P: NO DIFFUSION XS AVAILABLE')
+      ENDIF
+      IF(SCAT .and. itra==0) THEN
+        CALL XABORT('@D2P: NO TRANSFERT XS AVAILABLE')
+      ENDIF
+      IF((LADF) .and. idifc==0) THEN
+        CALL XABORT('@D2P: NO FUITES XS AVAILABLE')
+      ENDIF
+      NANI=ADRX(NREA+2,isot,ISADRX(imil))-1
+      ND=ADRX(NREA+1,isot,ISADRX(imil))
+      IF(MOD(idif,NREA+1).GT.0  .AND. ND.GE.1) THEN
+        iadc=ADRX(idif,isot,ISADRX(imil))+NGP
+      ENDIF
+      ! address in RDATAX of ABSORPTION XS
+      ADR_ABS=ADRX(iabs,isot,ISADRX(imil))
+
+
+      ! address in RDATAX of EXCESS XS
+      ADR_EXC=0
+      IF(LABS(3)) ADR_EXC=ADRX(iexc,isot,ISADRX(imil))
+      ! address in RDATAX of PROFIL XS
+      ADR_PRF=0
+      IF(SCAT) ADR_PRF=ADRX(iprf,isot,ISADRX(imil))
+      ! address in RDATAX of TRANSFERT XS
+      ADR_TRA=0
+      IF(SCAT) ADR_TRA=ADRX(itra,isot,ISADRX(imil))
+      ! address in RDATAX of FUITES XS
+      ADR_DIF=0
+      IF(LADF) ADR_DIF=ADRX(idifc,isot,ISADRX(imil))
+
+      ! moving in the saphyyb object to recover RDATAX information
+      CALL LCMSIX(IPSAP,' ',0)
+      CALL LCMSIX(IPSAP,CALDIR,1)
+      CALL LCMSIX(IPSAP,'mili       1',1)
+      CALL LCMGET(IPSAP,'RDATAX',RDATAX)
+      CALL LCMGET(IPSAP,'IDATAP',IDATAP)
+
+      ! LOOP over energy groups
+      DO ig=1, NGP
+       ABSORPTION(ig)=RDATAX(ADR_ABS+ig-1)
+       IF(LADF) DIFC(ig)=RDATAX(ADR_DIF+ig-1)
+       IF(LABS(3)) THEN
+         ABSORPTION(ig)=ABSORPTION(ig)-RDATAX(ADR_EXC+ig-1)
+       ENDIF
+      ENDDO
+
+
+      IF(SCAT)THEN   ! recover the scattering XS from Saphyb
+         ii = ADR_PRF
+         nj = IDATAP(ii+6+2*NGP)-1
+
+        DO ani=0, NANI
+         il = ADR_TRA + (ani) * nj
+         fagg =IDATAP(ii)
+         lagg =IDATAP(ii+1)
+         fdgg =IDATAP(ii+2)
+         wgal =IDATAP(ii+3)
+         fag  =IDATAP(ii+4)
+         lag  =IDATAP(ii+5)
+         fdg  =IDATAP(ii+6:ii+5+NGP)
+         adr  =IDATAP(ii+6+NGP:ii+6+2*NGP)
+         IF(wgal.GT.0)THEN
+          it=il
+          DO g=fagg,lagg
+           i1=(g-1)*NGP+fdgg
+           i2=(g-1)*NGP+fdgg+wgal-1
+           TRANSFERT(ani+1,i1:i2)=RDATAX(it:it+wgal-1)
+           it=it+wgal
+          ENDDO
+         ENDIF
+         DO g=fag,lag
+          i1=(g-1)*NGP+fdg(g)
+          i2=(g-1)*NGP+fdg(g)+adr(g+1)-adr(g)-1
+          j1=il-1+adr(g)
+          j2=il-1+adr(g+1)-1
+          TRANSFERT(ani+1,i1:i2)=RDATAX(j1:j2)
+         ENDDO
+        ENDDO
+        IF(iadc.NE.0)THEN
+         NG=NGP
+!         TRANSFERT(1,1:NG*NG:NG+1) =
+!     >         TRANSFERT(1,1:NG*NG:NG+1) - RDATAX(iadc:iadc+NGP-1)
+        ENDIF
+      ENDIF
+      DO g=1, NGP
+        DO ig=1, NGP
+         SCAT_MAT(NSCAT) = TRANSFERT(1,g+(ig-1)*NGP)
+         NSCAT=NSCAT+1
+        ENDDO
+      ENDDO
+
+      ! RECOVER ADF IN SAPHYB (IF AVAILABLE) (adapted from !
+      ! saphyb_browser of UPM)
+
+      IF(LADF) THEN
+        IF((ADF_T.EQ.'SEL').OR.(ADF_T.EQ.'GET')) THEN
+         CALL LCMSIX (IPSAP,' ',0)
+         CALL LCMSIX (IPSAP,'geom        ',1)
+         CALL LCMSIX (IPSAP,'outgeom     ',1)
+         CALL LCMLEN(IPSAP,'SURF',NSURF,ITYLCM)
+         IF(NSF.NE.NSURF) THEN
+           WRITE(6,*) "@D2P: ERROR IN NUMBER OF ASSEMBLY SURFACES"
+           WRITE(6,*) "THE NUMBER OF SURFACES IN SAP (",
+     1     NSURF,") IF DIFFERENT FROM DRAG2PARCS INPUT (",NSF,")"
+           CALL XABORT('')
+         ENDIF
+
+         CALL LCMGET(IPSAP,'IPAR',IPAR)
+         CALL LCMGET(IPSAP,'RPAR',RPAR)
+
+         CALL LCMSIX(IPSAP,' ',0)
+         CALL LCMSIX(IPSAP,CALDIR,1)
+         CALL LCMSIX(IPSAP,'outflx      ',1)
+
+         CALL LCMGET(IPSAP,'CURRM',CURRN(:,:,2))
+         CALL LCMGET(IPSAP,'CURRP',CURRN(:,:,1))
+         CALL LCMGET(IPSAP,'SURFLX',SRFLX(:,:))
+         CALL LCMGET(IPSAP,'REGFLX',ZAFLX(:,:))
+         ADF = 0.
+         DIFC(:)=DIFC(:)/B2
+
+         ! CALL to GET_SFI_XS to recover ADF
+         CALL D2PADF(IPDAT,IPRINT,NGP,NMIL, ADF, NSF, DIFC,CURRN,SRFLX,
+     1   ZAFLX,RPAR,IPAR,ADF_T,STAIDX,NVAR)
+        ENDIF
+      ENDIF
+      ! STORE RESULTS IN INFO DATA BLOCK
+      CALL LCMSIX(IPDAT,' ',0)
+      CALL LCMSIX(IPDAT,'BRANCH_INFO',1)
+      IPTH=LCMGID(IPDAT,'CROSS_SECT')
+      KPTH=LCMDIL(IPTH,STAIDX(NVAR))
+      CALL LCMSIX(KPTH,'MACROLIB_XS',1)
+      IF(LABS(2)) CALL LCMPUT(KPTH,'ABSORPTION',NGP,2,ABSORPTION)
+      IF(SCAT) CALL LCMPUT(KPTH,'SCAT',NGP*NGP,2,SCAT_MAT)
+      IF(LABS(2)) WRITE(6,*) "ABSORPTION EXCESS :", ABSORPTION
+      IF(SCAT) WRITE(6,*) "SCATTERING MATRIX  :", SCAT_MAT
+      DEALLOCATE (RDATAX,IDATAP)
+      END
diff --git a/Donjon/src/DETCDRV.f b/Donjon/src/DETCDRV.f
new file mode 100644
index 0000000..0a13bfb
--- /dev/null
+++ b/Donjon/src/DETCDRV.f
@@ -0,0 +1,202 @@
+*DECK DETCDRV
+      SUBROUTINE DETCDRV(IPDET,NGRP,NEL,NUN,NX,NY,NZ,MESHX,MESHY,MESHZ,
+     1           KEYF,FLUX,IPRT,KC,DT,LHEX,LSIMEX,LNORM,VNORM,LPARAB)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Driver for the module DETECT:
+*
+*Copyright:
+* Copyright (C) 2010 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* E. Varin, M. Guyot
+*
+*Parameters:
+* IPDET  pointer to the library object
+* NGRP   number of energy groups
+* NEL    number of finite elements
+* NUN    number of unknowns
+* NX     number of x mesh-splitted elements 
+* NY     number of y mesh-splitted elements 
+* NZ     number of z mesh-splitted elements
+* MESHX  
+* MESHY  
+* MESHZ  
+* KEYF   keyflux recover from L_TRACk object
+* FLUX   flux for each mesh-splitted elements
+* IPRT   printing index
+* KC     calculation type reference
+* DT     time step
+* LHEX   =.TRUE. if hexagonal detectors are present
+* LSIMEX =.TRUE. if keyword SIMEX is present
+* LNORM  =.TRUE. if keyword NORM is present
+* VNORM  real used for normalization
+* LPARAB =.TRUE. if parabolic interpolation is performed
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPDET
+      INTEGER IPRT,KC,NGRP,NEL,NX,NY,NZ,KEYF(NEL),NUN
+      LOGICAL LHEX,LSIMEX,LNORM,LPARAB
+      REAL    FLUX(NUN,NGRP),DT,MESHX(NX+1),MESHY(NY+1),MESHZ(NZ+1),
+     1        VNORM
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER   NSTATE,IOUT
+      PARAMETER (NSTATE=40,IOUT=6) 
+      INTEGER   ILONG,ITYLCM,INFO(2),NREP,ITHEX,NHEX,J
+      REAL      DEVPOS(6),PLNL,REF,RESP,VLAMDA,XMULT,TLG
+      CHARACTER NXTYP*12,FIRST*12,NXDET*12,FIRST1*12
+      LOGICAL   LREGUL
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IHEX
+      REAL, ALLOCATABLE, DIMENSION(:) :: SPEC,REP,FRACT,NVCST,PDD,APD,
+     1          BPD
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(SPEC(NGRP))
+*
+      IF(IPRT.GE.1) THEN
+        IF(KC.EQ.0) THEN
+          WRITE(IOUT,*) 'DETECT: CALCULATION TYPE REFERENCE, KC = ',KC
+        ELSE
+          WRITE(IOUT,*) 'DETECT: CALCULATION TYPE NORMAL, KC = ',KC
+        ENDIF
+        WRITE(IOUT,*) 'DETECT: TIME STEP USED, DT = ',DT
+      ENDIF
+      CALL LCMSIX(IPDET,' ',0)
+      NXTYP = ' '
+      CALL LCMNXT(IPDET,NXTYP)
+      FIRST = NXTYP
+ 10   CALL LCMNXT(IPDET,NXTYP)
+      CALL LCMLEN(IPDET,NXTYP,ILONG,ITYLCM)
+      IF (ITYLCM.EQ.0) THEN
+        CALL LCMSIX(IPDET,NXTYP,1)
+        CALL LCMGET(IPDET,'INFORMATION',INFO)
+        CALL LCMGET(IPDET,'SPECTRAL',SPEC)
+        NREP = INFO(2)
+        ALLOCATE(REP(NREP))
+        IF( NXTYP(1:5).EQ.'PLATN' )THEN
+          ALLOCATE(FRACT(NREP-1),NVCST(NREP-2),PDD(NREP-2),APD(NREP-2),
+     1    BPD(NREP-2))
+          CALL LCMGET(IPDET,'FRACTION',FRACT)
+          CALL LCMGET(IPDET,'INV-CONST',NVCST)
+        ENDIF
+        NXDET = ' '
+        CALL LCMNXT(IPDET,NXDET)
+        FIRST1 = NXDET
+ 20     CALL LCMNXT(IPDET,NXDET)
+        CALL LCMLEN(IPDET,NXDET,ILONG,ITYLCM)
+        IF (ITYLCM.EQ.0) THEN
+           IF(IPRT.GT.3) WRITE(IOUT,*) 'NAME DETECTOR ',NXDET
+           CALL LCMSIX(IPDET,NXDET,1)
+           IF(LHEX) THEN
+             CALL LCMLEN(IPDET,'NHEX',NHEX,ITHEX)
+             IF(NHEX.EQ.0) CALL XABORT('@DETCDRV: HEXAGON NUMBERS'
+     +             //' NOT PRESENT IN DETECT')
+             ALLOCATE(IHEX(NHEX))
+             CALL LCMGET(IPDET,'NHEX',IHEX)
+           ENDIF
+           CALL LCMGET(IPDET,'POSITION',DEVPOS)
+           CALL LCMGET(IPDET,'RESPON',REP)
+            IF(LSIMEX.AND.NXTYP.EQ.'VANAD_REGUL') THEN
+              CALL DETINT(NX,NY,NZ,NEL,NUN,LPARAB,MESHX,MESHY,MESHZ,
+     +        KEYF,FLUX,NGRP,DEVPOS,RESP,IPRT)
+            ELSE
+              CALL DETFLU(LHEX,NX,NY,NZ,NEL,NUN,MESHX,MESHY,MESHZ,KEYF,
+     +        FLUX,NGRP,SPEC,DEVPOS,NHEX,IHEX,RESP,IPRT)
+            ENDIF
+*----
+*  DETECTOR RESPONSE CALCULATION
+*----
+            IF(.NOT.LNORM)THEN
+              PLNL = REP(1)
+              REF  = REP(2)
+              IF(NXTYP.EQ.'VANAD_REGUL')THEN
+*----
+*  VANADIUM RESPONSE CALCULATION
+*----
+                IF(LSIMEX) THEN
+                  REF = RESP
+                ELSE
+                  IF(KC.EQ.1) THEN
+                    VLAMDA = 1./225.
+                    XMULT = 1.0 + VLAMDA*DT
+                    XMULT = 1.0/XMULT
+                    RESP = XMULT*(PLNL+DT*VLAMDA*RESP)
+                    REF = PLNL
+                  ELSE
+                    REF = RESP
+                  ENDIF
+                ENDIF
+              ELSEIF(NXTYP(1:5).EQ.'PLATN')THEN
+*----
+*  PLATINIUM RESPONSE CALCULATION
+*----
+                LREGUL = .FALSE.
+                DO 30 J=1,NREP-2
+                  PDD(J) = REP(J)
+  30            CONTINUE
+                IF(NXTYP.EQ.'PLATN_REGUL')THEN
+                  LREGUL = .TRUE.
+                ENDIF
+                CALL DETPLAT(DT,RESP,REF,KC,PDD,LREGUL,FRACT,NVCST,
+     +          NREP-2,APD,BPD)
+                DO 40 J=1,NREP-2
+                  REP(J) = PDD(J)
+  40            CONTINUE
+              ELSEIF (NXTYP(1:5).EQ.'CHION') THEN
+*----
+*  LECTURE DE CHAMBRES D'ION
+*----
+                IF(NREP.NE.3)CALL XABORT('@DETCDRV: ION CHAMBERS MUST '
+     +            //'HAVE THREE STORED VALUES FOR RESPONSES')
+                IF (KC.EQ.1) THEN
+                  REF = REP(3)
+                  RESP = LOG10(RESP/REF)
+                  TLG = (RESP-PLNL)/DT
+                  REF = TLG
+                ELSE
+                  REP(3) = RESP
+                  RESP =LOG10(RESP/REP(3))
+                ENDIF
+              ENDIF
+            ELSE
+              REF = VNORM/RESP
+              RESP = VNORM
+            ENDIF
+*----
+*  DETECTOR RESPONSE STORAGE
+*----
+           REP(1) = RESP
+           REP(2) = REF
+           IF(IPRT.GT.4) WRITE(6,*) 'RESP, REF ',RESP, REF
+           CALL LCMPUT(IPDET,'RESPON',NREP,2,REP)
+           CALL LCMSIX(IPDET,' ',2)
+        ENDIF
+        IF(LHEX) DEALLOCATE(IHEX)
+        IF(NXDET.EQ.FIRST1) GOTO 45
+        GOTO 20
+   45   CALL LCMSIX(IPDET,' ',2)
+        DEALLOCATE(REP)
+        IF(NXTYP(1:5).EQ.'PLATN')THEN
+          DEALLOCATE(FRACT,NVCST,PDD,APD,BPD)
+        ENDIF
+      ENDIF
+      IF (NXTYP.EQ.FIRST) GOTO 50
+        GOTO 10
+  50  CONTINUE
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(SPEC)
+      RETURN
+      END
diff --git a/Donjon/src/DETCTL.f b/Donjon/src/DETCTL.f
new file mode 100644
index 0000000..111ca23
--- /dev/null
+++ b/Donjon/src/DETCTL.f
@@ -0,0 +1,181 @@
+*DECK DETCTL
+      SUBROUTINE DETCTL(NX,NY,NZ,NEL,VECT,RESP,NDET,XCT,YCT,ZCT,COR,
+     1           KEYF,IPRT)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Call the subroutines that perform the parabolic interpolation.
+*
+*Copyright:
+* Copyright (C) 2010 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* E. Varin, M. Guyot
+*
+*Parameters:
+* NX     number of x mesh-splitted elements 
+* NY     number of y mesh-splitted elements 
+* NZ     number of z mesh-splitted elements
+* NEL    number of finite elements
+* VECT
+* RESP   flux reads by the detector
+* NDET   number of detectors
+* XCT    center coordinates of each mesh-splitted elements for x
+* YCT    center coordinates of each mesh-splitted elements for y
+* ZCT    center coordinates of each mesh-splitted elements for z
+* COR    coordinates of the center of the detector
+* KEYF   keyflux recover from L_TRACK object
+* IPRT   printing index
+*
+*-----------------------------------------------------------------------                                                                    *
+ 
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER    NX,NY,NZ,NEL,NDET,KEYF(NEL),IPRT
+      REAL       VECT(*),COR(*),XCT,YCT,ZCT,RESP(NDET)
+*----
+*  LOCAL VARIABLES
+*----
+      REAL      D1,D2,D3,X1,X2,X3,XX1,XX2,XX3,Y1,Y2,
+     1          Y3,YY1,YY2,YY3,Z1,Z2,Z3,ZZ1,ZZ2,ZZ3,PD1,PD2,PD3,PPD1,
+     2          PPD2,PPD3,CE,BE,AH
+      INTEGER   I,III,NIJK,I1,I2,I3,IP1,IP2,IP3,J1,J2,J3,JP1,JP2,JP3,
+     1          K1,K2,K3,KP1,KP2,KP3,K0,JJJ
+
+      IF(IPRT.GT.4) WRITE(6,1000)
+
+      IF (NDET.LE.0) RETURN
+      NIJK = NX*NY
+
+      DO 10 III=1,NDET
+         I = (III-1)*3
+         D1 = COR(I+1)
+         D2 = COR(I+2)
+         D3 = COR(I+3)
+*----
+*  DETERMINE CENTER OF INTERPOLATE RANGE
+*----
+         CALL DETRTR(D1,XCT,NX,XX1,XX2,XX3,IP1,IP2,IP3)
+         X1 = XX1
+         X2 = XX2
+         X3 = XX3
+         I1 = IP1
+         I2 = IP2
+         I3 = IP3
+
+         CALL DETRTR(D2,YCT,NY,YY1,YY2,YY3,JP1,JP2,JP3)
+         Y1 = YY1
+         Y2 = YY2
+         Y3 = YY3
+         J1 = JP1
+         J2 = JP2
+         J3 = JP3
+
+         CALL DETRTR(D3,ZCT,NZ,ZZ1,ZZ2,ZZ3,KP1,KP2,KP3)
+         Z1 = ZZ1
+         Z2 = ZZ2
+         Z3 = ZZ3
+         K1 = KP1
+         K2 = KP2
+         K3 = KP3
+
+         IF (IPRT.GT.4) THEN
+           IF (MOD(III,25).EQ.0) WRITE(6,1000)
+         ENDIF
+
+         IF(IPRT.GT.4) THEN
+           WRITE(6,2000) III,D1,X1,X2,X3,D2,Y1,Y2,Y3,D3,Z1,Z2,Z3,
+     >                          I1,I2,I3,   J1,J2,J3,   K1,K2,K3
+         ENDIF
+*----
+*  INTERPOLATION IN X AT PLANE Z=K1
+*----
+         K0   = (K1-1)*NIJK
+*----
+*  INTERPOLATION IN X AT PLANE Y=J1,Z=K1
+*----
+         JJJ  = NX*(J1-1)
+         PD1 = DETPOL(VECT,KEYF,JJJ,K0,I1,I2,I3,X1,X2,X3,D1)
+*----
+*  INTERPOLATION IN X AT PLANE Y=J2,Z=K1
+*----
+         JJJ  = NX*(J2-1)
+         PD2 = DETPOL(VECT,KEYF,JJJ,K0,I1,I2,I3,X1,X2,X3,D1)
+*----
+*  INTERPOLATION IN X AT PLANE Y=J3,Z=K1
+*----
+         JJJ  = NX*(J3-1)
+         PD3 = DETPOL(VECT,KEYF,JJJ,K0,I1,I2,I3,X1,X2,X3,D1)
+*----
+*  INTERPOLATION IN Y AT PLANE Z=K1
+*----
+         CALL DETPAR(Y1,Y2,Y3,PD1,PD2,PD3,AH,BE,CE)
+         PPD1 = AH*D2*D2 + BE*D2 + CE
+*----
+*  INTERPOLATION IN X AT PLANE Z=K2
+*----
+         K0   = (K2-1)*NIJK
+*----
+*  INTERPOLATION IN X AT PLANE Y=J1,Z=K2
+*----
+         JJJ  = NX*(J1-1)
+         PD1 = DETPOL(VECT,KEYF,JJJ,K0,I1,I2,I3,X1,X2,X3,D1)
+*----
+*  INTERPOLATION IN X AT PLANE Y=J2,Z=K2
+*----
+         JJJ  = NX*(J2-1)
+         PD2 = DETPOL(VECT,KEYF,JJJ,K0,I1,I2,I3,X1,X2,X3,D1)
+*----
+*  INTERPOLATION IN X AT PLANE Y=J3,Z=K2
+*----
+         JJJ  = NX*(J3-1)
+         PD3 = DETPOL(VECT,KEYF,JJJ,K0,I1,I2,I3,X1,X2,X3,D1)
+*----
+*  INTERPOLATION IN Y AT PLANE Z=K2
+*----
+         CALL DETPAR2(Y1,Y2,Y3,PD1,PD2,PD3,AH,BE,CE)
+         PPD2 = AH*D2*D2 + BE*D2 + CE
+*----
+*  INTERPOLATION IN X AT PLANE Z=K3
+*----
+         K0   = (K3-1)*NIJK
+*----
+*  INTERPOLATION IN X AT PLANE Y=J1,Z=K3
+*----
+         JJJ  = NX*(J1-1)
+         PD1 = DETPOL(VECT,KEYF,JJJ,K0,I1,I2,I3,X1,X2,X3,D1)
+*----
+*  INTERPOLATION IN X AT PLANE Y=J2,Z=K3
+*----
+         JJJ  = NX*(J2-1)
+         PD2 = DETPOL(VECT,KEYF,JJJ,K0,I1,I2,I3,X1,X2,X3,D1)
+*----
+*  INTERPOLATION IN X AT PLANE Y=J3,Z=K3
+*----
+         JJJ  = NX*(J3-1)
+         PD3 = DETPOL(VECT,KEYF,JJJ,K0,I1,I2,I3,X1,X2,X3,D1)
+*----
+*  INTERPOLATION IN Y AT PLANE Z=K3
+*----
+         CALL DETPAR2(Y1,Y2,Y3,PD1,PD2,PD3,AH,BE,CE)
+         PPD3 = AH*D2*D2 + BE*D2 + CE
+*----
+*  INTERPOLATION IN Z
+*----
+         CALL DETPAR2(Z1,Z2,Z3,PPD1,PPD2,PPD3,AH,BE,CE)
+         RESP(III) = AH*D3*D3 + BE*D3 + CE
+
+  10  CONTINUE
+
+      RETURN
+
+ 1000 FORMAT(//,57X,'BRACKETING PROCESS',
+     >        /,57X,'******************',
+     >       //,5X,'DET',4X,'X ',8X,'X1',8X,'X2',8X,'X3',4X,
+     >                   4X,'Y ',8X,'Y1',8X,'Y2',8X,'Y3',4X,
+     >                   4X,'Z ',8X,'Z1',8X,'Z2',8X,'Z3',4X,/)
+ 2000 FORMAT(5X,I3.3,12F10.4,/,5X,3X,3(10X,3(2X,I6.6,2X)))
+
+      END
diff --git a/Donjon/src/DETDRV.f b/Donjon/src/DETDRV.f
new file mode 100644
index 0000000..2a22b4d
--- /dev/null
+++ b/Donjon/src/DETDRV.f
@@ -0,0 +1,148 @@
+*DECK DETDRV
+      SUBROUTINE DETDRV(IPDET,NGRP,IPRT,LHEX,NDETOT,LENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+*  Driver for module DETINI:
+*
+*Copyright:
+* Copyright (C) 2010 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* J. Koclas, E. Varin, M. Guyot
+*
+*Parameters: input/output
+* IPDET   pointer to the L_DETECT object.
+* NGRP    number of energy groups
+* IPRT    printing flag
+* LHEX    =.TRUE. if it is an hexagonal geometry
+* NDETOT  total number of detectors
+* LENTRY  =.TRUE. if the L_DETECT object is updated
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPDET
+      INTEGER  NGRP,IPRT,NDETOT
+      LOGICAL  LHEX,LENTRY
+*----
+*  LOCAL VARIABLES
+*----
+      CHARACTER TEXT*12,TYPE*12
+      INTEGER ITYP,NITMA,NDETEC,NREP,I,INFO(2)
+      REAL FLOT
+      DOUBLE PRECISION DFLOT
+      REAL, ALLOCATABLE, DIMENSION(:) :: SPEC,CST,FRACT
+*----
+*  READING INFORMATION LINKED TO DETECTOR TYPE
+*----
+      CALL REDGET(ITYP,NITMA,FLOT,TYPE,DFLOT)
+      IF (ITYP.NE.3) CALL XABORT('@DETDRV: CHARACTER DATA'
+     +  //' EXPECTED(1)')
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF ((ITYP.NE.3).OR.(TEXT.NE.'INFO')) CALL XABORT('@DETINI:'
+     +  //' CHARACTER INFO EXPECTED')
+      CALL REDGET(ITYP,NDETEC,FLOT,TEXT,DFLOT)
+      IF (ITYP.NE.1) CALL XABORT('@DETDRV: INTEGER DATA EXPECTED(1)')
+      CALL REDGET(ITYP,NREP,FLOT,TEXT,DFLOT)
+      IF(NREP.LT.2)CALL XABORT('@DETDRV: AT LEAST TWO RESPONSES')
+*----
+*  READING INFORMATION LINKED TO ENERGY SPECTRAL
+*----
+      IF(NGRP.EQ.0)CALL XABORT('@DETDRV: NUMBER OF GROUPS REQUIRED')
+      ALLOCATE(SPEC(NGRP))
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF (ITYP.NE.3) CALL XABORT('@DETDRV: CHARACTER DATA'
+     +  //' EXPECTED(2)')
+      IF(TEXT.EQ.'SPECTRAL') THEN
+        DO 10 I=1,NGRP
+          CALL REDGET(ITYP,NITMA,SPEC(I),TEXT,DFLOT)
+          IF (ITYP.NE.2) CALL XABORT('@DETDRV: REAL DATA EXPECTED '
+     +       //'FOR SPECTRAL')
+  10    CONTINUE
+      ELSEIF(TEXT.EQ.'DEFAULT')THEN
+        DO 20 I=1,NGRP-1
+         SPEC(I) = 0.0
+  20    CONTINUE
+        SPEC(NGRP) = 1.0
+        WRITE(6,*) '**** WARINING **** ENERGY SPECTRAL INITIALIZED '
+     +     //'TO 1.0 IN THE HIGHEST GROUP ONLY '
+      ELSE 
+        CALL XABORT('@DETDRV: KEYWORDS FOR SPECTRAL EXPECTED')
+      ENDIF
+*----
+*  READING INFORMATION LINKED TO DELAY CONSTANT AND FRACTION READING
+*----
+      IF(TYPE(1:5).EQ.'PLATN') THEN
+        IF(NREP.LE.2)CALL XABORT('@DETDRV: MORE THAN TWO RESPONSES'
+     +         //' MUST BE SPECIFIED')
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT) 
+        IF (ITYP.NE.3) CALL XABORT('@DETDRV: CHARACTER DATA'
+     +    //' EXPECTED(3)')
+        IF(TEXT.EQ.'INVCONST') THEN
+          ALLOCATE(CST(NREP-2))
+          DO 40 I=1,NREP-2
+            CALL REDGET(ITYP,NITMA,CST(I),TEXT,DFLOT)
+            IF(ITYP.NE.2) CALL XABORT('@DETDRV: REAL DATA EXPECTED '
+     +         //'FOR TIME CONSTANTS') 
+   40     CONTINUE
+          CALL LCMSIX(IPDET,' ',0)
+          CALL LCMSIX(IPDET,TYPE,1)
+          CALL LCMPUT(IPDET,'INV-CONST',NREP-2,2,CST)
+          CALL LCMSIX(IPDET,' ',0)
+          DEALLOCATE(CST)
+        ELSE
+           CALL XABORT('@DETDRV: KEYWORD INVCONST EXPECTED FOR'
+     +           //' PLATINIUM DETECTORS')
+        ENDIF
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF (ITYP.NE.3) CALL XABORT('@DETDRV: CHARACTER DATA'
+     +    //' EXPECTED(4)')
+        IF(TEXT.EQ.'FRACTION') THEN
+          ALLOCATE(FRACT(NREP-1))
+          DO 50 I=1,NREP-1
+            CALL REDGET(ITYP,NITMA,FRACT(I),TEXT,DFLOT)
+            IF (ITYP.NE.2) CALL XABORT('@DETDRV: REAL DATA EXPECTED'
+     +       //' FOR FRACTION')
+  50      CONTINUE
+          CALL LCMSIX(IPDET,' ',0)
+          CALL LCMSIX(IPDET,TYPE,1)
+          CALL LCMPUT(IPDET,'FRACTION',NREP-1,2,FRACT)
+          CALL LCMSIX(IPDET,' ',0)
+          DEALLOCATE(FRACT)
+        ELSE
+           CALL XABORT('@DETDRV: KEYWORD FRACTION EXPECTED FOR'
+     +           //' PLATINIUM DETECTORS')
+        ENDIF
+      ENDIF
+      
+      DO 30 I=1,NDETEC
+        CALL DETREAD(IPDET,TYPE,NREP,IPRT,LHEX)
+  30  CONTINUE
+*----
+*  STORAGE OF INFORMATION
+*----
+      CALL LCMSIX(IPDET,' ',0)
+      CALL LCMSIX(IPDET,TYPE,1)
+      IF (.NOT.LENTRY) THEN
+        INFO(1)=NDETEC
+        INFO(2)=NREP
+      ELSE
+        CALL LCMGET(IPDET,'INFORMATION',INFO)
+        INFO(1) = INFO(1) + NDETEC
+        IF (NREP.NE.INFO(2))
+     +   CALL XABORT('@DETDRV: RESPONS NUMBER INCONSISTENT WITH '//
+     +   ' THE PREVIOUS VALUE')
+      ENDIF
+      CALL LCMPUT(IPDET,'INFORMATION',2,1,INFO)
+      CALL LCMPUT(IPDET,'SPECTRAL',NGRP,2,SPEC)
+      CALL LCMSIX(IPDET,' ',0)
+      NDETOT = NDETOT + NDETEC
+      DEALLOCATE(SPEC)
+      RETURN
+      END
diff --git a/Donjon/src/DETECT.f b/Donjon/src/DETECT.f
new file mode 100644
index 0000000..dd39019
--- /dev/null
+++ b/Donjon/src/DETECT.f
@@ -0,0 +1,249 @@
+*DECK DETECT
+      SUBROUTINE DETECT(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+*  This module compute detectors readings
+*
+*Copyright:
+* Copyright (C) 2010 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* E. Varin, M. Guyot
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The DETECT: module specifications are:
+* DETEC := DETECT: DETEC FLUX  TRACK GEOM :: (descdetect) ;
+* where
+*   DETEC : name of the \emph{detect} containing the detector positions and 
+*     responses. 
+*   FLUX  : name of the \emph{flux} containing the flux solution computed by
+*     the FLUD: or FLPOW: modules. To obtain a correct result, the best is to
+*     use a normalized flux, coming from the FLPOW: module. In this case, the 
+*     fluxes are normalized to the reactor power.
+*   TRACK : name of the \emph{track} containing the TRIVAC tracking.
+*   GEOM  : name of the \emph{geometry} containing the mesh-splitting 
+*     geometry created by the USPLIT: or GEO: modules.
+*   (descdetect) : structure containing the data to module DETECT:.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER NSTATE,IOUT
+      PARAMETER (NSTATE=40,IOUT=6)
+      REAL    FLOT,DT,VNORM
+      TYPE(C_PTR) IPFLU,JPFLUX,IPTRK,IPGEO,IPDET
+      INTEGER ISTATE(NSTATE),NEL,NUN,
+     1        PARAM(NSTATE),I,IPRT,ITYP,NITMA,KC,NX,NY,NZ,NXP1,
+     2        NYP1,NZP1,NGRP,IGR,GEOTYP,ILONG,ITYLCM,IUN
+      LOGICAL LTRK,LFLU,LGEO,LDET,LHEX,LNORM,LSIMEX,LPARAB
+      CHARACTER HSIGN*12,TEXT*12
+      DOUBLE PRECISION DFLOT
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: KEYF
+      REAL, ALLOCATABLE, DIMENSION(:) :: MESHX,MESHY,MESHZ,FUNKN
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: FLU
+*----
+*  PARAMETERS VALIDATION
+*----  
+      IF(NENTRY.LE.3) CALL XABORT('@DETECT: FOUR PARAMETER EXPECTED.')
+      LTRK = .FALSE.
+      LFLU = .FALSE.
+      LGEO = .FALSE.
+      LDET = .FALSE.
+      IPFLU = C_NULL_PTR
+      IPTRK = C_NULL_PTR
+      IPGEO = C_NULL_PTR
+      IPDET = C_NULL_PTR
+      DO 10 I=1,NENTRY
+        IF((IENTRY(I).EQ.1).OR.(IENTRY(I).EQ.2)) THEN
+          TEXT=HENTRY(I)
+          CALL LCMSIX(KENTRY(I),' ',0)
+          CALL LCMGTC(KENTRY(I),'SIGNATURE',12,HSIGN)
+          IF (HSIGN.EQ.'L_DETECT') THEN
+            IPDET=KENTRY(I)
+            LDET = .TRUE.
+            IF(JENTRY(I).NE.1) CALL XABORT('@DET'
+     +      //'ECT: MODIFICATION MODE EXPECTED FOR OBJECT'//HSIGN//'.')
+          ELSEIF (HSIGN.EQ.'L_GEOM') THEN
+            IPGEO=KENTRY(I)
+            LGEO = .TRUE.
+            IF(JENTRY(I).NE.2) CALL XABORT('@DET'
+     +      //'ECT: READ-ONLY MODE EXPECTED FOR OBJECT'//HSIGN//'.')
+         ELSEIF (HSIGN.EQ.'L_TRACK') THEN
+           IF (.NOT.LTRK) THEN
+             IPTRK=KENTRY(I)
+             LTRK = .TRUE.
+           IF(JENTRY(I).NE.2) CALL XABORT('@DET'
+     +      //'ECT: READ-ONLY MODE EXPECTED FOR OBJECT'//HSIGN//'.')
+           ELSE
+             CALL XABORT('@DETECT: ONLY ONE L_TRACK FILE IS REQUIRED')
+           ENDIF
+         ELSEIF ((HSIGN.EQ.'L_FLUX').AND.(.NOT.LFLU)) THEN
+           IPFLU=KENTRY(I)
+           LFLU = .TRUE.
+           IF(JENTRY(I).NE.2) CALL XABORT('@DET'
+     +      //'ECT: READ-ONLY MODE EXPECTED FOR OBJECT'//HSIGN//'.')
+           ELSE
+             CALL XABORT('@DETECT: ONLY ONE L_FLUX FILE IS REQUIRED')
+           ENDIF
+         ELSE
+           CALL XABORT('@DETECT: INVALIV OBJECT='//TEXT)
+         ENDIF
+  10  CONTINUE
+      IF (.NOT.(LFLU.AND.LGEO.AND.LTRK.AND.LDET))
+     +  CALL XABORT('@DETECT: MISSING OBJECTS IN CALL')
+*----
+*  READ DATA
+*----  
+      IPRT = 1
+      LHEX = .FALSE.
+      LNORM = .FALSE.
+      LSIMEX = .FALSE.
+      LPARAB = .TRUE.
+      DT = 0.0
+      KC = 0
+
+ 15   CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.EQ.3) THEN
+        IF (TEXT.EQ.'EDIT') THEN
+          CALL REDGET(ITYP,IPRT,FLOT,TEXT,DFLOT)
+          IF (ITYP.NE.1)
+     +      CALL XABORT('@DETECT: INTEGER DATA EXPECTED(1)')
+        ELSEIF (TEXT.EQ.'TIME') THEN
+          CALL REDGET(ITYP,NITMA,DT,TEXT,DFLOT)
+          IF (ITYP.NE.2)
+     +      CALL XABORT('@DETECT: REAL DATA EXPECTED(1)')
+        ELSEIF (TEXT.EQ.'REF') THEN
+          CALL REDGET(ITYP,KC,FLOT,TEXT,DFLOT)
+          IF (ITYP.NE.1)
+     +      CALL XABORT('@DETECT: INTEGER DATA EXPECTED(2)')
+        ELSEIF (TEXT.EQ.'SIMEX') THEN
+            LSIMEX = .TRUE.
+        ELSEIF (TEXT.EQ.'SPLINE') THEN
+            IF(.NOT.LSIMEX) CALL XABORT('@DETECT: WRONG KEYWORD, '
+     +               //' SIMEX REQUIRED')
+            LPARAB = .FALSE.
+        ELSEIF (TEXT.EQ.'PARAB') THEN
+            IF(.NOT.LSIMEX) CALL XABORT('@DETECT: WRONG KEYWORD, '
+     +               //' SIMEX REQUIRED')
+            LPARAB = .TRUE.
+        ELSEIF (TEXT.EQ.'NORM') THEN
+          LNORM = .TRUE.
+          CALL REDGET(ITYP,NITMA,VNORM,TEXT,DFLOT)
+          IF (ITYP.NE.2)
+     +      CALL XABORT('@DETECT: REAL DATA EXPECTED(3)')
+          IF( VNORM.EQ.0.0 )CALL XABORT('@DETECT: ILLEGAL VALUE '
+     +                 // 'OF NORM')
+        ELSEIF (TEXT.EQ.';') THEN
+          GOTO 20
+        ELSE
+          CALL XABORT('@DETECT: CONTROLLED TYPE EXPECTED'//TEXT)
+        ENDIF
+      ELSE
+        CALL XABORT('@DETECT: CHARACTER DATA EXPECTED(1)')
+      ENDIF
+      GOTO 15
+*----
+*  RECOVER L_GEOM INFORMATION
+*----  
+ 20   IF(DT.EQ.0.0) CALL XABORT('@DETECT: TIME NOT SET')
+      IF(LSIMEX.AND.LNORM) CALL XABORT('@DETECT: WRONG ASSOCIATION '
+     +  //' SIMEX INT AND NORMALIZATION')
+      CALL LCMGET(IPDET,'STATE-VECTOR',PARAM)
+      CALL LCMGET(IPGEO,'STATE-VECTOR',ISTATE)
+      GEOTYP = ISTATE(1)
+      IF(PARAM(3).EQ.1) LHEX = .TRUE.
+      IF(LSIMEX.AND.GEOTYP.NE.7)
+     +  CALL XABORT('@DETECT: SIMEX INTERPOLATION ONLY FOR 3D '
+     +        //'CARTESIAN')
+      IF((LHEX.AND.(GEOTYP.LT.8)).OR.(.NOT.LHEX.AND.(GEOTYP.GE.8)))
+     +   CALL XABORT('@DETECT: INCOMPATIBLE DETECT WITH GEOMETRY')
+      IF(GEOTYP.LT.5.OR.GEOTYP.EQ.6)
+     +  CALL XABORT('@DETECT: GEOMETRY TYPE NOT SUPPORTED IN DETECT')
+      NX = ISTATE(3)
+      NY = ISTATE(4)
+      IF(NY.EQ.0) NY=1
+      NZ = ISTATE(5)
+      IF(NZ.EQ.0) NZ=1
+      NXP1 = NX+1
+      NYP1 = NY+1
+      NZP1 = NZ+1
+      ALLOCATE(MESHX(NXP1),MESHY(NYP1),MESHZ(NZP1))
+      IF((GEOTYP.EQ.7).OR.(GEOTYP.EQ.5)) THEN
+        CALL LCMGET(IPGEO,'MESHX',MESHX)
+        CALL LCMGET(IPGEO,'MESHY',MESHY)
+      ELSE
+        MESHY(1)=0.
+        MESHY(2)=1.
+        MESHX(1)=0.
+        MESHX(2)=1.
+      ENDIF
+      IF(GEOTYP.EQ.9.OR.GEOTYP.EQ.7)THEN
+       CALL LCMGET(IPGEO,'MESHZ',MESHZ)
+      ELSE IF(GEOTYP.EQ.5.OR.GEOTYP.EQ.8)THEN
+        MESHZ(1)=0.
+        MESHZ(2)=1.
+      ENDIF
+*----
+*  RECOVER L_TRACK INFORMATION
+*----  
+      CALL LCMGET(IPTRK,'STATE-VECTOR',ISTATE)
+      NEL = ISTATE(1)
+      NUN = ISTATE(2)
+      ALLOCATE(KEYF(NEL))
+      CALL LCMGET(IPTRK,'KEYFLX',KEYF)
+      CALL LCMGET(IPDET,'STATE-VECTOR',ISTATE)
+      NGRP = ISTATE(1)
+*----
+*  RECOVER L_FLUX INFORMATION
+*----  
+      CALL LCMGET(IPFLU,'STATE-VECTOR',ISTATE)
+      IF(ISTATE(1).NE.NGRP)CALL XABORT('@DETECT: NUMBER OF ENERGY '
+     +  //'GROUPS INCOMPATIBLE BETWEEN FLUX AND DETECT')
+       ALLOCATE(FLU(NUN,NGRP))
+       CALL LCMSIX(IPFLU,' ',0)
+       JPFLUX=LCMGID(IPFLU,'FLUX')
+       CALL LCMLEL(JPFLUX,1,ILONG,ITYLCM)
+       ALLOCATE(FUNKN(ILONG))
+       DO 30 IGR=1,NGRP
+        CALL LCMGDL(JPFLUX,IGR,FUNKN)
+        DO 25 IUN=1,NUN
+          FLU(IUN,IGR)=FUNKN(IUN)
+   25   CONTINUE
+   30  CONTINUE
+       DEALLOCATE(FUNKN)
+*----
+*  CALL DRIVER
+*----  
+      CALL DETCDRV(IPDET,NGRP,NEL,NUN,NX,NY,NZ,MESHX,MESHY,MESHZ,KEYF,
+     + FLU,IPRT,KC,DT,LHEX,LSIMEX,LNORM,VNORM,LPARAB)
+*----
+*  RELEASE MEMORY
+*----  
+      DEALLOCATE(FLU,KEYF,MESHX,MESHY,MESHZ)
+      RETURN
+      END
diff --git a/Donjon/src/DETFIL.f b/Donjon/src/DETFIL.f
new file mode 100644
index 0000000..cb4b16c
--- /dev/null
+++ b/Donjon/src/DETFIL.f
@@ -0,0 +1,45 @@
+*DECK DETFIL
+      SUBROUTINE DETFIL(Y,X,XL,TC,DT,N)
+*
+*----------------------------------------------------------------------
+*
+*Purpose:
+* Filters the n values of x vector for TC seconds.
+* Formulations are taken from the expression of the different
+* equation of a filter with a linear variation of x in DT time
+* step.
+*
+*Author(s): 
+* xxx
+*
+*Parameters:
+* Y   real variables Y(I) at previous time
+* X   real variables to filtered
+* XL  real variables X(I) at previous time
+* TC  filter time constant
+* DT  time step between two calculations
+* N   dimension of the vectors X,XL,Y
+*
+*--------------------------------------------------------------------
+*
+      IMPLICIT NONE
+      INTEGER  N,I
+      REAL     Y(N),X(N),XL(N),TC,DT,AA,A,B,C
+*
+*     COMPUTE PONDERATION FACTORS FOR Y,X ET XL
+*
+      AA =  - DT / TC
+      A  = EXP ( AA )
+      B  = 1. - A
+      C  = 1. - B * TC/DT
+*
+*     COMPUTE NEW Y
+*
+      DO 10 I=1,N
+*
+        Y(I)  = A * Y(I) + ( B - C ) * XL(I) + C * X(I)
+        XL(I) = X(I)
+*
+ 10   CONTINUE
+      RETURN
+      END
diff --git a/Donjon/src/DETFLU.f b/Donjon/src/DETFLU.f
new file mode 100644
index 0000000..a2938bd
--- /dev/null
+++ b/Donjon/src/DETFLU.f
@@ -0,0 +1,145 @@
+*DECK DETFLU
+      SUBROUTINE DETFLU(LHEX,NX,NY,NZ,NEL,NUN,MESHX,MESHY,MESHZ,KEYF,
+     > FLUX,NGRP,SPEC,DEVPOS,NHEX,IHEX,RESP,IPRT)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute flux at detector site
+*
+*Copyright:
+* Copyright (C) 2010 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* E. Varin, M. Guyot
+*
+*Parameters:
+* LHEX   =.TRUE. if hexagonal detectors are present
+* NX     number of x mesh-splitted elements 
+* NY     number of y mesh-splitted elements 
+* NZ     number of z mesh-splitted elements
+* NEL    number of finite elements
+* NUN    number of unknowns
+* MESHX  regions coordinates according to x
+* MESHY  regions coordinates according to y
+* MESHZ  regions coordinates according to z
+* KEYF   keyflux recover from L_TRACk object
+* FLUX   flux for each mesh-splitted elements
+* NGRP   number of energy groups
+* SPEC   spectral information
+* DEVPOS detector coordinates
+* NHEX   number of hexagons in the detector
+* IHEX   index number of hexagons
+* COR    center detector coordinates
+* RESP   flux reads by the detector
+* IPRT   printing index
+*
+*-----------------------------------------------------------------------
+*
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER NX,NY,NZ,NEL,NUN,NGRP,IPRT,NHEX,NT,KEYF(NEL),IHEX(NHEX)
+      REAL MESHX(NX+1),MESHY(NY+1),MESHZ(NZ+1),FLUX(NUN,NGRP),RESP,
+     1     DEVPOS(6),SPEC(NGRP)
+      LOGICAL LHEX
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER NXP1,NYP1,NZP1,I,J,K,I1,I2,J1,J2,K1,K2,IAM,IGR
+      REAL    X1,X2,Y1,Y2,Z1,Z2
+
+      NXP1 = NX+1
+      NYP1 = NY+1
+      NZP1 = NZ+1
+
+      X1=DEVPOS(1)
+      X2=DEVPOS(2)
+      Y1=DEVPOS(3)
+      Y2=DEVPOS(4)
+      Z1=DEVPOS(5)
+      Z2=DEVPOS(6)
+
+      IF(.NOT.LHEX) THEN
+        IF(X1.LT.MESHX(1)) X1=MESHX(1)
+        IF(X2.LT.MESHX(1)) X2=MESHX(1)
+        IF(X2.GT.MESHX(NXP1)) X2=MESHX(NXP1)
+        IF(X1.GT.MESHX(NXP1)) X1=MESHX(NXP1)
+
+        IF(Y1.LT.MESHY(1)) Y1=MESHY(1)
+        IF(Y2.LT.MESHY(1)) Y2=MESHY(1)
+        IF(Y2.GT.MESHY(NYP1)) Y2=MESHY(NYP1)
+        IF(Y1.GT.MESHY(NYP1)) Y1=MESHY(NYP1)
+      ENDIF
+
+      IF(Z1.LT.MESHZ(1)) Z1=MESHZ(1)
+      IF(Z2.LT.MESHZ(1)) Z2=MESHZ(1)
+      IF(Z2.GT.MESHZ(NZP1)) Z2=MESHZ(NZP1)
+      IF(Z1.GT.MESHZ(NZP1)) Z1=MESHZ(NZP1)
+
+      IF(.NOT.LHEX) THEN
+        I1=0
+        DO 20 I=1,NXP1
+          IF(X1.GE.MESHX(I) .AND. X1.LE.MESHX(I+1)) THEN
+            I1=I
+          ENDIF
+          IF(X2.GE.MESHX(I) .AND. X2.LE.MESHX(I+1)) THEN
+            I2=I
+            GOTO 10
+          ENDIF
+  20    CONTINUE
+
+  10    DO 30 J=1,NYP1
+          IF(Y1.GE.MESHY(J) .AND. Y1.LE.MESHY(J+1)) THEN
+              J1=J
+          ENDIF
+          IF(Y2.GE.MESHY(J) .AND. Y2.LE.MESHY(J+1)) THEN
+            J2=J
+            GOTO 40
+          ENDIF
+  30    CONTINUE
+  40    CONTINUE
+      ELSE
+        J1 = 1
+        J2 = 1
+        I1 = 1
+        I2 = NHEX
+      ENDIF
+
+      DO 50 K=1,NZP1
+          IF(Z1.GE.MESHZ(K) .AND. Z1.LE.MESHZ(K+1)) THEN
+             K1=K
+          ENDIF
+          IF(Z2.GE.MESHZ(K) .AND. Z2.LE.MESHZ(K+1)) THEN
+             K2=K
+             GOTO 60
+          ENDIF
+  50  CONTINUE
+
+  60  RESP = 0.0
+      NT = 0
+
+      IF(IPRT.GT.4) WRITE(6,*) 'POS GEOM ',I1,I2,J1,J2,K1,K2
+      DO 70 K=K1,K2
+       DO 71 J=J1,J2
+        DO 72 I=I1,I2
+          NT = NT+1
+          IF(LHEX) THEN
+            IAM = (K-1)*NX+IHEX(I)
+          ELSE
+            IAM=(K-1)*NX*NY+(J-1)*NX+I
+          ENDIF
+          DO 73 IGR=1,NGRP
+            RESP = RESP + SPEC(IGR)*FLUX(KEYF(IAM),IGR)
+  73      CONTINUE
+          IF(IPRT.GT.4) WRITE(6,*) 'DETFLU: FINITE ELEMENT NUMBER ',
+     +                             IAM
+  72  CONTINUE
+  71  CONTINUE
+  70  CONTINUE
+
+      RESP = RESP / FLOAT(NT)
+
+      RETURN
+      END
diff --git a/Donjon/src/DETINI.f b/Donjon/src/DETINI.f
new file mode 100644
index 0000000..395ab02
--- /dev/null
+++ b/Donjon/src/DETINI.f
@@ -0,0 +1,130 @@
+*DECK DETINI
+      SUBROUTINE DETINI(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+*  Reads detector information and stores them 
+*
+*Copyright:
+* Copyright (C) 2010 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* J. Koclas, E. Varin, M. Guyot
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The DETINI: module specification is:
+* DETECT := DETINI: [ DETECT ] :: (descdet) ;
+* where
+*   DETECT : name of the \emph{detect} object that will be created by the 
+*     module; it will contain the detector informations. If \emph{detect} 
+*     appear on RHS, it is updated, otherwise, it is created.
+*   (descdev) : structure describing the input data to the DETINI: module.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER  NSTATE
+      PARAMETER (NSTATE=40)
+      CHARACTER TEXT*12,HSIGN*12
+      INTEGER ISTATE(NSTATE),NGRP,NDETOT,IPRT,IHEX,ITYP,NITMA
+      REAL FLOT
+      DOUBLE PRECISION DFLOT      
+      LOGICAL LHEX,LDET,LENTRY
+      TYPE(C_PTR) IPDET
+*----
+*  PARAMETER VALIDATION
+*----
+      NDETOT = 0
+      NGRP = 0
+      LENTRY=.FALSE.
+      ISTATE(:NSTATE)=0
+*
+      IF(NENTRY.NE.1) CALL XABORT('@DETINI: PARAMETER EXPECTED.')
+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('@D'
+     + //'ETINI: LINKED LIST OR XSM FILE EXPECTED AT LHS.')
+      IF((JENTRY(1).NE.0).AND.(JENTRY(1).NE.1)) CALL XABORT('@D'
+     + //'ETINI: CREATE OR MODIFICATION MODE EXPECTED.')
+*
+      IPDET=KENTRY(1)
+      IF(JENTRY(1).EQ.1) THEN
+        TEXT=HENTRY(1)
+        LENTRY=.TRUE.
+        CALL LCMGTC(KENTRY(1),'SIGNATURE',12,HSIGN)
+        IF(HSIGN.NE.'L_DETECT')CALL XABORT('@DETINI: L_DETECT'
+     +   //' OBJECT IS EXPECTED (OBJECT='//TEXT//')')
+        CALL LCMGET(IPDET,'STATE-VECTOR',ISTATE)
+        NGRP = ISTATE(1)
+        NDETOT = ISTATE(2)
+      ENDIF
+*----
+*  READ INPUT DATA
+*----
+      IPRT = 0
+      LHEX = .FALSE.
+      LDET= .FALSE.
+      IHEX = 0
+   10 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3) CALL XABORT('@DETINI: CHARACTER DATA'
+     +   //' EXPECTED(1).')
+      IF(TEXT.EQ.'EDIT') THEN
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@DETINI: INTEGER DATA EXPECTED(1).')
+        IPRT=MAX(0,NITMA)
+      ELSEIF(TEXT.EQ.'HEXZ')THEN
+        LHEX=.TRUE.
+      ELSEIF(TEXT.EQ.'NGRP')THEN
+        CALL REDGET(ITYP,NGRP,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@DETINI: INTEGER DATA EXPECTED(2).')
+        IF(JENTRY(1).EQ.1) THEN
+          CALL XABORT('@DETINI: ENERGY GROUP NUMBER REQUIRED ONLY AT'
+     +      //' CREATION OF L_DETECT OBJECT')
+        ENDIF
+      ELSEIF(TEXT.EQ.'TYPE')THEN
+        CALL DETDRV(IPDET,NGRP,IPRT,LHEX,NDETOT,LENTRY)
+      ELSEIF(TEXT.EQ.';')THEN
+        LDET=.TRUE.
+      ELSE
+        CALL XABORT('@DETINI: INVALID KEYWORD '//TEXT)
+      ENDIF
+      IF(.NOT.LDET) GOTO 10
+*----
+*  STATE-VECTOR STORAGE
+*----
+      IF(JENTRY(1).EQ.0) THEN
+        HSIGN='L_DETECT'
+        CALL LCMSIX(IPDET,' ',0)
+        CALL LCMPTC(IPDET,'SIGNATURE',12,HSIGN)
+      ENDIF
+      ISTATE(:NSTATE)=0
+      ISTATE(1)=NGRP
+      ISTATE(2)=NDETOT
+      IF(LHEX) ISTATE(3)=1
+      CALL LCMPUT(IPDET,'STATE-VECTOR',NSTATE,1,ISTATE)
+      IF(IPRT.GT.2) CALL LCMLIB(IPDET)
+      RETURN
+      END
diff --git a/Donjon/src/DETINT.f b/Donjon/src/DETINT.f
new file mode 100644
index 0000000..5ee212c
--- /dev/null
+++ b/Donjon/src/DETINT.f
@@ -0,0 +1,100 @@
+*DECK DETINT
+      SUBROUTINE DETINT(NX,NY,NZ,NEL,NUN,LPARAB,MESHX,MESHY,MESHZ,
+     +           KEYF,FLUX,NGRP,DEVPOS,RESP,IPRT)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Driver for the interpolation.
+*
+*Copyright:
+* Copyright (C) 2010 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* E. Varin, M. Guyot
+*
+*Parameters:
+* NX     number of x mesh-splitted elements 
+* NY     number of y mesh-splitted elements 
+* NZ     number of z mesh-splitted elements
+* NEL    number of finite elements
+* NUN    number of unknowns
+* LPARAB =.TRUE. if parabolic interpolation is performed
+* MESHX  regions coordinates according to x
+* MESHY  regions coordinates according to y
+* MESHZ  regions coordinates according to z
+* KEYF   keyflux recover from L_TRACk object
+* FLUX   flux for each mesh-splitted elements
+* NGRP   number of energy groups
+* DEVPOS detector coordinates
+* RESP   flux reads by the detector
+* IPRT   printing index
+*
+*-----------------------------------------------------------------------
+*
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER NX,NY,NZ,NEL,NUN,NGRP,IPRT,KEYF(NEL)
+      REAL MESHX(NX+1),MESHY(NY+1),MESHZ(NZ+1),FLUX(NUN,NGRP),RESP,
+     1 DEVPOS(6)
+      LOGICAL LPARAB
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER NXP1,NYP1,NZP1,NDET,I,IM
+      REAL COR(3)
+      REAL, ALLOCATABLE, DIMENSION(:) :: XCT,YCT,ZCT
+*----
+*  SCRATCH STORAGE ALLOCATION
+*   XCT    center coordinates of each mesh-splitted elements for x
+*   YCT    center coordinates of each mesh-splitted elements for y
+*   ZCT    center coordinates of each mesh-splitted elements for z
+*   COR    center detector coordinates
+*----
+      ALLOCATE(XCT(NX),YCT(NY),ZCT(NZ))
+*
+      NXP1 = NX+1
+      NYP1 = NY+1
+      NZP1 = NZ+1
+
+      IF(IPRT.GT.1) 
+     +  WRITE(6,*) 'INTERPOLATION POLYNOMIALE DES LECTURES AUX VANADIUM'
+      NDET = 1
+*----
+*  CENTER MESH CALCULATION
+*----
+      DO 10 I=1,NX
+        XCT(I) = (MESHX(I+1) + MESHX(I)) /2.
+   10 CONTINUE
+      DO 11 I=1,NY
+        YCT(I) = (MESHY(I+1) + MESHY(I)) /2.
+   11 CONTINUE
+      DO 12 I=1,NZ
+        ZCT(I) = (MESHZ(I+1) + MESHZ(I)) /2.
+   12 CONTINUE
+*----
+*  CENTER DETECTOR COORDINATE
+*----
+      DO 13 I=1,3
+        COR(I) = (DEVPOS(2*I) + DEVPOS(2*I-1)) /2.
+   13 CONTINUE
+      IF(LPARAB) THEN
+*----
+*  POLYNOMIAL FLUX INTERPOLATION AT DETECTOR SITES
+*----
+         CALL DETCTL(NX,NY,NZ,NEL,FLUX(1,2),RESP,NDET,XCT,YCT,ZCT,COR,
+     >   KEYF,IPRT)
+      ELSE
+         IM = MAX(NX,NY)
+         IM = MAX(IM,NZ)
+         CALL DETSPL(NX,NY,NZ,IM,FLUX(1,2),RESP,NDET,XCT,YCT,ZCT,COR,
+     >   KEYF,IPRT)
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(ZCT,YCT,XCT)
+      RETURN
+      END
diff --git a/Donjon/src/DETLIN.f b/Donjon/src/DETLIN.f
new file mode 100644
index 0000000..a326560
--- /dev/null
+++ b/Donjon/src/DETLIN.f
@@ -0,0 +1,25 @@
+*DECK DETLIN
+      SUBROUTINE DETLIN(X1,X2,Y1,Y2,BS,CS)
+*
+*----------------------------------------------------------------------
+*Purpose:
+* Routine calculating the linear coefficient needed for a linear
+* interpolation Y = BS*X + CS
+*
+*Author(s): 
+* M. Beaudet
+*
+*Parameters: 
+* X1      
+* X2      
+* Y1      
+* Y2      
+* BS      
+* CS      
+*
+*----------------------------------------------------------------------
+*
+      BS   = (Y1-Y2)/(X1-X2)
+      CS   = Y1-BS*X1
+      RETURN
+      END
diff --git a/Donjon/src/DETPAR.f b/Donjon/src/DETPAR.f
new file mode 100644
index 0000000..d4feb2a
--- /dev/null
+++ b/Donjon/src/DETPAR.f
@@ -0,0 +1,31 @@
+*DECK DETPAR
+      SUBROUTINE DETPAR(X1,X2,X3,Y1,Y2,Y3,AS,BS,CS)
+*
+*----------------------------------------------------------------------
+*Purpose:
+* Routine calculating the parabolic coefficients needed for
+* a parabolic interpolation Y = AS*X*X + BS*X + CS 
+*
+*Author(s): 
+* M. Beaudet
+*
+*Parameters: 
+* X1      
+* X2      
+* X3      
+* Y1      
+* Y2      
+* Y3      
+* AS      
+* BS      
+* CS      
+*
+*----------------------------------------------------------------------
+*
+      ANUM = Y1*(X2-X3)+Y3*(X1-X2)+Y2*(X3-X1)
+      ADEN = (X1-X2)*(X1-X3)*(X2-X3)
+      AS   = ANUM/ADEN
+      BS   = (Y2-Y3-AS*(X2*X2-X3*X3))/(X2-X3)
+      CS   = Y1-BS*X1-AS*X1*X1
+      RETURN
+      END
diff --git a/Donjon/src/DETPAR2.f b/Donjon/src/DETPAR2.f
new file mode 100644
index 0000000..94f0db9
--- /dev/null
+++ b/Donjon/src/DETPAR2.f
@@ -0,0 +1,31 @@
+*DECK DETPAR2
+      SUBROUTINE DETPAR2(V1,V2,V3,U1,U2,U3,AS,BS,CS)
+*
+*----------------------------------------------------------------------
+*Purpose: routine de HQSIMEX
+*
+*Author(s): 
+* M. Beaudet
+*
+*Parameters: 
+* V1     
+* V2     
+* V3     
+* U1     
+* U2     
+* U3     
+* AS     
+* BS     
+* CS     
+*
+*----------------------------------------------------------------------
+*
+      CHARACTER*6 CLNAME
+      CLNAME = 'PAR'
+      ANUM = U1*(V2-V3)+U3*(V1-V2)+U2*(V3-V1)
+      ADEN = (V1-V2)*(V1-V3)*(V2-V3)
+      AS   = ANUM/ADEN
+      BS   = (U2-U3-AS*(V2*V2-V3*V3))/(V2-V3)
+      CS   = U1-BS*V1-AS*V1*V1
+      RETURN
+      END
diff --git a/Donjon/src/DETPLAT.f b/Donjon/src/DETPLAT.f
new file mode 100644
index 0000000..cca4764
--- /dev/null
+++ b/Donjon/src/DETPLAT.f
@@ -0,0 +1,95 @@
+*DECK DETPLAT
+      SUBROUTINE DETPLAT(DT,RESPON,REF,KC,PDD,REGUL,PDF,PDT,NDDG,
+     +                   AP,BP)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Computes platinum detector reading with delay time consideration
+* and normalized to a reference value.
+*
+*Copyright:
+* Copyright (C) 2010 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* E. Varin
+*
+*Parameters: 
+* DT       
+* RESPON   
+* REF      
+* KC       
+* PDD      
+* REGUL    
+* PDF      
+* PDT      
+* NDDG     
+* AP       
+* BP       
+*
+*-----------------------------------------------------------------------
+*
+      INTEGER  NDDG,I
+      REAL RESPON,REF,DT
+      REAL AEP,AP(NDDG),BP(NDDG),PDT(NDDG),PDF(NDDG+1),PDD(NDDG),PDO
+      LOGICAL  REGUL
+*
+*     FLUX AT DETECTOR SITE
+*     ---------------------
+      IF ( KC.EQ.0) THEN
+*     REFERENCE CALCULATION
+*
+          PDO = RESPON
+          IF (REGUL) THEN
+             CALL DETFIL(PDO,RESPON,RESPON,25.,DT,1)
+          ENDIF
+          IF (PDO.EQ.0.0) THEN
+            PDO = 1.
+            WRITE(6,*)'===> DETECTOR HAS AN INITIAL ZERO VALUE <==='
+          ENDIF
+          REF = PDO
+      ENDIF
+*
+*     NORMALIZATION TO REFERENCE VALUE
+*
+      RESPON = RESPON/REF
+*
+      DO 10 I = 1 , NDDG
+*
+        AEP   = DT*PDT(I)
+        AP(I) = 1.0
+*
+        IF (AEP.GT.20.0) THEN
+           AEP = 20.0
+        ENDIF
+        IF (AEP.GT.1.0E-6) THEN
+           AP(I) = EXP ( -AEP )
+        ENDIF
+        BP(I) = 1.0 - AP(I)
+*
+10    CONTINUE
+*
+      IF (KC.EQ.0) THEN
+*
+*     INITIALISATION AT REFERENCE CALCULATION
+*     ---------------------------------------
+*
+         DO 20 I = 1 , NDDG
+           PDD(I) = PDF(I+1) * RESPON
+20       CONTINUE
+      ENDIF
+*
+*     CALCULATION OF DETECTOR RESPONSE
+*     --------------------------------
+*
+      PDO = 0.0
+      PDO = PDF(1)*RESPON
+      DO 30 I = 1 , NDDG
+           PDD(I) = AP(I)*PDD(I) + BP(I)*PDF(I+1)*RESPON
+           PDO    = PDO + PDD(I)
+ 30   CONTINUE
+*
+      RESPON = PDO
+*
+      RETURN
+      END
diff --git a/Donjon/src/DETPOL.f b/Donjon/src/DETPOL.f
new file mode 100644
index 0000000..10e0544
--- /dev/null
+++ b/Donjon/src/DETPOL.f
@@ -0,0 +1,73 @@
+*DECK DETPOL
+      REAL FUNCTION DETPOL(VECT,IXX,JJJ,K0,I1,I2,I3,X1,X2,X3,X)
+*
+*----------------------------------------------------------------------
+*Purpose:
+* Function performing the parabolic interpolation at X.
+*
+*Author(s): 
+* M. Beaudet
+*
+*Parameters: 
+* DETPOL   
+* VECT     
+* IXX      
+* JJJ      
+* K0       
+* I1       
+* I2       
+* I3       
+* X1       
+* X2       
+* X3       
+* X        
+*
+*----------------------------------------------------------------------
+*
+      INTEGER*4    IXX(*)
+      REAL*4       VECT(*)
+*
+      CHARACTER*6  CLNAME
+      DATA CLNAME /'INTPOL'/
+*
+      IJK1 = IXX(JJJ+K0+I1)
+      IJK2 = IXX(JJJ+K0+I2)
+      IJK3 = IXX(JJJ+K0+I3)
+*
+      IZERO = 0
+*
+      IF (IJK1.LE.0) IZERO = IZERO + 1
+      IF (IJK2.LE.0) IZERO = IZERO + 1
+      IF (IJK3.LE.0) IZERO = IZERO + 1
+*
+      IF (IZERO.GE.2) CALL XABORT('DETPOL: INVALID VALUE OF INDICES')
+*
+      IF (IJK1.LE.0) THEN
+         A2   = VECT(IJK2)
+         A3   = VECT(IJK3)
+         CALL DETLIN(X2,X3,A2,A3,BE,CE)
+         AH = 0.0
+*
+      ELSE IF (IJK2.LE.0) THEN
+         A1   = VECT(IJK1)
+         A3   = VECT(IJK3)
+         CALL DETLIN(X1,X3,A1,A3,BE,CE)
+         AH = 0.0
+*
+      ELSE IF (IJK3.LE.0) THEN
+         A1   = VECT(IJK1)
+         A2   = VECT(IJK2)
+         CALL DETLIN(X1,X2,A1,A2,BE,CE)
+         AH = 0.0
+*
+      ELSE
+         A1   = VECT(IJK1)
+         A2   = VECT(IJK2)
+         A3   = VECT(IJK3)
+         CALL DETPAR(X1,X2,X3,A1,A2,A3,AH,BE,CE)
+      ENDIF
+*
+      DETPOL = AH*X*X + BE*X + CE
+*
+      RETURN
+      END
diff --git a/Donjon/src/DETREAD.f b/Donjon/src/DETREAD.f
new file mode 100644
index 0000000..cdac6be
--- /dev/null
+++ b/Donjon/src/DETREAD.f
@@ -0,0 +1,119 @@
+*DECK DETREAD
+      SUBROUTINE DETREAD(IPDET,TYPE,NREP,IPRT,LHEX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+*  This subroutine reads detector parameters and store them
+*
+*Copyright:
+* Copyright (C) 2010 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* J. Koclas, E. Varin, M. Guyot
+*
+*Parameters: input/output
+* IPDET   pointer to the L_DETECT object.
+* TYPE
+* NREP    number of values stored for detector response
+* IPRT    printing flag
+* LHEX    =.TRUE. if it is an hexagonal geometry
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPDET
+      INTEGER     NREP,IPRT
+      LOGICAL     LHEX
+      CHARACTER   TYPE*12
+*----
+*  LOCAL VARIABLES
+*----
+      CHARACTER TEXT*12,NAMDET*12
+      INTEGER ITYP,NITMA,NHEX,I
+      REAL FLOT,DEVPOS(6)
+      DOUBLE PRECISION DFLOT
+      LOGICAL LEND,LPOS,LRESP,LHEX2
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IHEX
+      REAL, ALLOCATABLE, DIMENSION(:) :: REP
+*----
+*  READING INFORMATION LINKED TO DETECTOR PARAMETERS
+*----
+      LEND=.FALSE.
+      LPOS=.FALSE.
+      LRESP=.FALSE.
+      LHEX2=.FALSE.
+
+      ALLOCATE(REP(NREP))
+
+   10 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3) CALL XABORT('@DETREAD: CHARACTER DATA'
+     +    //' EXPECTED(1)')
+      IF(TEXT.EQ.'NAME') THEN
+        CALL REDGET(ITYP,NITMA,FLOT,NAMDET,DFLOT)
+        IF(ITYP.NE.3) CALL XABORT('@DETREAD: CHARACTER DATA'
+     +    //' EXPECTED(2)')
+      ELSEIF(TEXT.EQ.'NHEX') THEN
+        LHEX2=.TRUE.
+        IF(.NOT.LHEX )CALL XABORT('@DETREAD: INVALID KEYWORD NHEX')
+        CALL REDGET(ITYP,NHEX,FLOT,TEXT,DFLOT)
+        IF (ITYP.NE.1) CALL XABORT('@DETREAD: INTEGER DATA'
+     +       //' EXPECTED(1)')
+        ALLOCATE(IHEX(NHEX))
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF((ITYP.NE.3).AND.(TEXT.EQ.'HEX')) CALL XABORT('@DETREAD:'
+     +           //' CHARACTER DATA EXPECTED HEX')
+      ELSEIF(TEXT.EQ.'HEX') THEN
+        DO 20 I=1,NHEX
+          CALL REDGET(ITYP,IHEX(I),FLOT,TEXT,DFLOT)
+          IF(ITYP.NE.1)
+     +      CALL XABORT('@DETREAD: INTEGER DATA EXPECTED FOR HEX')
+   20   CONTINUE
+      ELSEIF(TEXT.EQ.'POSITION') THEN
+        LPOS=.TRUE.
+        DO 30 I=1,6
+          CALL REDGET(ITYP,NITMA,DEVPOS(I),TEXT,DFLOT)
+          IF (ITYP.NE.2) CALL XABORT('@DETREAD: REAL DATA EXPECTED(2)')
+   30   CONTINUE
+      ELSEIF(TEXT.EQ.'RESP') THEN
+         LRESP=.TRUE.
+         DO 40 I=1,NREP
+            CALL REDGET(ITYP,NITMA,REP(I),TEXT,DFLOT)
+            IF (ITYP.NE.2)CALL XABORT('@DETREAD: REAL DATA EXPECTED(2)')
+   40   CONTINUE
+      ELSEIF(TEXT.EQ.'ENDN') THEN
+        LEND=.TRUE.
+      ELSE
+         CALL XABORT('@DETREAD: WRONG KEYWORD')
+      ENDIF
+
+      IF(.NOT.LEND) GOTO 10
+*----
+*  READING INFORMATION LINKED TO DETECTOR PARAMETERS
+*----
+      IF((.NOT.LPOS).OR.(.NOT.LRESP)) CALL XABORT('@DETREAD: POSITIONS'
+     +       //' OR RESP NOT SPECIFIED')
+      IF(LHEX.NEQV.LHEX2) CALL XABORT('@DETREAD: NHEX SHOULD BE'
+     +       //' SPECIFIED')
+
+      CALL LCMSIX(IPDET,' ',0)
+      CALL LCMSIX(IPDET,TYPE,1)
+      CALL LCMSIX(IPDET,NAMDET,1)
+      CALL LCMPUT(IPDET,'POSITION',6,2,DEVPOS)
+      IF(LHEX)CALL LCMPUT(IPDET,'NHEX',NHEX,1,IHEX)
+      CALL LCMPUT(IPDET,'RESPON',NREP,2,REP)
+      IF(IPRT.GT.5) THEN
+         IF(LHEX) WRITE(6,50) (IHEX(I),I=1,NHEX)
+         WRITE(6,60) (REP(I),I=1,NREP)
+      ENDIF
+      IF(LHEX) DEALLOCATE(IHEX)
+      DEALLOCATE(REP)
+      RETURN
+*
+   50 FORMAT(/20H DETREAD: IHEX ARRAY/(10X,20I6))
+   60 FORMAT(/19H DETREAD: REP ARRAY/(10X,1P,10E12.4))
+      END
diff --git a/Donjon/src/DETRTR.f b/Donjon/src/DETRTR.f
new file mode 100644
index 0000000..b014028
--- /dev/null
+++ b/Donjon/src/DETRTR.f
@@ -0,0 +1,59 @@
+*DECK DETRTR
+      SUBROUTINE DETRTR(DA,A,IA,A1,A2,A3,II1,II2,II3)
+*
+*----------------------------------------------------------------------
+*Purpose:
+* Obtain the coordinates of a point where the interpolation is
+* performed
+*
+*Author(s):
+* ???
+*
+*Parameters: 
+* DA      
+* A       
+* IA      
+* A1      
+* A2      
+* A3      
+* II1     
+* II2     
+* II3     
+*
+*----------------------------------------------------------------------
+*
+      DIMENSION A(*)
+      CHARACTER*6 CLNAME
+*
+      CLNAME = 'SORTR '
+      DIF1 = 1000000.
+      DIF2 = 1000001.
+      DIF3 = 1000002.
+      II1  = 1000000
+      II2  = 1000001
+      II3  = 1000002
+*
+      DO 10 II=1,IA
+         DIF = ABS(DA-A(II))
+         IF ( DIF .LE. DIF1 ) THEN
+            DIF3 = DIF2
+            DIF2 = DIF1
+            DIF1 = DIF
+            II3  = II2
+            II2  = II1
+            II1  = II
+         ELSE IF ( DIF .LE. DIF2 ) THEN
+            DIF3 = DIF2
+            DIF2 = DIF
+            II3  = II2
+            II2  = II
+         ELSE IF ( DIF .LE. DIF3 ) THEN
+            DIF3 = DIF
+            II3  = II
+         ENDIF
+  10  CONTINUE
+      A1 = A(II1)
+      A2 = A(II2)
+      A3 = A(II3)
+      RETURN
+      END
diff --git a/Donjon/src/DETSPL.f b/Donjon/src/DETSPL.f
new file mode 100644
index 0000000..4915c51
--- /dev/null
+++ b/Donjon/src/DETSPL.f
@@ -0,0 +1,163 @@
+*DECK DETSPL
+      SUBROUTINE DETSPL(NXMAX,NYMAX,NZMAX,IM,FLUX,FLUXIN,NINT,XCNTR,
+     > YCNTR,ZCNTR,COORD,IXX,IPRT)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Driver for the spline interpolation.
+*
+*Copyright:
+* Copyright (C) 2010 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* E. Varin
+*
+*Parameters: 
+* NXMAX     
+* NYMAX     
+* NZMAX     
+* IM        
+* FLUX      
+* FLUXIN    
+* NINT      
+* XCNTR     
+* YCNTR     
+* ZCNTR     
+* COORD     
+* IXX       
+* IPRT      
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER NXMAX,NYMAX,NZMAX,IM,NINT,IXX(*),IPRT
+      REAL FLUX(*),FLUXIN(NINT),XCNTR(NXMAX),YCNTR(NYMAX),ZCNTR(NZMAX),
+     > COORD(*)
+*----
+*  LOCAL VARIABLES
+*----
+      LOGICAL     L1DSET
+      REAL, ALLOCATABLE, DIMENSION(:) :: FDUMMY,FXINT,FYINT,FZINT,F2X,
+     > F2Y,F2Z
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: FXY,FYZ,FZX
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: FXYZ
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(FXYZ(NXMAX,NYMAX,NZMAX),FDUMMY(IM),FXINT(NXMAX),
+     > FYINT(NYMAX),FZINT(NZMAX),FXY(NXMAX,NYMAX),FYZ(NYMAX,NZMAX),
+     > FZX(NZMAX,NXMAX),F2X(NXMAX),F2Y(NYMAX),F2Z(NZMAX))
+*----
+*  SECOND DERIVATIVE IS CALCULATED BASED ON X(I), Y(I) (DEFAULT)
+*----
+      FP1 = 0.0
+      FP2 = 0.0
+*----
+*  ASSEMBLE THE ARRAY FXYZ OVER THE FULL MESH
+*----
+      NXNY = NXMAX*NYMAX
+*
+      DO 10 J=1,NXMAX
+         IX = J
+         DO 20 I=1,NYMAX
+            IY = NXMAX*(I - 1)
+            DO 30 K=1,NZMAX
+               IZ = NXNY*(K - 1)
+*
+               IDX = IX + IY + IZ
+               IF (IXX(IDX).EQ.0) THEN
+                  FXYZ(J,I,K) = 0.0
+               ELSE
+                  FXYZ(J,I,K) = FLUX(IXX(IDX))
+               ENDIF
+*
+   30       CONTINUE
+ 20      CONTINUE
+10    CONTINUE
+*----
+*  CALCULATE THE COORDINATES TO INTERPOLATE
+*----
+      IF(IPRT.GT.4) WRITE(6,1000)
+      IF(IPRT.GT.4) WRITE(6,2000)
+
+      N1 = NXMAX
+      N2 = NYMAX
+      N3 = NZMAX
+
+      DO 40 N=1,NINT
+         ININT = 3*(N-1)
+
+         XINT = COORD(ININT + 1)
+         YINT = COORD(ININT + 2)
+         ZINT = COORD(ININT + 3)
+*----
+*  INTERPOLATE IN TWO DIMENSIONS AT XINT,YINT FOR EACH Z PLANE
+*----
+         ITYPE = 1
+         CALL DETSPL3(XCNTR ,YCNTR ,ZCNTR ,
+     >               NXMAX ,NYMAX ,NZMAX ,
+     >               FXYZ  ,FXY   ,FDUMMY,
+     >               F2X   ,F2Y   ,F2Z   ,
+     >               XINT  ,YINT  ,ZINT  ,
+     >               FP1   ,FP2   ,
+     >               FYINT ,FZINT ,FINTR1,
+     >               N1    ,N2    ,N3    ,ITYPE)
+
+         L1DSET = .TRUE.
+         IF (L1DSET) GOTO 1
+*----
+*  INTERPOLATE IN TWO DIMENSIONS AT YINT,ZINT FOR EACH X PLANE
+*----
+         ITYPE = 2
+         CALL DETSPL3(YCNTR ,ZCNTR ,XCNTR ,
+     >               NYMAX ,NZMAX ,NXMAX ,
+     >               FXYZ  ,FYZ   ,FDUMMY,
+     >               F2Y   ,F2Z   ,F2X   ,
+     >               YINT  ,ZINT  ,XINT  ,
+     >               FP1   ,FP2   ,
+     >               FZINT ,FXINT ,FINTR2,
+     >               N1    ,N2    ,N3    ,ITYPE)
+*
+         IF(IPRT.GT.4) WRITE(6,3000) XINT,YINT,ZINT,FINTR2
+*----
+*  INTERPOLATE IN TWO DIMENSIONS AT ZINT,XINT FOR EACH Y PLANE
+*----
+         ITYPE = 3
+         CALL DETSPL3(ZCNTR ,XCNTR ,YCNTR ,
+     >               NZMAX ,NXMAX ,NYMAX ,
+     >               FXYZ  ,FZX   ,FDUMMY,
+     >               F2Z   ,F2X   ,F2Y   ,
+     >               ZINT  ,XINT  ,YINT ,
+     >               FP1   ,FP2   ,
+     >               FXINT ,FYINT ,FINTR3,
+     >               N1    ,N2    ,N3    ,ITYPE)
+
+         IF(IPRT.GT.4) WRITE(6,3000) XINT,YINT,ZINT,FINTR3
+*----
+*  GET AVERAGE VALUE
+*----
+   1     FI = FINTR1
+
+         IF(IPRT.GT.4) WRITE(6,4000) N,XINT,YINT,ZINT,FI
+
+         FLUXIN(N) = FI
+
+  40  CONTINUE
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(F2Z,F2Y,F2X,FZX,FYZ,FXY,FZINT,FYINT,FXINT,FDUMMY,FXYZ)
+      RETURN
+*
+ 1000 FORMAT(1H1,//,5X,'*** INTERPOLATION PROCESS',/)
+ 2000 FORMAT(//,1X,'DET NO' ,5X,4X,'XP',4X, 4X,'YP',4X, 4X,'ZP',4X,
+     >                       7X,'FI',6X,//)
+ 3000 FORMAT(   1X,6X       ,5X,F8.3   ,2X, F8.3   ,2X, F8.3,2X,
+     >                       3X,1PE12.5)
+ 4000 FORMAT(   4X,I3.3     ,5X,F8.3   ,2X, F8.3   ,2X, F8.3,2X,
+     >                       3X,1PE12.5)
+
+      END
diff --git a/Donjon/src/DETSPL2.f b/Donjon/src/DETSPL2.f
new file mode 100644
index 0000000..f5aa08d
--- /dev/null
+++ b/Donjon/src/DETSPL2.f
@@ -0,0 +1,65 @@
+*DECK DETSPL2
+      SUBROUTINE DETSPL2(XCNTR ,YCNTR ,NXMAX ,NYMAX ,FXY,
+     >                  FP1   ,FP2   ,F2X   ,F2Y   ,FDUMMY,
+     >                  XINT  ,YINT  ,FYINT ,FXYINT)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Perform spline interpolation.
+*
+*Copyright:
+* Copyright (C) 2010 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* E. Varin
+*
+*Parameters: 
+* XCNTR    
+* YCNTR    
+* NXMAX    
+* NYMAX    
+* FXY      
+* FP1      
+* FP2      
+* F2X      
+* F2Y      
+* FDUMMY   
+* XINT     
+* YINT     
+* FYINT    
+* FXYINT   
+*
+*-----------------------------------------------------------------------
+*
+      REAL*4     XCNTR(NXMAX),YCNTR(NYMAX),FXY(NXMAX,NYMAX),
+     >           XINT        ,YINT        ,FXYINT,
+     >           F2X(NXMAX)  ,F2Y(NYMAX)  ,FYINT(NYMAX),
+     >           FDUMMY(NXMAX)
+*----
+*  CALCULATE THE SECOND DERIVATIVES ALONG XCNTR FOR EACH Y
+*----
+      DO 10 I=1,NYMAX
+
+         DO 20 J=1,NXMAX
+            FDUMMY(J) = FXY(J,I)
+  20     CONTINUE
+
+         CALL DETSPLI(XCNTR,FDUMMY,NXMAX,FP1,FP2,F2X)
+*----
+*  INTERPOLATE ALONG THE X COORDINATE FOR EACH Y
+*----
+         CALL DETSPLI2(XCNTR,FDUMMY,F2X,NXMAX,XINT,FYINT(I))
+
+  10  CONTINUE
+*----
+*  CALCULATE SECOND DERIVATIVE ALONG Y FOR XINT
+*----
+      CALL DETSPLI(YCNTR,FYINT,NYMAX,FP1,FP2,F2Y)
+*----
+*  INTERPOLATE ALONG Y FOR XINT
+*----
+      CALL DETSPLI2(YCNTR,FYINT,F2Y,NYMAX,YINT,FXYINT)
+
+      RETURN
+      END
diff --git a/Donjon/src/DETSPL3.f b/Donjon/src/DETSPL3.f
new file mode 100644
index 0000000..7327366
--- /dev/null
+++ b/Donjon/src/DETSPL3.f
@@ -0,0 +1,94 @@
+*DECK DETSPL3
+      SUBROUTINE DETSPL3(XCNTR ,YCNTR ,ZCNTR ,
+     >                  NXMAX ,NYMAX ,NZMAX ,
+     >                  FXYZ  ,FXY   ,FDUMMY,
+     >                  F2X   ,F2Y   ,F2Z   ,
+     >                  XINT  ,YINT  ,ZINT  ,
+     >                  FP1   ,FP2   ,
+     >                  FYINT ,FZINT ,FINTRP,
+     >                  N1    ,N2    ,N3    ,ITYPE)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Perform spline interpolation.
+*
+*Copyright:
+* Copyright (C) 2010 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* E. Varin
+*
+*
+*Parameters: 
+* XCNTR     
+* YCNTR     
+* ZCNTR     
+* NXMAX     
+* NYMAX     
+* NZMAX     
+* FXYZ      
+* FXY       
+* FDUMMY    
+* F2X       
+* F2Y       
+* F2Z       
+* XINT      
+* YINT      
+* ZINT      
+* FP1       
+* FP2       
+* FYINT     
+* FZINT     
+* FINTRP    
+* N1        
+* N2        
+* N3        
+* ITYPE     
+*
+*-----------------------------------------------------------------------
+*
+      REAL*4     XCNTR(NXMAX)  ,YCNTR(NYMAX)     ,ZCNTR(NZMAX),
+     >           FXYZ(N1,N2,N3),FXY(NXMAX,NYMAX) ,
+     >           FYINT(NYMAX)  ,FZINT(NZMAX)     ,
+     >           F2X(NXMAX)    ,F2Y(NYMAX)       ,F2Z(NZMAX),
+     >           FDUMMY(NXMAX)
+*----
+*  INTERPOLATE IN TWO DIMENSIONS AT XINT,YINT FOR EACH Z PLANE
+*----
+      DO 10 K=1,NZMAX
+
+         DO 20 J=1,NXMAX
+            DO 30 I=1,NYMAX
+
+               IF (ITYPE.EQ.1) THEN
+                  FXY(J,I) = FXYZ(J,I,K)
+               ELSE IF (ITYPE.EQ.2) THEN
+                  FXY(J,I) = FXYZ(K,J,I)
+               ELSE IF (ITYPE.EQ.3) THEN
+                  FXY(J,I) = FXYZ(I,K,J)
+               ELSE
+                  CALL XABORT('DETSPL3: ERROR IN SPLIN3')
+               ENDIF
+
+   30       CONTINUE
+  20     CONTINUE
+
+         CALL DETSPL2(XCNTR,YCNTR,NXMAX ,NYMAX ,FXY,
+     >               FP1  ,FP2  ,F2X   ,F2Y   ,FDUMMY,
+     >               XINT ,YINT ,FYINT ,FXYINT)
+
+         FZINT(K) = FXYINT
+
+   10 CONTINUE
+*----
+*  CALCULATE SECOND DERIVATIVE ALONG Z AT XINT,YINT
+*----
+      CALL DETSPLI(ZCNTR,FZINT,NZMAX,FP1,FP2,F2Z)
+*----
+*  INTERPOLATE ALONG Z FOR XINT,YINT
+*----
+      CALL DETSPLI2(ZCNTR,FZINT,F2Z,NZMAX,ZINT,FINTRP)
+
+      RETURN
+      END
diff --git a/Donjon/src/DETSPLI.f b/Donjon/src/DETSPLI.f
new file mode 100644
index 0000000..93eaa70
--- /dev/null
+++ b/Donjon/src/DETSPLI.f
@@ -0,0 +1,40 @@
+*DECK DETSPLI
+      SUBROUTINE DETSPLI(X,Y,N,YP1,YPN,Y2)
+*
+*Parameters: 
+* X     
+* Y     
+* N     
+* YP1   
+* YPN   
+* Y2    
+*     
+      PARAMETER (NMAX=100)
+      DIMENSION X(N),Y(N),Y2(N),U(NMAX)
+      IF (YP1.GT..99E30) THEN
+        Y2(1)=0.
+        U(1)=0.
+      ELSE
+        Y2(1)=-0.5
+        U(1)=(3./(X(2)-X(1)))*((Y(2)-Y(1))/(X(2)-X(1))-YP1)
+      ENDIF
+      DO 11 I=2,N-1
+        SIG=(X(I)-X(I-1))/(X(I+1)-X(I-1))
+        P=SIG*Y2(I-1)+2.
+        Y2(I)=(SIG-1.)/P
+        U(I)=(6.*((Y(I+1)-Y(I))/(X(I+1)-X(I))-(Y(I)-Y(I-1))
+     *      /(X(I)-X(I-1)))/(X(I+1)-X(I-1))-SIG*U(I-1))/P
+11    CONTINUE
+      IF (YPN.GT..99E30) THEN
+        QN=0.
+        UN=0.
+      ELSE
+        QN=0.5
+        UN=(3./(X(N)-X(N-1)))*(YPN-(Y(N)-Y(N-1))/(X(N)-X(N-1)))
+      ENDIF
+      Y2(N)=(UN-QN*U(N-1))/(QN*Y2(N-1)+1.)
+      DO 12 K=N-1,1,-1
+        Y2(K)=Y2(K)*Y2(K+1)+U(K)
+12    CONTINUE
+      RETURN
+      END
diff --git a/Donjon/src/DETSPLI2.f b/Donjon/src/DETSPLI2.f
new file mode 100644
index 0000000..1d37d25
--- /dev/null
+++ b/Donjon/src/DETSPLI2.f
@@ -0,0 +1,31 @@
+*DECK DETSPLI2
+      SUBROUTINE DETSPLI2(XA,YA,Y2A,N,X,Y)
+*
+*Parameters: 
+* XA       
+* YA       
+* Y2A      
+* N        
+* X         
+* Y    
+*     
+      DIMENSION XA(N),YA(N),Y2A(N)
+      KLO=1
+      KHI=N
+1     IF (KHI-KLO.GT.1) THEN
+        K=(KHI+KLO)/2
+        IF(XA(K).GT.X)THEN
+          KHI=K
+        ELSE
+          KLO=K
+        ENDIF
+      GOTO 1
+      ENDIF
+      H=XA(KHI)-XA(KLO)
+      IF (H.EQ.0.) CALL XABORT('DETSPLI2: BAD XA INPUT.')
+      A=(XA(KHI)-X)/H
+      B=(X-XA(KLO))/H
+      Y=A*YA(KLO)+B*YA(KHI)+
+     *      ((A**3-A)*Y2A(KLO)+(B**3-B)*Y2A(KHI))*(H**2)/6.
+      RETURN
+      END
diff --git a/Donjon/src/DEVDGD.f b/Donjon/src/DEVDGD.f
new file mode 100644
index 0000000..2f9d7f5
--- /dev/null
+++ b/Donjon/src/DEVDGD.f
@@ -0,0 +1,155 @@
+*DECK DEVDGD
+      SUBROUTINE DEVDGD(IPDEV,NROD,DGRP,IMPX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Create rod-device group directories on the device data structure.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki
+*
+*Parameters: input
+* IPDEV  pointer to device information.
+* NROD   total number of rod-devices.
+* DGRP   total number of rod-device groups.
+* IMPX   printing index (=0 for no print).
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPDEV
+      INTEGER NROD,DGRP,IMPX
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(IOUT=6)
+      CHARACTER TEXT*12
+      INTEGER RODID(NROD)
+      DOUBLE PRECISION DFLOT
+      TYPE(C_PTR) JPDEV,KPDEV
+*----
+*  CREATE GROUPS
+*----
+      JPDEV=LCMLID(IPDEV,'ROD_GROUP',DGRP)
+      IGRP=0
+      IF(IMPX.GT.0)WRITE(IOUT,1001)
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('@DEVDGD: KEYWORD GROUP-ID EXPECTED.')
+      IF(TEXT.NE.'GROUP-ID')CALL XABORT('@DEVDGD: KEYWORD GROUP-'
+     1 //'ID EXPECTED.')
+   10 IGRP=IGRP+1
+      CALL REDGET(ITYP,JGRP,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.1)CALL XABORT('@DEVDGD: INTEGER GROUP-ID NUMBER'
+     1 //' EXPECTED.')
+      IF(JGRP.NE.IGRP)THEN
+        WRITE(IOUT,*)'@DEVDGD: READ GROUP-ID NUMBER #',JGRP
+        WRITE(IOUT,*)'@DEVDGD: EXPECTED GROUP-ID NUMBER #',IGRP
+        CALL XABORT('@DEVDGD: WRONG GROUP-ID NUMBER.')
+      ENDIF
+      IF(JGRP.GT.DGRP)THEN
+        WRITE(IOUT,*)'@DEVDGD: GIVEN TOTAL NUMBER OF GROUPS ',DGRP
+        WRITE(IOUT,*)'@DEVDGD: READ GROUP-ID NUMBER #',JGRP
+        CALL XABORT('@DEVDGD: WRONG GROUP-ID NUMBER.')
+      ENDIF
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('@DEVDGD: KEYWORD EXPECTED.')
+*----
+*  OPTION ALL
+*----
+      IF(TEXT.EQ.'ALL')THEN
+        KPDEV=LCMDIL(JPDEV,IGRP)
+        DO 30 ID=1,NROD
+        RODID(ID)=ID
+   30   CONTINUE
+        CALL LCMPUT(KPDEV,'GROUP-ID',1,1,IGRP)
+        CALL LCMPUT(KPDEV,'NUM-ROD',1,1,NROD)
+        CALL LCMPUT(KPDEV,'ROD-ID',NROD,1,RODID)
+*
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@DEVDGD: WRONG INPUT DATA.')
+        IF(TEXT.EQ.';')THEN
+          IF(IGRP.EQ.DGRP)THEN
+            NDG=NROD
+            GOTO 100
+          ENDIF
+          WRITE(IOUT,*)'@DEVDGD: GIVEN TOTAL NUMBER OF GROUPS ',DGRP
+          WRITE(IOUT,*)'@DEVDGD: CREATED ONLY NUMBER OF GROUPS ',IGRP
+          CALL XABORT('@DEVDGD: WRONG NUMBER OF GROUPS.')
+        ELSEIF(TEXT.EQ.'GROUP-ID')THEN
+          IF(IMPX.GT.0)WRITE(IOUT,1000)IGRP,NROD
+          GOTO 10
+        ELSE
+          CALL XABORT('@DEVDGD: WRONG KEYWORD '//TEXT)
+        ENDIF
+*----
+*  OPTION ROD-ID
+*----
+      ELSEIF(TEXT.EQ.'ROD-ID')THEN
+        NDG=0
+        RODID(:NROD)=0
+        KPDEV=LCMDIL(JPDEV,IGRP)
+*
+   50   CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.EQ.3)THEN
+          IF(TEXT.EQ.';')THEN
+            IF(IGRP.EQ.DGRP)GOTO 100
+            WRITE(IOUT,*)'@DEVDGD: GIVEN TOTAL NUMBER OF GROUPS ',DGRP
+            WRITE(IOUT,*)'@DEVDGD: CREATED ONLY NUMBER OF GROUPS ',IGRP
+            CALL XABORT('@DEVDGD: WRONG NUMBER OF GROUPS.')
+          ELSEIF(TEXT.EQ.'GROUP-ID')THEN
+            IF(IMPX.GT.0)WRITE(IOUT,1000)IGRP,NDG
+            GOTO 10
+          ELSE
+            CALL XABORT('@DEVDGD: WRONG KEYWORD '//TEXT)
+          ENDIF
+*----
+*  ROD-ID NUMBERS
+*----
+        ELSEIF(ITYP.EQ.1)THEN
+          ID=NITMA
+          IF((ID.GT.NROD).OR.(ID.LE.0))THEN
+            WRITE(IOUT,*)'@DEVDGD: FOR THE GROUP #',IGRP
+            WRITE(IOUT,*)'@DEVDGD: READ ROD-ID #',ID
+            CALL XABORT('@DEVDGD: WRONG ROD-ID NUMBER.')
+          ENDIF
+          DO I=1,NROD
+            IF(ID.EQ.RODID(I))THEN
+              WRITE(IOUT,*)'@DEVDGD: FOR THE GROUP #',IGRP
+              WRITE(IOUT,*)'@DEVDGD: REPEATED ROD-ID #',ID
+              CALL XABORT('@DEVDGD: WRONG ROD-ID NUMBER.')
+            ENDIF
+          ENDDO
+*
+          NDG=NDG+1
+          IF(NDG.GT.NROD)THEN
+            WRITE(IOUT,*)'@DEVDGD: FOR THE GROUP #',IGRP
+            WRITE(IOUT,*)'@DEVDGD: WRONG TOTAL NUMBER OF RODS ',NDG
+            CALL XABORT('@DEVDGD: INVALID INPUT OF ROD-DEVICES.')
+          ENDIF
+          RODID(NDG)=ID
+          CALL LCMPUT(KPDEV,'GROUP-ID',1,1,IGRP)
+          CALL LCMPUT(KPDEV,'NUM-ROD',1,1,NDG)
+          CALL LCMPUT(KPDEV,'ROD-ID',NDG,1,RODID)
+        ELSE
+          CALL XABORT('@DEVDGD: WRONG INPUT DATA.')
+        ENDIF
+        GOTO 50
+      ELSE
+        CALL XABORT('@DEVDGD: WRONG KEYWORD '//TEXT)
+      ENDIF
+  100 IF(IMPX.GT.0)WRITE(IOUT,1000)IGRP,NDG
+      IF(IMPX.GT.0)WRITE(IOUT,1002)DGRP
+      RETURN
+*
+ 1000 FORMAT(/1X,' => CREATED A GROUP #',I2.2,
+     1        4X,'INCLUDES TOTAL NUMBER OF RODS:',I3)
+ 1001 FORMAT(/1X,'**  CREATING GROUPS FOR ROD-DEVICES  **')
+ 1002 FORMAT(/1X,39('-')/1X,'TOTAL NUMBER OF GROUPS CREATED: ',I2)
+      END
diff --git a/Donjon/src/DEVDRV.f b/Donjon/src/DEVDRV.f
new file mode 100644
index 0000000..bbe4f20
--- /dev/null
+++ b/Donjon/src/DEVDRV.f
@@ -0,0 +1,154 @@
+*DECK DEVDRV
+      SUBROUTINE DEVDRV(IPDEV,IPMTX,IGEO,NMIX,NTOT,LIMIT)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Read specifications for the rod-devices from the input file.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki and A. Hebert
+*
+*Parameters: input
+* IPDEV  pointer to device information.
+* IPMTX  pointer to matex information.
+* IGEO   index related to the reactor geometry.
+* NMIX   old maximum number of material mixtures.
+* NTOT   old total number of all mixtures.
+* LIMIT  core limiting coordinates.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPDEV,IPMTX
+      INTEGER IGEO,NMIX,NTOT
+      REAL LIMIT(6)
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(NSTATE=40,IOUT=6,MAXPRT=10)
+      CHARACTER TEXT*12,HSMG*131
+      TYPE(C_PTR) JPDEV,KPDEV
+      INTEGER ISTATE(NSTATE),NRGRP,DMIX(2,MAXPRT)
+      DOUBLE PRECISION DFLOT
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: MIX
+*----
+*  CORE LIMITS
+*----
+      CALL LCMPUT(IPDEV,'CORE-LIMITS',6,2,LIMIT)
+*----
+*  READ INPUT DATA
+*----
+      IMPX=1
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('@DEVDRV: CHARACTER DATA EXPECTED(1).')
+      IF(TEXT.NE.'EDIT')GOTO 10
+*     PRINTING INDEX
+      CALL REDGET(ITYP,IMPX,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.1)CALL XABORT('@DEVDRV: INTEGER FOR EDIT EXPECTED.')
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('@DEVDRV: CHARACTER DATA EXPECTED(2).')
+   10 IF(TEXT.NE.'NUM-ROD')CALL XABORT('@DEVDRV: KEYWORD NUM-ROD EX'
+     1 //'PECTED.')
+*     TOTAL NUMBER OF RODS
+      CALL REDGET(ITYP,NROD,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.1)CALL XABORT('@DEVDRV: INTEGER TOTAL NUMBER OF ROD'
+     1 //'S EXPECTED.')
+      IF(NROD.LT.1)CALL XABORT('@DEVDRV: WRONG TOTAL NUMBER OF RODS <1')
+      IF(IMPX.GT.1)WRITE(IOUT,1003) LIMIT(1),LIMIT(3),LIMIT(5),LIMIT(2),
+     1 LIMIT(4),LIMIT(6)
+      IF(IMPX.GT.0)WRITE(IOUT,1000) NROD
+*
+      MAXTOT=NTOT+NROD*2*MAXPRT
+      ALLOCATE(MIX(MAXTOT))
+      MIX(:MAXTOT)=0
+      CALL LCMGET(IPMTX,'MAT',MIX)
+*----
+*  READ OPTION
+*----
+      NRGRP=0
+      IMODE=1
+      JPDEV=LCMLID(IPDEV,'DEV_ROD',NROD)
+   30 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(TEXT.EQ.'ROD')THEN
+*       READ INDIVIDUAL ROD DATA
+        CALL DEVGET(JPDEV,NROD,LIMIT,IMODE,IMPX)
+      ELSE IF(TEXT.EQ.'CREATE')THEN
+*       CREATE ROD-GROUPS
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(TEXT.NE.'ROD-GR') CALL XABORT('@DEVDRV: KEYWORD ROD-GR EX'
+     1  //'PECTED.')
+        CALL REDGET(ITYP,NRGRP,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1) CALL XABORT('@DEVDRV: INTEGER NUMBER OF ROD-GR'
+     1  //'OUPS EXPECTED.')
+        IF(NRGRP.LT.1) CALL XABORT('@DEVDRV: WRONG NUMBER OF GROUPS <1')
+        CALL DEVDGD(IPDEV,NROD,NRGRP,IMPX)
+        GO TO 40
+      ELSE IF(TEXT.EQ.'FADE')THEN
+        IMODE=1
+      ELSE IF(TEXT.EQ.'MOVE')THEN
+        IMODE=2
+      ELSE IF(TEXT.EQ.';') THEN
+        GOTO 40
+      ELSE
+        WRITE(HSMG,'(26H@DEVDRV: INVALID KEYWORD (,A,2H).)') TEXT
+        CALL XABORT(HSMG)
+      ENDIF
+      GOTO 30
+*----
+*  VALIDATE ROD DATA AND SET MIXTURE INDICES
+*----
+   40 IOFSET=0
+      DO 60 ID=1,NROD
+      CALL LCMLEL(JPDEV,ID,LENGT,ITYLCM)
+      IF(LENGT.EQ.0) THEN
+        WRITE(HSMG,'(18H@DEVDRV: ROD INDEX,I5,16H IS NOT DEFINED.)') ID
+        CALL XABORT(HSMG)
+      ENDIF
+      KPDEV=LCMGIL(JPDEV,ID)
+      CALL LCMGET(KPDEV,'ROD-PARTS',NPART)
+      IF(NPART.GT.MAXPRT) CALL XABORT('@DEVDRV: MAXPRT OVERFLOW.')
+      CALL LCMGET(KPDEV,'ROD-MIX',DMIX)
+      DO 55 IPART=1,NPART
+      DO 50 I=1,2
+      IOFSET=IOFSET+1
+      IF(IOFSET.GT.MAXTOT) CALL XABORT('@DEVDRV: MAXTOT OVERFLOW.')
+      MIX(NTOT+IOFSET)=DMIX(I,IPART)
+      DMIX(I,IPART)=NMIX+IOFSET
+   50 CONTINUE
+   55 CONTINUE
+      CALL LCMPUT(KPDEV,'ROD-MIX',2*NPART,1,DMIX)
+   60 CONTINUE
+*----
+*  STATE-VECTORS
+*----
+      ISTATE(:NSTATE)=0
+      ISTATE(1)=IGEO
+      ISTATE(2)=NROD
+      ISTATE(3)=NRGRP
+      ISTATE(6)=IMODE
+      CALL LCMPUT(IPDEV,'STATE-VECTOR',NSTATE,1,ISTATE)
+      IF(IMPX.GT.1)CALL LCMLIB(IPDEV)
+*     UPDATE MATEX
+      ISTATE(:NSTATE)=0
+      CALL LCMGET(IPMTX,'STATE-VECTOR',ISTATE)
+      ISTATE(2)=NMIX+IOFSET
+      ISTATE(5)=NTOT+IOFSET
+      CALL LCMPUT(IPMTX,'MAT',NTOT+IOFSET,1,MIX)
+      CALL LCMPUT(IPMTX,'STATE-VECTOR',NSTATE,1,ISTATE)
+      DEALLOCATE(MIX)
+      IF(IMPX.GT.4) CALL LCMLIB(IPMTX)
+      RETURN
+*
+ 1000 FORMAT(/1X,'DEVDRV: GIVEN TOTAL NUMBER OF ROD-DEVICES:',
+     1 I5//' **  READING INPUT DATA FOR RODS  **')
+ 1003 FORMAT(//5X,'---  REACTOR CORE LIMITS  ---'//
+     1 1X,'Xmin',F10.4,5X,'Ymin',F10.4,5X,'Zmin',F10.4/
+     2 1X,'Xmax',F10.4,5X,'Ymax',F10.4,5X,'Zmax',F10.4/)
+      END
diff --git a/Donjon/src/DEVGET.f b/Donjon/src/DEVGET.f
new file mode 100644
index 0000000..9744aaf
--- /dev/null
+++ b/Donjon/src/DEVGET.f
@@ -0,0 +1,279 @@
+*DECK DEVGET
+      SUBROUTINE DEVGET(JPDEV,NROD,LIMIT,IMODE,IMPX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Read the specification for a given rod from the input file.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki and A. Hebert
+*
+*Parameters: input
+* JPDEV  pointer to LCM list object with device information.
+* NROD   total number of rods.
+* LIMIT  full-core limits.
+* IMODE  type of rod movement.
+* IMPX   printing index (=0 for no print).
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) JPDEV
+      INTEGER NROD,IMODE,IMPX
+      REAL LIMIT(6)
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(IOUT=6,MAXPRT=10)
+      INTEGER DMIX(2,MAXPRT)
+      REAL MAXPOS(6,MAXPRT),RODPOS(6,MAXPRT),LENG(2),LEVEL
+      DOUBLE PRECISION DFLOT
+      CHARACTER TEXT*12,RNAME*12,AXIS,FROM*2,HSMG*131
+      TYPE(C_PTR) KPDEV
+*----
+*  ROD INDEX
+*----
+      CALL REDGET(ITYP,ID,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.1) CALL XABORT('@DEVGET: INTEGER ROD-ID EXPECTED.')
+      IF(ID.LE.0) CALL XABORT('@DEVGET: POSITIVE ROD-ID EXPECTED.')
+      IF(ID.GT.NROD)THEN
+        WRITE(IOUT,*)'@DEVGET: READ CURRENT ROD-ID #',ID
+        WRITE(IOUT,*)'@DEVGET: GIVEN TOTAL NUMBER OF RODS:',NROD
+        CALL XABORT('@DEVGET: WRONG INPUT OF ROD-ID NUMBER. GREATER'
+     1   //' THAN THE TOTAL NUMBER OF RODS.')
+      ENDIF
+      CALL LCMLEL(JPDEV,ID,ILONG,ITYLCM)
+      IF(ILONG.NE.0) THEN
+        WRITE(HSMG,'(18H@DEVGET: ROD INDEX,I5,16H ALREADY EXISTS.)') ID
+        CALL XABORT(HSMG)
+      ENDIF
+      IF(IMPX.GT.1) WRITE(IOUT,1000) ID
+      KPDEV=LCMDIL(JPDEV,ID)
+*----
+*  READ ROD-SPECIFIC DATA
+*----
+      IAXIS=0
+      NPART=0
+      ITOP=0
+      LEVEL=-999.0
+      SPEED=-999.0
+      TIME=-999.0
+      RNAME='NOT_DEFINED'
+      LENG(1)=MAX(LIMIT(2),LIMIT(4),LIMIT(6))
+      LENG(2)=MIN(LIMIT(1),LIMIT(3),LIMIT(5))
+   10 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3)  CALL XABORT('@DEVGET: CHARECTER NAME EXPECTED.')
+      IF(TEXT.EQ.'ROD-NAME') THEN
+        CALL REDGET(ITYP,NITMA,FLOT,RNAME,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@DEVGET: ROD NAME EXPECTED.')
+      ELSE IF(TEXT.EQ.'LEVEL') THEN
+        CALL REDGET(ITYP,NITMA,LEVEL,TEXT,DFLOT)
+        IF(ITYP.NE.2) CALL XABORT('@DEVGET: REAL LEVEL EXPECTED.')
+        IF(LEVEL.GT.1.0) CALL XABORT('@DEVGET: WRONG LEVEL VALUE > 1.')
+        IF(LEVEL.LT.0.0) CALL XABORT('@DEVGET: WRONG LEVEL VALUE < 0.')
+      ELSE IF(TEXT.EQ.'TIME') THEN
+        CALL REDGET(ITYP,NITMA,TIME,TEXT,DFLOT)
+        IF(ITYP.NE.2) CALL XABORT('@DEVGET: REAL FOR TIME EXPECTED.')
+        IF(TIME.LT.0.0) CALL XABORT('@DEVGET: WRONG TIME VALUE < 0.')
+      ELSE IF(TEXT.EQ.'SPEED') THEN
+        CALL REDGET(ITYP,NITMA,SPEED,TEXT,DFLOT)
+        IF(ITYP.NE.2) CALL XABORT('@DEVGET: REAL FOR SPEED EXPECTED.')
+        IF(SPEED.LT.0.0) CALL XABORT('@DEVGET: WRONG SPEED VALUE < 0.')
+      ELSE IF(TEXT.EQ.'AXIS') THEN
+        CALL REDGET(ITYP,NITMA,FLOT,AXIS,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@DEVGET: AXIS NAME EXPECTED.')
+        IF(AXIS.EQ.'X') THEN
+          IAXIS=1
+        ELSE IF(AXIS.EQ.'Y') THEN
+          IAXIS=2
+        ELSE IF(AXIS.EQ.'Z') THEN
+          IAXIS=3
+        ELSE
+          CALL XABORT('@DEVGET: X, Y OR Z EXPECTED FOR AXIS.')
+        ENDIF
+      ELSE IF(TEXT.EQ.'FROM') THEN
+        CALL REDGET(ITYP,NITMA,FLOT,FROM,DFLOT)
+        IF(FROM.EQ.'H+')THEN
+          ITOP=1
+        ELSEIF(FROM.EQ.'H-')THEN
+          ITOP=-1
+        ELSE
+          CALL XABORT('@DEVGET: KEYWORD H+ OR H- EXPECTED.')
+        ENDIF
+      ELSE IF(TEXT.EQ.'MAXPOS') THEN
+        NPART=NPART+1
+        IF(NPART.GT.MAXPRT) CALL XABORT('@DEVGET: MAXPRT OVERFLOW.')
+        DO I=1,6
+          CALL REDGET(ITYP,NITMA,MAXPOS(I,NPART),TEXT,DFLOT)
+          IF(ITYP.NE.2) CALL XABORT('@DEVGET: REAL POSITION EXPECTED.')
+        ENDDO
+        IF(MAXPOS(2,NPART).LT.MAXPOS(1,NPART)) THEN
+          CALL XABORT('@DEVGET: WRONG X ROD COORDINATES: X- > X+')
+        ELSE IF(MAXPOS(1,NPART).LT.LIMIT(1)) THEN
+          CALL XABORT('@DEVGET: WRONG X- VALUE.')
+        ELSE IF(MAXPOS(2,NPART).GT.LIMIT(2)) THEN
+          CALL XABORT('@DEVGET: WRONG X+ VALUE.')
+        ELSE IF(MAXPOS(4,NPART).LT.MAXPOS(3,NPART)) THEN
+          CALL XABORT('@DEVGET: WRONG Y ROD COORDINATES: Y- > Y+')
+        ELSE IF(MAXPOS(3,NPART).LT.LIMIT(3)) THEN
+          CALL XABORT('@DEVGET: WRONG Y- VALUE.')
+        ELSE IF(MAXPOS(4,NPART).GT.LIMIT(4)) THEN
+          CALL XABORT('@DEVGET: WRONG Y+ VALUE.')
+        ELSE IF(MAXPOS(6,NPART).LT.MAXPOS(5,NPART)) THEN
+          CALL XABORT('@DEVGET: WRONG Z ROD COORDINATES: Z- > Z+')
+        ELSE IF(MAXPOS(5,NPART).LT.LIMIT(5)) THEN
+          CALL XABORT('@DEVGET: WRONG Z- VALUE.')
+        ELSE IF(MAXPOS(6,NPART).GT.LIMIT(6)) THEN
+          CALL XABORT('@DEVGET: WRONG Z+ VALUE.')
+        ENDIF
+        IF(IAXIS.EQ.0) THEN
+          WRITE(HSMG,'(33H@DEVGET: MISSING AXIS DATA IN ROD,I5)') ID
+          CALL XABORT(HSMG)
+        ELSE IF(IAXIS.EQ.1) THEN
+          LENG(1)=MIN(LENG(1),MAXPOS(1,NPART))
+          LENG(2)=MAX(LENG(2),MAXPOS(2,NPART))
+        ELSE IF(IAXIS.EQ.2) THEN
+          LENG(1)=MIN(LENG(1),MAXPOS(3,NPART))
+          LENG(2)=MAX(LENG(2),MAXPOS(4,NPART))
+        ELSE IF(IAXIS.EQ.3) THEN
+          LENG(1)=MIN(LENG(1),MAXPOS(5,NPART))
+          LENG(2)=MAX(LENG(2),MAXPOS(6,NPART))
+        ENDIF
+*
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(TEXT.NE.'DMIX') THEN
+          WRITE(HSMG,'(30H@DEVGET: DMIX EXPECTED FOR ROD,I5)') ID
+          CALL XABORT(HSMG)
+        ENDIF
+        DO I=1,2
+          CALL REDGET(ITYP,DMIX(I,NPART),FLOT,TEXT,DFLOT)
+          IF(ITYP.NE.1) CALL XABORT('@DEVGET: INTEGER DMIX EXPECTED.')
+        ENDDO
+      ELSE IF(TEXT.EQ.'ENDROD') THEN
+        GO TO 20
+      ELSE
+        WRITE(HSMG,'(26H@DEVGET: INVALID KEYWORD (,A,9H) FOR ROD,I5)')
+     1  TEXT,ID
+        CALL XABORT(HSMG)
+      ENDIF
+      GO TO 10
+*----
+*  VALIDATE ROD POSITION
+*----
+   20 IF(IMPX.GT.1) THEN
+        DO 25 IPART=1,NPART
+        WRITE(IOUT,1001) RNAME,IPART,MAXPOS(1,IPART),MAXPOS(3,IPART),
+     1  MAXPOS(5,IPART),MAXPOS(2,IPART),MAXPOS(4,IPART),MAXPOS(6,IPART)
+   25   CONTINUE
+      ENDIF
+      EPS=1.0E-4*(LENG(2)-LENG(1))
+      DO 30 IPART=1,NPART-1
+      IF(IAXIS.EQ.1) THEN
+        IF((ABS(MAXPOS(1,IPART)-MAXPOS(2,IPART+1)).GT.EPS).AND.
+     1     (ABS(MAXPOS(2,IPART)-MAXPOS(1,IPART+1)).GT.EPS)) THEN
+          WRITE(HSMG,1008) IPART,ID
+          CALL XABORT(HSMG)
+        ENDIF
+      ELSE IF(IAXIS.EQ.2) THEN
+        IF((ABS(MAXPOS(3,IPART)-MAXPOS(4,IPART+1)).GT.EPS).AND.
+     1     (ABS(MAXPOS(4,IPART)-MAXPOS(3,IPART+1)).GT.EPS)) THEN
+          WRITE(HSMG,1008) IPART,ID
+          CALL XABORT(HSMG)
+        ENDIF
+      ELSE IF(IAXIS.EQ.3) THEN
+        IF((ABS(MAXPOS(5,IPART)-MAXPOS(6,IPART+1)).GT.EPS).AND.
+     1     (ABS(MAXPOS(6,IPART)-MAXPOS(5,IPART+1)).GT.EPS)) THEN
+          WRITE(HSMG,1008) IPART,ID
+          CALL XABORT(HSMG)
+        ENDIF
+      ENDIF
+   30 CONTINUE
+*----
+*  SET CURRENT ROD POSITION
+*----
+      IF(NPART.EQ.0) THEN
+        WRITE(HSMG,'(35H@DEVGET: MISSING MAXPOS DATA IN ROD,I5)') ID
+        CALL XABORT(HSMG)
+      ELSE IF(ITOP.EQ.0) THEN
+        WRITE(HSMG,'(33H@DEVGET: MISSING FROM DATA IN ROD,I5)') ID
+        CALL XABORT(HSMG)
+      ENDIF
+      IF(LEVEL.GE.0.0) THEN
+        DO 45 IPART=1,NPART
+        DO 40 I=1,6
+        RODPOS(I,IPART)=MAXPOS(I,IPART)
+   40   CONTINUE
+   45   CONTINUE
+        IF(IMODE.EQ.1) THEN
+*         FADING ROD
+          DELH=LEVEL*(LENG(2)-LENG(1))
+        ELSE IF(IMODE.EQ.2) THEN
+*         MOVING ROD
+          IF(ITOP.EQ.-1) THEN
+            DELH=LEVEL*(LENG(2)-LIMIT(1))+LIMIT(1)
+          ELSE IF(ITOP.EQ.1) THEN
+            DELH=LIMIT(2)-LEVEL*(LIMIT(2)-LENG(1))
+          ENDIF
+          DELH=MIN(LIMIT(2),MAX(LIMIT(1),DELH))
+          IF(IMPX.GT.3) THEN
+            WRITE(IOUT,*) '    ADJ ',NXSEQ,' LEVEL ',LEVEL*100.,
+     1                    '% OF INSERTION'
+            WRITE(IOUT,*) '    NEW POSITION (L_sup)= ',DELH
+          ENDIF
+        ENDIF
+        CALL MOVCHK(0,IMODE,NPART,IAXIS,ITOP,DELH,LENG,RODPOS)
+      ENDIF
+*----
+*  STORE ROD DATA
+*----
+      CALL LCMPUT(KPDEV,'ROD-ID',1,1,ID)
+      CALL LCMPUT(KPDEV,'ROD-PARTS',1,1,NPART)
+      CALL LCMPTC(KPDEV,'ROD-NAME',12,RNAME)
+      CALL LCMPUT(KPDEV,'FROM',1,1,ITOP)
+      CALL LCMPUT(KPDEV,'AXIS',1,1,IAXIS)
+      CALL LCMPUT(KPDEV,'LENGTH',2,2,LENG)
+      IF(LEVEL.GE.0.0) CALL LCMPUT(KPDEV,'LEVEL',1,2,LEVEL)
+      IF(SPEED.GE.0.0) CALL LCMPUT(KPDEV,'SPEED',1,2,SPEED)
+      IF(TIME.GE.0.0) CALL LCMPUT(KPDEV,'TIME',1,2,TIME)
+      IF(LEVEL.GE.0.0) CALL LCMPUT(KPDEV,'MAX-POS',6*NPART,2,MAXPOS)
+      CALL LCMPUT(KPDEV,'ROD-POS',6*NPART,2,RODPOS)
+      CALL LCMPUT(KPDEV,'ROD-MIX',2*NPART,1,DMIX)
+*
+      IF(IMPX.GT.1) THEN
+        DO 50 IPART=1,NPART
+        WRITE(IOUT,1002) RNAME,IPART,RODPOS(1,IPART),RODPOS(3,IPART),
+     1  RODPOS(5,IPART),RODPOS(2,IPART),RODPOS(4,IPART),RODPOS(6,IPART)
+   50   CONTINUE
+        WRITE(IOUT,1003) LENG(2)-LENG(1),FROM,AXIS
+        IF(LEVEL.GE.0.0) WRITE(IOUT,1004) LEVEL
+        IF(SPEED.GE.0.0) WRITE(IOUT,1005) SPEED
+        IF(TIME.GE.0.0) WRITE(IOUT,1006) TIME
+        WRITE(IOUT,1007)
+      ENDIF
+      RETURN
+*
+ 1000 FORMAT(/3X,'DEVGET: =>',2X,'ROD #',I3.3)
+ 1001 FORMAT(/5X,'ROD NAME',1X,'=>',1X,A,'(PART',I5,')'/
+     1   5X,'FULL-INSERTED ROD POSITION :',
+     2   4X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4/
+     3  37X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4/5X,80(1H-))
+ 1002 FORMAT(/5X,'ROD NAME',1X,'=>',1X,A,'(PART',I5,')'/
+     1   5X,'CURRENT ROD POSITION :',
+     1   5X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4/
+     2  32X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4/5X,80(1H-))
+ 1003 FORMAT(5X,'ROD LENGTH =',F9.4/
+     1  5X,'INSERTION FROM : ',A2,5X,'MOVEMENT AXIS : ',A1)
+ 1004 FORMAT(5X,'INSERTION LEVEL =',F8.4)
+ 1005 FORMAT(5X,'INSERTION SPEED =',1P,E11.4)
+ 1006 FORMAT(5X,'INSERTION TIME  =',1P,E11.4)
+ 1007 FORMAT(5X,80(1H-)/5X,80(1H-))
+ 1008 FORMAT(39H@DEVGET: INCORRECT ROD POSITION IN PART,I5,
+     1 7H OF ROD,I5)
+      END
diff --git a/Donjon/src/DEVINI.f b/Donjon/src/DEVINI.f
new file mode 100644
index 0000000..28c3315
--- /dev/null
+++ b/Donjon/src/DEVINI.f
@@ -0,0 +1,115 @@
+*DECK DEVINI
+      SUBROUTINE DEVINI(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Read specification for the rod-devices, create a device object.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The DEVINI: module specification is:
+* DEVICE MATEX := DEVINI: MATEX :: (descdev) ;
+* where
+*   DEVICE : name of the \emph{device) object that will be created by the 
+*     module; it will contain the devices information.
+*   MATEX  : name of the \emph{matex} object that will be updated by the 
+*     module. The rod-devices material mixtures are appended to the previous 
+*     material index and the rod-devices indices are also modified, accordingly.
+*   (descdev) : structure describing the input data to the DEVINI: module.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(NSTATE=40)
+      CHARACTER HSIGN*12,TEXT12*12
+      INTEGER ISTATE(NSTATE)
+      REAL LIMIT(6)
+      TYPE(C_PTR) IPDEV,IPMTX
+      REAL, ALLOCATABLE, DIMENSION(:) :: XXX,YYY,ZZZ
+*----
+*  PARAMETER VALIDATION
+*----
+      IF(NENTRY.NE.2)CALL XABORT('@DEVINI: TWO PARAMETERS EXPECTED')
+      TEXT12=HENTRY(1)
+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2))CALL XABORT('@DEVI'
+     1 //'NI: LCM OBJECT FOR L_DEVICE EXPECTED ('//TEXT12//').')
+      IF(JENTRY(1).NE.0)CALL XABORT('@DEVINI: CREATE MODE EXPECTE'
+     1 //'D FOR L_DEVICE.')
+      HSIGN='L_DEVICE'
+      CALL LCMPTC(KENTRY(1),'SIGNATURE',12,HSIGN)
+      IPDEV=KENTRY(1)
+      TEXT12=HENTRY(2)
+      IF((IENTRY(2).NE.1).AND.(IENTRY(2).NE.2))CALL XABORT('@DEVI'
+     1 //'NI: LCM OBJECT FOR L_MATEX EXPECTED ('//TEXT12//').')
+      CALL LCMGTC(KENTRY(2),'SIGNATURE',12,HSIGN)
+      IF(HSIGN.NE.'L_MATEX')CALL XABORT('@DEVINI: MISSING L_MATEX.')
+      IF(JENTRY(2).NE.1)CALL XABORT('@DEVINI: MODIFICATION MODE E'
+     1 //'XPECTED FOR L_MATEX.')
+      IPMTX=KENTRY(2)
+*----
+*  RECOVER INFORMATION
+*----
+      ISTATE(:NSTATE)=0
+      CALL LCMGET(IPMTX,'STATE-VECTOR',ISTATE)
+      IGEO=ISTATE(6)
+      IF(IGEO.NE.7)CALL XABORT('@DEVINI: ON'
+     1 //'LY 3D-CARTESIAN GEOMETRY ALLOWED.')
+      NMIX=ISTATE(2)
+      NTOT=ISTATE(5)
+      LX=ISTATE(8)
+      LY=ISTATE(9)
+      LZ=ISTATE(10)
+*     CORE LIMITS ALONG X-AXIS
+      ALLOCATE(XXX(LX+1))
+      XXX(:LX+1)=0.0
+      CALL LCMGET(IPMTX,'MESHX',XXX)
+      LIMIT(1)=XXX(1)
+      LIMIT(2)=XXX(LX+1)
+      DEALLOCATE(XXX)
+*     CORE LIMITS ALONG Y-AXIS
+      ALLOCATE(YYY(LY+1))
+      YYY(:LY+1)=0.0
+      CALL LCMGET(IPMTX,'MESHY',YYY)
+      LIMIT(3)=YYY(1)
+      LIMIT(4)=YYY(LY+1)
+      DEALLOCATE(YYY)
+*     CORE LIMITS ALONG Z-AXIS
+      ALLOCATE(ZZZ(LZ+1))
+      ZZZ(:LZ+1)=0.0
+      CALL LCMGET(IPMTX,'MESHZ',ZZZ)
+      LIMIT(5)=ZZZ(1)
+      LIMIT(6)=ZZZ(LZ+1)
+      DEALLOCATE(ZZZ)
+*     READ ROD-DEVICES DATA
+      CALL DEVDRV(IPDEV,IPMTX,IGEO,NMIX,NTOT,LIMIT)
+      RETURN
+      END
diff --git a/Donjon/src/DLEAK.f b/Donjon/src/DLEAK.f
new file mode 100644
index 0000000..f3e629b
--- /dev/null
+++ b/Donjon/src/DLEAK.f
@@ -0,0 +1,303 @@
+*DECK DLEAK

+      SUBROUTINE DLEAK(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Create a delta Macrolib with respect to leakage information.

+*

+*Copyright:

+* Copyright (C) 2012 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* A. Hebert

+*

+*Parameters: input

+* NENTRY  number of data structures transfered to this module.

+* HENTRY  name of the data structures.

+* IENTRY  data structure type where:

+*         IENTRY=1 for LCM memory object;

+*         IENTRY=2 for XSM file;

+*         IENTRY=3 for sequential binary file;

+*         IENTRY=4 for sequential ASCII file.

+* JENTRY  access permission for the data structure where:

+*         JENTRY=0 for a data structure in creation mode;

+*         JENTRY=1 for a data structure in modifications mode;

+*         JENTRY=2 for a data structure in read-only mode.

+* KENTRY  data structure pointer.

+*

+*Comments:

+* None

+*-----------------------------------------------------------------------

+*

+      USE GANLIB

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      INTEGER NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)

+      CHARACTER HENTRY(NENTRY)*12

+      TYPE(C_PTR) KENTRY(NENTRY)

+*----

+*  LOCAL VARIABLES

+*----

+      PARAMETER(NSTATE=40)

+      CHARACTER HSIGN*12,TEXT12*12

+      DOUBLE PRECISION DFLOTT

+      INTEGER ISTATE(NSTATE)

+      DOUBLE PRECISION OPTPRR(NSTATE)

+      TYPE(C_PTR) IPOPT,IPNEW,IPOLD,JPNEW,JPOLD,KPNEW,KPOLD,LPNEW,MPNEW

+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IJJ,NJJ

+      REAL, ALLOCATABLE, DIMENSION(:) :: GAR,PER

+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: VARV,WEI

+*----

+*  PARAMETER VALIDATION

+*----

+      IF(NENTRY.NE.3)CALL XABORT('DLEAK: THREE PARAMETERS EXPECTED.')

+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2))CALL XABORT('@DLEAK'

+     1 //': LCM OBJECT EXPECTED AT LHS.')

+      IF(JENTRY(1).EQ.0)THEN

+        HSIGN='L_MACROLIB'

+        CALL LCMPTC(KENTRY(1),'SIGNATURE',12,HSIGN)

+      ELSE

+        CALL XABORT('DLEAK: EMPTY DELTA MACROLIB EXPECTED AT LHS.')

+      ENDIF

+      IPNEW=KENTRY(1)

+      IF((IENTRY(2).NE.1).AND.(IENTRY(2).NE.2))CALL XABORT('DLEAK: LC'

+     1 //'M OBJECT EXPECTED AT LHS.')

+      IF(JENTRY(2).EQ.0)THEN

+        HSIGN='L_OPTIMIZE'

+        CALL LCMPTC(KENTRY(2),'SIGNATURE',12,HSIGN)

+      ELSE

+        CALL XABORT('DLEAK: EMPTY OPTIMIZE OBJECT EXPECTED AT LHS.')

+      ENDIF

+      IPOPT=KENTRY(2)

+      IF((IENTRY(3).NE.1).AND.(IENTRY(3).NE.2))CALL XABORT('DLEAK: LC'

+     1 //'M OBJECT EXPECTED AT RHS.')

+      IF(JENTRY(3).NE.2)CALL XABORT('DLEAK: MACROLIB IN READ-ONLY MOD'

+     1 //'E EXPECTED AT RHS.')

+      CALL LCMGTC(KENTRY(3),'SIGNATURE',12,HSIGN)

+      IF(HSIGN.NE.'L_MACROLIB')THEN

+        CALL XABORT('DLEAK: SIGNATURE OF '//HENTRY(3)//' IS '//HSIGN//

+     1  '. L_MACROLIB EXPECTED.')

+      ENDIF

+      IPOLD=KENTRY(3)

+      CALL LCMGET(IPOLD,'STATE-VECTOR',ISTATE)

+      NGRP=ISTATE(1)

+      NMIX=ISTATE(2)

+      ILEAK=ISTATE(9)

+*----

+*  READ THE INPUT DATA

+*----

+      IMPX=1

+      ITYPE=0

+      IDELTA=0

+      NGR1=1

+      NGR2=NGRP

+      IBM1=1

+      IBM2=NMIX

+   20 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)

+      IF(INDIC.EQ.10) GO TO 30

+      IF(INDIC.NE.3) CALL XABORT('DLEAK: CHARACTER DATA EXPECTED(1).')

+      IF(TEXT12.EQ.'EDIT') THEN

+*       READ THE PRINT INDEX.

+        CALL REDGET(INDIC,IMPX,FLOTT,TEXT12,DFLOTT)

+        IF(INDIC.NE.1) CALL XABORT('DLEAK: INTEGER DATA EXPECTED(1).')

+      ELSE IF(TEXT12.EQ.'TYPE') THEN

+*       READ THE TYPE OF LEAKAGE.

+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)

+        IF(INDIC.NE.3) CALL XABORT('DLEAK: CHARACTER DATA EXPECTED(2).')

+        IF(TEXT12.EQ.'DIFF') THEN

+          ITYPE=1

+        ELSE IF(TEXT12.EQ.'NTOT1') THEN

+          ITYPE=2

+        ELSE

+          CALL XABORT('DLEAK: INVALID TYPE OF CROSS SECTION.')

+        ENDIF

+      ELSE IF(TEXT12.EQ.'DELTA') THEN

+*       READ THE TYPE OF DELTA.

+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)

+        IF(INDIC.NE.3) CALL XABORT('DLEAK: CHARACTER DATA EXPECTED(3).')

+        IF(TEXT12.EQ.'VALUE') THEN

+          IDELTA=1

+        ELSE IF(TEXT12.EQ.'FACTOR') THEN

+          IDELTA=2

+        ELSE

+          CALL XABORT('DLEAK: INVALID DELTA TYPE.')

+        ENDIF

+      ELSE IF(TEXT12.EQ.'MIXMIN') THEN

+*       READ THE MINIMUM MIXTURE INDEX.

+        CALL REDGET(INDIC,IBM1,FLOTT,TEXT12,DFLOTT)

+        IF(INDIC.NE.1) CALL XABORT('DLEAK: INTEGER DATA EXPECTED(2).')

+        IF((IBM1.LE.0).OR.(IBM1.GT.NMIX)) CALL XABORT('DLEAK: INVALID '

+     1  //'VALUE OF MIXMIN.')

+      ELSE IF(TEXT12.EQ.'MIXMAX') THEN

+*       READ THE MAXIMUM MIXTURE INDEX.

+        CALL REDGET(INDIC,IBM2,FLOTT,TEXT12,DFLOTT)

+        IF(INDIC.NE.1) CALL XABORT('DLEAK: INTEGER DATA EXPECTED(3).')

+        IF((IBM2.LT.IBM1).OR.(IBM2.GT.NMIX)) CALL XABORT('DLEAK: INVAL'

+     1  //'ID VALUE OF MIXMAX.')

+      ELSE IF(TEXT12.EQ.'GRPMIN') THEN

+*       READ THE MINIMUM GROUP INDEX.

+        CALL REDGET(INDIC,NGR1,FLOTT,TEXT12,DFLOTT)

+        IF(INDIC.NE.1) CALL XABORT('DLEAK: INTEGER DATA EXPECTED(4).')

+        IF((NGR1.LE.0).OR.(NGR1.GT.NGRP)) CALL XABORT('DLEAK: INVALID '

+     1  //'VALUE OF GRPMIN.')

+      ELSE IF(TEXT12.EQ.'GRPMAX') THEN

+*       READ THE MAXIMUM GROUP INDEX.

+        CALL REDGET(INDIC,NGR2,FLOTT,TEXT12,DFLOTT)

+        IF(INDIC.NE.1) CALL XABORT('DLEAK: INTEGER DATA EXPECTED(5).')

+        IF((NGR2.LT.NGR1).OR.(NGR2.GT.NGRP)) CALL XABORT('DLEAK: INVAL'

+     1  //'ID VALUE OF GRPMAX.')

+      ELSE IF(TEXT12.EQ.';') THEN

+        GO TO 30

+      ELSE

+        CALL XABORT('DLEAK: '//TEXT12//' IS AN INVALID KEYWORD.')

+      ENDIF

+      GO TO 20

+   30 IF(ITYPE.EQ.0) CALL XABORT('DLEAK: LEAKAGE TYPE NOT SET.')

+      IF(IDELTA.EQ.0) CALL XABORT('DLEAK: DELTA TYPE NOT SET.')

+      IF(IBM2.LT.IBM1) CALL XABORT('DLEAK: INVALID MIXTURE INDICES.')

+      IF(NGR2.LT.NGR1) CALL XABORT('DLEAK: INVALID GROUP INDICES.')

+      IF((ITYPE.EQ.1).AND.(ILEAK.EQ.0)) CALL XABORT('DLEAK: NO LEAKAGE'

+     1 //' ON INPUT MACROLIB.')

+      NPERT=(IBM2-IBM1+1)*(NGR2-NGR1+1)

+      IF(IMPX.GT.0) WRITE(6,'(/36H DLEAK: NUMBER OF CROSS-SECTION PERT,

+     1 10HURBATIONS=,I5)') NPERT

+*----

+*  SET THE PERTURBED MACROLIB

+*----

+      ALLOCATE(VARV(NPERT),WEI(NPERT))

+      JPNEW=LCMLID(IPNEW,'STEP',NPERT)

+      JPOLD=LCMGID(IPOLD,'GROUP')

+      IPERT=0

+      ALLOCATE(IJJ(NMIX),NJJ(NMIX),GAR(NMIX),PER(NMIX))

+      DO 52 IGRP=NGR1,NGR2

+      DO 51 IBMP=IBM1,IBM2

+      IPERT=IPERT+1

+      KPNEW=LCMDIL(JPNEW,IPERT)

+      LPNEW=LCMLID(KPNEW,'GROUP',NGRP)

+      DO 50 IGR=1,NGRP

+      MPNEW=LCMDIL(LPNEW,IGR)

+      KPOLD=LCMGIL(JPOLD,IGR)

+      GAR(:NMIX)=0.0

+      NJJ(:NMIX)=1

+      DO 40 IMIX=1,NMIX

+      IJJ(IMIX)=IGR

+   40 CONTINUE

+      CALL LCMPUT(MPNEW,'NTOT0',NMIX,2,GAR)

+      CALL LCMPUT(MPNEW,'SIGS00',NMIX,2,GAR)

+      CALL LCMPUT(MPNEW,'SIGW00',NMIX,2,GAR)

+      CALL LCMPUT(MPNEW,'SCAT00',NMIX,2,GAR)

+      CALL LCMPUT(MPNEW,'NJJS00',NMIX,1,NJJ)

+      CALL LCMPUT(MPNEW,'IJJS00',NMIX,1,IJJ)

+      CALL LCMPUT(MPNEW,'IPOS00',NMIX,1,NJJ)

+      PER(:NMIX)=0.0

+      IF((IDELTA.EQ.1).AND.(ITYPE.EQ.1).AND.(ILEAK.EQ.1)) THEN

+         IF(IGR.EQ.IGRP) PER(IBMP)=1.0

+         CALL LCMPUT(MPNEW,'DIFF',NMIX,2,PER)

+         CALL LCMGET(KPOLD,'DIFF',GAR)

+         IF(IGR.EQ.IGRP) VARV(IPERT)=GAR(IBMP)

+      ELSE IF((IDELTA.EQ.1).AND.(ITYPE.EQ.1).AND.(ILEAK.EQ.2)) THEN

+         IF(IGR.EQ.IGRP) PER(IBMP)=1.0

+         CALL LCMPUT(MPNEW,'DIFFX',NMIX,2,PER)

+         CALL LCMPUT(MPNEW,'DIFFY',NMIX,2,PER)

+         CALL LCMPUT(MPNEW,'DIFFZ',NMIX,2,PER)

+         CALL LCMGET(KPOLD,'DIFFX',GAR)

+         IF(IGR.EQ.IGRP) VARV(IPERT)=GAR(IBMP)

+      ELSE IF((IDELTA.EQ.1).AND.(ITYPE.EQ.2)) THEN

+         IF(IGR.EQ.IGRP) PER(IBMP)=1.0

+         CALL LCMPUT(MPNEW,'NTOT1',NMIX,2,PER)

+         CALL LCMLEN(KPOLD,'NTOT1',ILONG,ITYLCM)

+         IF(ILONG.NE.0) THEN

+           CALL LCMGET(KPOLD,'NTOT1',GAR)

+         ELSE

+           CALL LCMGET(KPOLD,'NTOT0',GAR)

+         ENDIF

+         IF(IGR.EQ.IGRP) VARV(IPERT)=GAR(IBMP)

+      ELSE IF((IDELTA.EQ.2).AND.(ITYPE.EQ.1).AND.(ILEAK.EQ.1)) THEN

+         CALL LCMGET(KPOLD,'DIFF',GAR)

+         IF(IGR.EQ.IGRP) PER(IBMP)=GAR(IBMP)

+         CALL LCMPUT(MPNEW,'DIFF',NMIX,2,PER)

+         IF(IGR.EQ.IGRP) VARV(IPERT)=1.0D0

+         IF(IGR.EQ.IGRP) WEI(IPERT)=GAR(IBMP)**2

+      ELSE IF((IDELTA.EQ.2).AND.(ITYPE.EQ.1).AND.(ILEAK.EQ.2)) THEN

+         CALL LCMGET(KPOLD,'DIFFX',GAR)

+         IF(IGR.EQ.IGRP) PER(IBMP)=GAR(IBMP)

+         CALL LCMPUT(MPNEW,'DIFFX',NMIX,2,PER)

+         CALL LCMPUT(MPNEW,'DIFFY',NMIX,2,PER)

+         CALL LCMPUT(MPNEW,'DIFFZ',NMIX,2,PER)

+         IF(IGR.EQ.IGRP) VARV(IPERT)=1.0D0

+         IF(IGR.EQ.IGRP) WEI(IPERT)=GAR(IBMP)**2

+      ELSE IF((IDELTA.EQ.2).AND.(ITYPE.EQ.2)) THEN

+         CALL LCMLEN(KPOLD,'NTOT1',ILONG,ITYLCM)

+         IF(ILONG.NE.0) THEN

+           CALL LCMGET(KPOLD,'NTOT1',GAR)

+         ELSE

+           CALL LCMGET(KPOLD,'NTOT0',GAR)

+         ENDIF

+         IF(IGR.EQ.IGRP) PER(IBMP)=GAR(IBMP)

+         CALL LCMPUT(MPNEW,'NTOT1',NMIX,2,PER)

+         IF(IGR.EQ.IGRP) VARV(IPERT)=1.0D0

+         IF(IGR.EQ.IGRP) WEI(IPERT)=GAR(IBMP)**2

+      ENDIF

+   50 CONTINUE

+   51 CONTINUE

+   52 CONTINUE

+      DEALLOCATE(PER,GAR,NJJ,IJJ)

+*----

+*  SET THE PERTURBED MACROLIB STATE-VECTOR

+*----

+      ISTATE(:NSTATE)=0

+      ISTATE(1)=NGRP

+      ISTATE(2)=NMIX

+      ISTATE(3)=1

+      ISTATE(9)=ILEAK

+      ISTATE(11)=NPERT

+      CALL LCMPUT(IPNEW,'STATE-VECTOR',NSTATE,1,ISTATE)

+      IF(IMPX.GT.1) CALL LCMLIB(IPNEW)

+*----

+*  PUT OPTIMIZE OBJECT INFORMATION

+*----

+      CALL LCMPUT(IPOPT,'VAR-VALUE',NPERT,4,VARV)

+      IF(IDELTA.EQ.2) CALL LCMPUT(IPOPT,'VAR-WEIGHT',NPERT,4,WEI)

+      DEALLOCATE(WEI,VARV)

+      ISTATE(:NSTATE)=0

+      ISTATE(1)=NGRP

+      ISTATE(2)=NMIX

+      ISTATE(3)=ITYPE

+      ISTATE(4)=IDELTA

+      ISTATE(5)=NGR1

+      ISTATE(6)=NGR2

+      ISTATE(7)=IBM1

+      ISTATE(8)=IBM2

+      IF(IMPX.GT.0) WRITE(6,100) (ISTATE(I),I=1,8)

+      CALL LCMPUT(IPOPT,'DEL-STATE',NSTATE,1,ISTATE)

+      ISTATE(:NSTATE)=0

+      ISTATE(1)=NPERT

+      ISTATE(2)=0

+      ISTATE(3)=1

+      ISTATE(4)=0

+      ISTATE(5)=0

+      ISTATE(6)=2

+      ISTATE(9)=2

+      ISTATE(10)=0

+      CALL LCMPUT(IPOPT,'STATE-VECTOR',NSTATE,1,ISTATE)

+      OPTPRR(:NSTATE)=0.0D0

+      OPTPRR(1)=1.0

+      OPTPRR(2)=0.1

+      OPTPRR(3)=1.0E-4

+      OPTPRR(4)=1.0E-4

+      OPTPRR(5)=1.0E-4

+      CALL LCMPUT(IPOPT,'OPT-PARAM-R',NSTATE,4,OPTPRR)

+      RETURN

+*

+  100 FORMAT(/18H DEL-STATE OPTIONS/18H -----------------/

+     1 7H NGRP  ,I8,28H   (NUMBER OF ENERGY GROUPS)/

+     2 7H NMIX  ,I8,32H   (NUMBER OF MATERIAL MIXTURES)/

+     3 7H ITYPE ,I8,29H   (=1/2: USE DIFF/USE NTOT1)/

+     4 7H IDELTA,I8,31H   (=1/2: USE VALUE/USE FACTOR)/

+     5 7H NGR1  ,I8,24H   (MINIMUM GROUP INDEX)/

+     6 7H NGR2  ,I8,24H   (MAXIMUM GROUP INDEX)/

+     7 7H IBM1  ,I8,26H   (MINIMUM MIXTURE INDEX)/

+     8 7H IBM2  ,I8,26H   (MAXIMUM MIXTURE INDEX))

+      END

diff --git a/Donjon/src/DONDRV.F b/Donjon/src/DONDRV.F
new file mode 100644
index 0000000..ee42c61
--- /dev/null
+++ b/Donjon/src/DONDRV.F
@@ -0,0 +1,329 @@
+*DECK DONDRV
+      INTEGER FUNCTION DONDRV(HMODUL,NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Module-dependent driver for DONJON.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* D. Sekki
+*
+*Parameters: input/output
+* HMODUL  name of module to process.
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file;
+*         IENTRY=6 for HDF5 file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Parameters: output
+* DONDRV  completion flag: =0 module exists; =1 does not exists.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      CHARACTER HMODUL*(*),HENTRY(NENTRY)*12
+      INTEGER IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR) KENTRY(NENTRY)
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(IOUT=6)
+      REAL TBEG,TEND
+      DOUBLE PRECISION DMEMB,DMEMD
+      CHARACTER DSR*72,NAM*72,COD*12
+      LOGICAL :: DONMOD
+*
+      DONDRV=0
+      DONMOD=.TRUE.
+      CALL KDRCPU(TBEG)
+      CALL KDRMEM(DMEMB)
+*----
+*  CALL MODULE AND PRINT CREDITS
+*----
+      IF(HMODUL.EQ.'NCR:')THEN
+        COD='DRAGON'
+        DSR='ACCESS MULTI-PARAMETER REACTOR COMPOSITION DATABASE'
+        NAM='A. HEBERT'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL NCR(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSEIF(HMODUL.EQ.'CRE:')THEN
+        COD='DONJON'
+        DSR='ACCESS MONO-PARAMETER REACTOR COMPOSITION DATABASE'
+        NAM='A. HEBERT, D. SEKKI'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL CRE(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSEIF(HMODUL.EQ.'USPLIT:')THEN
+        COD='DONJON'
+        DSR='LINK MATERIAL INDEX AND REACTOR GEOMETRY'
+        NAM='J. KOCLAS, D. SEKKI'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL USPLIT(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSEIF(HMODUL.EQ.'MACINI:')THEN
+        COD='DONJON'
+        DSR='EXPAND MACROLIB OVER THE REACTOR GEOMETRY'
+        NAM='J. KOCLAS, E. VARIN, D. SEKKI'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL MACINI(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSEIF(HMODUL.EQ.'RESINI:')THEN
+        COD='DONJON'
+        DSR='FUEL LATTICE GEOMETRY AND PROPERTIES'
+        NAM='E. VARIN, D. SEKKI, R. CHAMBON'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL RESINI(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSEIF(HMODUL.EQ.'FLPOW:')THEN
+        COD='DONJON'
+        DSR='COMPUTE FLUXES AND POWERS'
+        NAM='D. SEKKI'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL FLPOW(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSEIF(HMODUL.EQ.'DEVINI:')THEN
+        COD='DONJON'
+        DSR='MODELING OF ROD-DEVICES IN THE REACTOR CORE'
+        NAM='D. SEKKI '
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL DEVINI(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSEIF(HMODUL.EQ.'DSET:')THEN
+        COD='DONJON'
+        DSR='UPDATE DEVICES PARAMETERS'
+        NAM='D. SEKKI'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL DSET(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSEIF(HMODUL.EQ.'MOVDEV:')THEN
+        COD='DONJON'
+        DSR='MOVE DEVICES IN THE REACTOR CORE'
+        NAM='D. SEKKI'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL MOVDEV(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSEIF(HMODUL.EQ.'NEWMAC:')THEN
+        COD='DONJON'
+        DSR='UPDATE MACROLIB FOR DEVICES PROPERTIES'
+        NAM='J. KOCLAS, D. SEKKI'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL NEWMAC(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSEIF(HMODUL.EQ.'DETINI:')THEN
+        COD='DONJON'
+        DSR='CONSTRUCT 2D AND 3D DETECTORS IN THE CORE'
+        NAM='J. KOCLAS, E. VARIN, M. GUYOT'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL DETINI(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSEIF(HMODUL.EQ.'DETECT:')THEN
+        COD='DONJON'
+        DSR='COMPUTE DETECTORS READING'
+        NAM='J. KOCLAS, M. GUYOT'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL DETECT(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSEIF(HMODUL.EQ.'TAVG:')THEN
+        COD='DONJON'
+        DSR='TIME-AVERAGE CALCULATION'
+        NAM='D. SEKKI'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL TAVG(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSEIF(HMODUL.EQ.'TINST:')THEN
+        COD='DONJON'
+        DSR='INSTANTANEOUS CALCULATION'
+        NAM='B. TOUEG'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL TINST(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSEIF(HMODUL.EQ.'CVR:')THEN
+        COD='DONJON'
+        DSR='UPDATE DATA FOR VOIDING SIMULATION'
+        NAM='D. SEKKI'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL CVR(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSEIF(HMODUL.EQ.'LZC:')THEN
+        COD='DONJON'
+        DSR='MODELING OF LIQUID ZONE CONTROLLERS'
+        NAM='D. SEKKI'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL LZC(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSEIF(HMODUL.EQ.'HST:')THEN
+        COD='DONJON'
+        DSR='HISTORY BASED CALCULATION SUPPORT'
+        NAM='G. MARLEAU AND E. VARIN'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL HST(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSEIF(HMODUL.EQ.'XENON:')THEN
+        COD='DONJON'
+        DSR='COMPUTE THE XENON DISTRIBUTION'
+        NAM='M. GUYOT'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL XENON(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSEIF(HMODUL.EQ.'AFM:')THEN
+        COD='DONJON'
+        DSR='MULTI-PARAMETER FEEDBACK MODEL'
+        NAM='T. SISSAOUI'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL AFM(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSE IF(HMODUL.EQ.'NCR:') THEN
+        COD='DONJON'
+        DSR='ACCESS MULTI-PARAMETER REACTOR COMPOSITION DATABASE'
+        NAM='A. HEBERT'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL NCR(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSE IF(HMODUL.EQ.'SCR:') THEN
+        COD='DONJON'
+        DSR='ACCESS MULTI-PARAMETER REACTOR SAPHYB DATABASE'
+        NAM='A. HEBERT'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL SCR(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+#if defined(HDF5_LIB)
+      ELSE IF(HMODUL.EQ.'ACR:') THEN
+        COD='DONJON'
+        DSR='ACCESS MULTI-PARAMETER REACTOR APEX DATABASE'
+        NAM='A. HEBERT'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL ACR(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSE IF(HMODUL.EQ.'MCR:') THEN
+        COD='DONJON'
+        DSR='ACCESS MULTI-PARAMETER REACTOR MPO DATABASE'
+        NAM='A. HEBERT'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL MCR(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+#endif /* defined(HDF5_LIB) */
+      ELSE IF(HMODUL.EQ.'PCR:') THEN
+        COD='DONJON'
+        DSR='ACCESS MULTI-PARAMETER REACTOR PMAXS DATABASE'
+        NAM='A. HEBERT'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL PCR(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSE IF(HMODUL.EQ.'T16CPO:') THEN
+        COD='DONJON'
+        DSR='INTERFACE FOR WIMS-AECL'
+        NAM='G. MARLEAU'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL T16CPO(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSE IF(HMODUL.EQ.'THM:') THEN
+        COD='DONJON'
+        DSR='SIMPLIFIED THERMAL-HYDRAULICS CALCULATION'
+        NAM='A. HEBERT'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL THM(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSE IF(HMODUL.EQ.'DLEAK:') THEN
+        COD='DONJON'
+        DSR='COMPUTE A DELTA MACROLIB RELATIVE TO LEAKAGE INFORMATION'
+        NAM='A. HEBERT'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL DLEAK(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSE IF(HMODUL.EQ.'DSPH:') THEN
+        COD='DONJON'
+        DSR='COMPUTE A DELTA MACROLIB RELATIVE TO SPH FACTORS'
+        NAM='A. HEBERT'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL DSPH(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSE IF(HMODUL.EQ.'DREF:') THEN
+        COD='DONJON'
+        DSR='SET THE GPT ADJOINT SOURCES FOR RMS REACTION RATE ERRORS'
+        NAM='A. HEBERT'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL DREF(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSE IF(HMODUL.EQ.'GRAD:') THEN
+        COD='DONJON'
+        DSR='COMPUTE GRADIENTS OF SYSTEM CHARACTERISTICS'
+        NAM='A. HEBERT'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL GRAD(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSE IF(HMODUL.EQ.'PLQ:') THEN
+        COD='DONJON'
+        DSR='LINEAR OPTIMIZATION PROBLEM WITH A QUADRATIC CONSTRAINT'
+        NAM='A. HEBERT AND R. CHAMBON'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL PLQ(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSE IF(HMODUL.EQ.'LNSR:') THEN
+        COD='DONJON'
+        DSR='LINE OPTIMIZATION OF THE OBJECTIVE FUNCTION'
+        NAM='A. HEBERT'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL LNSR(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSE IF(HMODUL.EQ.'SIM:') THEN
+        COD='DONJON'
+        DSR='PWR FUELLING SIMULATOR'
+        NAM='A. HEBERT AND V. SALINO'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL SIM(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSE IF(HMODUL.EQ.'MCC:') THEN
+        COD='DONJON'
+        DSR='FUEL MAP MODIFICATION'
+        NAM='M. CORDIEZ'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL MCC(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSE IF(HMODUL.EQ.'NAP:') THEN
+        COD='DONJON'
+        DSR='PIN POWER RECONSTRUCTION AND ENRICHED L_COMPO CONSTRUCTION'
+        NAM='R. CHAMBON'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL NAP(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSE IF(HMODUL.EQ.'D2P:') THEN
+        COD='DONJON'
+        DSR='PMAXS INTERFACE FILE GENERATION'
+        NAM='J. TAFOREAU'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL D2P(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSE IF(HMODUL.EQ.'ROD:') THEN
+        COD='DONJON'
+        DSR='CONTROL ROD INSERTION MANAGEMENT FOR PWR'
+        NAM='G. TIXIER'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL ROD(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSE IF(HMODUL.EQ.'PKINI:') THEN
+        COD='DONJON'
+        DSR='POINT KINETIC INITIALIZATION MODULE'
+        NAM='A. HEBERT'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL PKINI(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSE IF(HMODUL.EQ.'PKINS:') THEN
+        COD='DONJON'
+        DSR='POINT KINETIC SOLUTION AND GLOBAL FEEDBACK'
+        NAM='A. HEBERT'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL PKINS(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSE IF(HMODUL.EQ.'IDET:') THEN
+        COD='DONJON'
+        DSR='DETECTOR INTEGRATED RESPONSE EVALUATION'
+        NAM='A. HEBERT'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL IDET(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSE IF(HMODUL.EQ.'FPSPH:') THEN
+        COD='DONJON'
+        DSR='SINGLE SPH FACTOR FIXED POINT ITERATION'
+        NAM='A. HEBERT'
+        WRITE(IOUT,1000)HMODUL,COD,DSR,NAM
+        CALL FPSPH(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ELSE
+        DONMOD=.FALSE.
+        DONDRV=KDRDRV(HMODUL,NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+      ENDIF
+      IF(DONMOD)THEN
+        WRITE(IOUT,1001)HMODUL
+        CALL KDRCPU(TEND)
+        CALL KDRMEM(DMEMD)
+        WRITE(IOUT,1002) HMODUL,(TEND-TBEG),REAL(DMEMD-DMEMB)
+      ENDIF
+      RETURN
+*
+ 1000 FORMAT(/1X,15('~')/
+     1 1X,'@BEGIN MODULE -> ',A12/
+     2 1X,'@FROM CODE    -> ',A12/
+     3 1X,'@DESCRIPTION  -> ',A72/
+     4 1X,'@CREDITS      -> ',A72/
+     5 1X,'@COPYRIGHTS   -> ECOLE POLYTECHNIQUE DE MONTREAL'/
+     6 18X,'GNU LESSER GENERAL PUBLIC LICENSE'/1X,15('~')/)
+ 1001 FORMAT(1X,'@END MODULE -> ',A12)
+ 1002 FORMAT('-->>MODULE ',A12,': TIME SPENT=',F13.3,' MEMORY USAGE=',
+     1 1P,E10.3)
+      END
diff --git a/Donjon/src/DONJON.f90 b/Donjon/src/DONJON.f90
new file mode 100644
index 0000000..c338298
--- /dev/null
+++ b/Donjon/src/DONJON.f90
@@ -0,0 +1,81 @@
+program DONJON
+   use GANLIB
+   implicit none
+   integer, parameter :: iout=6
+   character(len=131) :: hsmg
+!----
+! local storage
+!----
+   integer       :: iprint,ier
+!----
+! gan-2000 external functions
+!----
+   integer, external :: KERNEL
+   interface
+      integer(c_int) function donmod(cmodul, nentry, hentry, ientry, jentry, &
+                     kentry, hparam_c) bind(c)
+         use, intrinsic :: iso_c_binding
+         character(kind=c_char), dimension(*) :: cmodul
+         integer(c_int), value :: nentry 
+         character(kind=c_char), dimension(13,*) :: hentry
+         integer(c_int), dimension(nentry) :: ientry, jentry
+         type(c_ptr), dimension(nentry) :: kentry
+         character(kind=c_char), dimension(73,*) :: hparam_c
+       end function donmod
+    end interface
+!----
+!  variables for DONJON version
+!----
+      integer           :: imvers
+      character(len=64) :: date
+      character(len=48) :: rev
+      character(len=6), parameter :: namsbr='donjon'
+!----
+!  version information recovered from cvs
+!----
+   imvers=5
+   call KDRVER(rev,date)
+   write(iout,6000) namsbr,imvers,rev,date
+   write(iout,6010) namsbr
+!----
+!  execute the cle-2000 driver
+!----
+   iprint=0
+   ier=KERNEL(donmod,iprint)
+   if( ier /= 0 )then
+      write(hsmg,'(27hDONJON: kernel error (code=,I5,2h).)') ier
+      call XABORT(hsmg)
+   endif
+!----
+!  all modules processed
+!----
+   write(iout,6030) namsbr,imvers,rev
+   stop
+!----
+!  formats
+!----
+ 6000 FORMAT( &
+       ' @@@@@@@     @@@@@   @@     @@   @@@@@@   @@@@@   @@     @@'/ &
+       ' @@@@@@@@   @@@@@@@  @@@    @@       @@  @@@@@@@  @@@    @@'/ &
+       ' @@     @@ @@     @@ @@@@   @@       @@ @@     @@ @@@@   @@'/ &
+       ' @@     @@ @@     @@ @@ @@  @@       @@ @@     @@ @@ @@  @@'/ &
+       ' @@     @@ @@     @@ @@  @@ @@       @@ @@     @@ @@  @@ @@'/ &
+       ' @@     @@ @@     @@ @@   @@@@       @@ @@     @@ @@   @@@@'/ &
+       ' @@@@@@@@   @@@@@@@  @@    @@@ @@    @@  @@@@@@@  @@    @@@'/ &
+       ' @@@@@@@     @@@@@   @@     @@  @@@@@@    @@@@@   @@     @@'// &
+       '           VERSION ',A6,I2,2X,A,4X,A/ &
+       '           GROUPE D''ANALYSE NUCLEAIRE'/ &
+       '           ECOLE POLYTECHNIQUE DE MONTREAL'//)
+ 6010 FORMAT( &
+       ' COPYRIGHT NOTICE FOR THIS VERSION OF ',A6,':'/ &
+       ' --------------------------------------------'/ &
+       ' Copyright (C) 2007 Ecole Polytechnique de Montreal '/ &
+       ' This library is free software; you can redistribute it' / &
+       ' and/or modify it under the terms of the GNU Lesser General' / &
+       ' Public License as published by the Free Software Foundation;' / &
+       ' either version 2.1 of the License, or (at your option) any' / &
+       ' later version '///)
+ 6030 FORMAT(/1x,'normal end of execution for ',a6,i2,2x,a/ &
+              1x,'check for warning in listing'/ &
+              1x,'before assuming your run was successful')
+end program DONJON
diff --git a/Donjon/src/DREF.f b/Donjon/src/DREF.f
new file mode 100644
index 0000000..56a4a90
--- /dev/null
+++ b/Donjon/src/DREF.f
@@ -0,0 +1,245 @@
+*DECK DREF
+      SUBROUTINE DREF(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Set the source of an adjoint fixed source eigenvalue problem. The
+* source is the gradient of the RMS power or absorption distribution.
+*
+*Copyright:
+* Copyright (C) 2012 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER (NSTATE=40)
+      TYPE(C_PTR) IPGRAD,IPDREF,IPMAC1,IPMAC2,IPFLX,IPTRK
+      CHARACTER HSIGN*12,TEXT12*12,CMODUL*12
+      INTEGER ISTATE(NSTATE)
+      DOUBLE PRECISION DFLOTT,RMSD
+      LOGICAL LNO,LRMS,LNEWT
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: MAT,KEY
+      REAL, ALLOCATABLE, DIMENSION(:) :: VOL
+*----
+*  PARAMETER VALIDATION.
+*----
+      IF(NENTRY.NE.6) CALL XABORT('DREF: SIX PARAMETERS EXPECTED.')
+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('DREF: LCM'
+     1 //' OBJECT EXPECTED AT LHS.')
+      IF(JENTRY(1).NE.0) CALL XABORT('DREF: FIRST ENTRY IN CREATE MODE'
+     1 //' EXPECTED.')
+      IPDREF=KENTRY(1)
+      IF((IENTRY(2).NE.1).AND.(IENTRY(2).NE.2)) CALL XABORT('DREF: LCM'
+     1  //' OBJECT EXPECTED AT LHS.')
+      IF(JENTRY(2).NE.1) CALL XABORT('DREF: SECOND ENTRY IN MODIFICATI'
+     1  //'ON MODE EXPECTED.')
+      IPGRAD=KENTRY(2)
+      CALL LCMGTC(IPGRAD,'SIGNATURE',12,HSIGN)
+      IF(HSIGN.NE.'L_OPTIMIZE') THEN
+         TEXT12=HENTRY(2)
+         CALL XABORT('DREF: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     1   '. L_OPTIMIZE EXPECTED.')
+      ENDIF
+      CALL LCMGET(IPGRAD,'STATE-VECTOR',ISTATE)
+      LNEWT=ISTATE(8).EQ.4
+      CALL LCMGET(IPGRAD,'DEL-STATE',ISTATE)
+      ICONT=ISTATE(4)
+      DO I=3,6
+         IF((JENTRY(I).NE.2).OR.((IENTRY(I).NE.1).AND.(IENTRY(I).NE.2)))
+     1   CALL XABORT('DREF: LCM OBJECT IN READ-ONLY MODE EXPECTED AT R'
+     2   //'HS.')
+      ENDDO
+*----
+*  RECOVER THE ACTUAL FLUX SOLUTION AND CORRESPONDING TRACKING.
+*----
+      CALL LCMGTC(KENTRY(3),'SIGNATURE',12,HSIGN)
+      IF(HSIGN.NE.'L_FLUX') THEN
+         TEXT12=HENTRY(3)
+         CALL XABORT('DREF: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     1   '. L_FLUX EXPECTED.')
+      ENDIF
+      IPFLX=KENTRY(3)
+      CALL LCMGET(IPFLX,'STATE-VECTOR',ISTATE)
+      NG=ISTATE(1)
+      NUN=ISTATE(2)
+      CALL LCMGTC(KENTRY(3+1),'SIGNATURE',12,HSIGN)
+      IF(HSIGN.NE.'L_TRACK') THEN
+         TEXT12=HENTRY(4)
+         CALL XABORT('DREF: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     1   '. L_TRACK EXPECTED.')
+      ENDIF
+      IPTRK=KENTRY(4)
+      CALL LCMGET(IPTRK,'STATE-VECTOR',ISTATE)
+      NREG=ISTATE(1)
+      ITYPE=ISTATE(6)
+      IELEM=ISTATE(9)
+      ICHX=ISTATE(12)
+      IF(ISTATE(2).NE.NUN) CALL XABORT('DREF: INVALID NUN.')
+      CALL LCMGTC(IPTRK,'TRACK-TYPE',12,CMODUL)
+      IF((CMODUL.NE.'TRIVAC').AND.(CMODUL.NE.'SN')) THEN
+         CALL XABORT('DREF: TRIVAC OR SN EXPECTED.')
+       ENDIF
+      ALLOCATE(MAT(NREG),KEY(NREG),VOL(NREG))
+      CALL LCMGET(IPTRK,'MATCOD',MAT)
+      CALL LCMGET(IPTRK,'KEYFLX',KEY)
+      CALL LCMGET(IPTRK,'VOLUME',VOL)
+*----
+*  RECOVER THE ACTUAL MACROLIB.
+*----
+      CALL LCMGTC(KENTRY(5),'SIGNATURE',12,HSIGN)
+      IF(HSIGN.EQ.'L_MACROLIB') THEN
+         IPMAC1=KENTRY(5)
+      ELSE IF(HSIGN.EQ.'L_LIBRARY') THEN
+         IPMAC1=LCMGID(KENTRY(5),'MACROLIB')
+      ELSE
+         TEXT12=HENTRY(5)
+         CALL XABORT('DREF: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     1   '. ACTUAL L_MACROLIB OR L_LIBRARY EXPECTED.')
+      ENDIF
+      CALL LCMGET(IPMAC1,'STATE-VECTOR',ISTATE)
+      IF(ISTATE(1).NE.NG) CALL XABORT('DREF: INVALID NUMBER OF GROUPS.')
+      NMIL=ISTATE(2)
+      NFIS1=ISTATE(4)
+      ILEAK1=ISTATE(9)
+*----
+*  RECOVER THE REFERENCE MACROLIB.
+*----
+      CALL LCMGTC(KENTRY(6),'SIGNATURE',12,HSIGN)
+      IF(HSIGN.EQ.'L_MACROLIB') THEN
+         IPMAC2=KENTRY(6)
+      ELSE IF(HSIGN.EQ.'L_LIBRARY') THEN
+         IPMAC2=LCMGID(KENTRY(6),'MACROLIB')
+      ELSE
+         TEXT12=HENTRY(6)
+         CALL XABORT('DREF: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     1   '. REFERENCE L_MACROLIB OR L_LIBRARY EXPECTED.')
+      ENDIF
+      CALL LCMGET(IPMAC2,'STATE-VECTOR',ISTATE)
+      IF(ISTATE(1).NE.NG) THEN
+         CALL XABORT('DREF: INVALID NUMBER OF REFERENCE GROUPS.')
+      ELSE IF(ISTATE(2).NE.NMIL) THEN
+         CALL XABORT('DREF: INVALID NUMBER OF REFERENCE MIXTURES.')
+      ENDIF
+      NFIS2=ISTATE(4)
+      NALBP=ISTATE(8)
+      ILEAK2=ISTATE(9)
+      IDF=ISTATE(12)
+      IF((NALBP.GT.0).AND.(ICHX.NE.2)) CALL XABORT('DREF: RAVIART-THOM'
+     1 //'AS FINITE ELEMENTS EXPECTED.')
+*----
+*  READ INPUT PARAMETERS
+*----
+      IPRINT=1
+      LNO=.FALSE.
+      LRMS=.FALSE.
+   10 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+      IF(INDIC.EQ.10) GO TO 20
+      IF(INDIC.NE.3) CALL XABORT('DREF: CHARACTER DATA EXPECTED')
+      IF(TEXT12(1:4).EQ.'EDIT') THEN
+        CALL REDGET(INDIC,IPRINT,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1) CALL XABORT('DREF: INTEGER DATA EXPECTED FOR IP'
+     1  //'RINT')
+      ELSE IF(TEXT12.EQ.'NODERIV') THEN
+        LNO=.TRUE.
+        GO TO 10
+      ELSE IF(TEXT12.EQ.'NEWTON') THEN
+        LNEWT=.TRUE.
+        GO TO 10
+      ELSE IF(TEXT12(1:3).EQ.'RMS') THEN
+        LRMS=.TRUE.
+        GO TO 20
+      ELSE IF(TEXT12(1:1).EQ.';') THEN
+        IF(LRMS) RETURN
+        GO TO 20
+      ELSE 
+        CALL XABORT('DREF: '//TEXT12//' IS AN INVALID KEYWORD')
+      ENDIF
+      GO TO 10
+*----
+*  COMPUTE THE GPT SOURCE
+*----
+   20 IF((ICONT.EQ.1).OR.(ICONT.EQ.2)) THEN
+        CALL DRESOU(IPRINT,IPDREF,IPMAC1,IPMAC2,IPFLX,IPGRAD,NG,NREG,
+     1  NMIL,NUN,MAT,KEY,VOL,LNO,RMSD)
+        NFUNC=1
+      ELSE IF(((ICONT.EQ.3).OR.(ICONT.EQ.4)).AND.LNEWT) THEN
+*       NEWTONIAN SPH TECHNIQUE
+        CALL DRENOU(IPRINT,IPDREF,IPMAC1,IPMAC2,IPFLX,IPTRK,IPGRAD,NG,
+     1  NREG,ITYPE,IELEM,NMIL,NALBP,NUN,NFIS1,NFIS2,ILEAK1,ILEAK2,
+     2  IDF,MAT,KEY,VOL,LNO,NFUNC,RMSD)
+      ELSE IF((ICONT.EQ.3).OR.(ICONT.EQ.4).OR.(ICONT.EQ.5)) THEN
+*       QUASI-NEWTONIAN SPH TECHNIQUE
+        CALL DREKOU(IPRINT,IPDREF,IPMAC1,IPMAC2,IPFLX,IPTRK,IPGRAD,
+     1  NG,NREG,ITYPE,IELEM,NMIL,NALBP,NUN,NFIS1,NFIS2,ILEAK1,ILEAK2,
+     2  IDF,MAT,KEY,VOL,LNO,RMSD)
+        NFUNC=1
+      ENDIF
+*
+      DEALLOCATE(VOL,KEY,MAT)
+*----
+*  SAVE THE SIGNATURE AND STATE VECTOR
+*----
+      HSIGN='L_SOURCE'
+      CALL LCMPTC(IPDREF,'SIGNATURE',12,HSIGN)
+      CALL LCMPTC(IPDREF,'TRACK-TYPE',12,CMODUL)
+      ISTATE(:NSTATE)=0
+      ISTATE(1)=NG
+      ISTATE(2)=NUN
+      ISTATE(3)=0
+      ISTATE(4)=NFUNC
+      ISTATE(5)=NMIL
+      ISTATE(6)=NG
+      IF(IPRINT.GT.0) WRITE(6,100) (ISTATE(I),I=1,6)
+      CALL LCMPUT(IPDREF,'STATE-VECTOR',NSTATE,1,ISTATE)
+      IF(.NOT.LRMS) RETURN
+*----
+*  SEND BACK RMS ERROR TOWARDS CLE-2000
+*----
+      CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+      INDIC=-INDIC
+      IF(INDIC.EQ.2) THEN
+        CALL REDPUT(INDIC,NITMA,REAL(RMSD),TEXT12,DFLOTT)
+      ELSE IF(INDIC.EQ.4) THEN
+        CALL REDPUT(INDIC,NITMA,FLOTT,TEXT12,RMSD)
+      ENDIF
+      GO TO 10
+*
+  100 FORMAT(/8H OPTIONS/8H -------/
+     1 7H NG    ,I8,28H   (NUMBER OF ENERGY GROUPS)/
+     2 7H NUN   ,I8,40H   (NUMBER OF UNKNOWNS PER ENERGY GROUP)/
+     3 7H NDIR  ,I8,35H   (NUMBER OF DIRECT FIXED SOURCES)/
+     4 7H NCST  ,I8,36H   (NUMBER OF ADJOINT FIXED SOURCES)/
+     5 7H NMIL  ,I8,34H   (NUMBER OF HOMOGENIZED REGIONS)/
+     6 7H NG    ,I8,38H   (NUMBER OF CONDENSED ENERGY GROUPS))
+      END
diff --git a/Donjon/src/DREJ02.f b/Donjon/src/DREJ02.f
new file mode 100644
index 0000000..8ef8176
--- /dev/null
+++ b/Donjon/src/DREJ02.f
@@ -0,0 +1,171 @@
+*DECK DREJ02
+      SUBROUTINE DREJ02(ITYPE,IELEM,NREG,NUN,MAXKN,MAXQF,MAT,KN,QFR,
+     1 IQFR,VOL,FUNKNO,OUT,GAMMA)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* One-speed net surfacic current calculation in 3D mixed-dual finite
+* element approximation.
+*
+*Copyright:
+* Copyright (C) 2018 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* ITYPE   type of geometry: =5/7 (Cartesian); =8/9 (hexagonal).
+* IELEM   degree of the Lagrangian finite elements: =1 (linear);
+*          =2 (parabolic); =3 (cubic); =4 (quartic).
+* NREG    number of elements.
+* NUN     dimension of array FUNKNO.
+* MAXKN   dimension of array KN.
+* MAXQF   dimension of array QFR.
+* MAT     mixture index per region.
+* KN      element-ordered unknown list.
+* QFR     element-ordered surfaces.
+* IQFR    element-ordered physical albedo indices.
+* VOL     volume of regions.
+* FUNKNO  neutron fluxes.
+*
+*Parameters: output
+* OUT     net surfacic current.
+* GAMMA   gamma function.
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER ITYPE,IELEM,NREG,NUN,MAXKN,MAXQF,MAT(NREG),KN(MAXKN),
+     1 IQFR(MAXQF)
+      REAL QFR(MAXQF),VOL(NREG),FUNKNO(NUN),OUT,GAMMA(NUN)
+*
+      IF(IELEM.LT.0) CALL XABORT('DREJ02: TYPE OF DISCRETIZATION NOT I'
+     1 //'MPLEMENTED.')
+      GAMMA(:NUN)=0.0
+      OUT=0.0
+      NUM1=0
+      NUM2=0
+      IF((ITYPE.NE.5).OR.(ITYPE.NE.7)) THEN
+        DO 20 K=1,NREG
+        IF(MAT(K).EQ.0) GO TO 20
+        IF(VOL(K).EQ.0.0) GO TO 10
+        IF(NUM2+4.GT.MAXQF) call XABORT('overflow')
+        IALB=IQFR(NUM2+1)
+        IF((IALB.NE.0).AND.(QFR(NUM2+1).GT.0.0)) THEN
+          IND1=KN(NUM1+2)
+          IF(IND1.LE.0) CALL XABORT('DREJ02: bug1')
+          GAMMA(IND1)=-QFR(NUM2+1)
+          OUT=OUT-FUNKNO(IND1)*QFR(NUM2+1)
+        ENDIF
+        IALB=IQFR(NUM2+2)
+        IF((IALB.NE.0).AND.(QFR(NUM2+2).GT.0.0)) THEN
+          IND1=KN(NUM1+2+IELEM**2)
+          IF(IND1.LE.0) CALL XABORT('DREJ02: bug2')
+          GAMMA(IND1)=QFR(NUM2+2)
+          OUT=OUT+FUNKNO(IND1)*QFR(NUM2+2)
+        ENDIF
+        IALB=IQFR(NUM2+3)
+        IF((IALB.NE.0).AND.(QFR(NUM2+3).GT.0.0)) THEN
+          IND1=KN(NUM1+2+2*IELEM**2)
+          IF(IND1.LE.0) CALL XABORT('DREJ02: bug3')
+          GAMMA(IND1)=-QFR(NUM2+3)
+          OUT=OUT-FUNKNO(IND1)*QFR(NUM2+3)
+        ENDIF
+        IALB=IQFR(NUM2+4)
+        IF((IALB.NE.0).AND.(QFR(NUM2+4).GT.0.0)) THEN
+          IND1=KN(NUM1+2+3*IELEM**2)
+          IF(IND1.LE.0) CALL XABORT('DREJ02: bug4')
+          GAMMA(IND1)=QFR(NUM2+4)
+          OUT=OUT+FUNKNO(IND1)*QFR(NUM2+4)
+        ENDIF
+        IALB=IQFR(NUM2+5)
+        IF((IALB.NE.0).AND.(QFR(NUM2+5).GT.0.0)) THEN
+          IND1=KN(NUM1+2+4*IELEM**2)
+          IF(IND1.LE.0) CALL XABORT('DREJ02: bug5')
+          GAMMA(IND1)=-QFR(NUM2+5)
+          OUT=OUT-FUNKNO(IND1)*QFR(NUM2+5)
+        ENDIF
+        IALB=IQFR(NUM2+6)
+        IF((IALB.NE.0).AND.(QFR(NUM2+6).GT.0.0)) THEN
+          IND1=KN(NUM1+2+5*IELEM**2)
+          IF(IND1.LE.0) CALL XABORT('DREJ02: bug6')
+          GAMMA(IND1)=QFR(NUM2+6)
+          OUT=OUT+FUNKNO(IND1)*QFR(NUM2+6)
+        ENDIF
+   10   NUM1=NUM1+1+6*IELEM**2
+        NUM2=NUM2+6
+   20   CONTINUE
+      ELSE IF((ITYPE.NE.8).OR.(ITYPE.NE.9)) THEN
+        DO 40 K=1,NREG
+        IF(MAT(K).EQ.0) GO TO 40
+        IF(VOL(K).EQ.0.0) GO TO 30
+        IF((IALB.NE.0).AND.(QFR(NUM2+1).GT.0.0)) THEN
+          IND1=KN(NUM1+2)
+          IF(IND1.LE.0) CALL XABORT('DREJ02: bug7')
+          GAMMA(IND1)=-QFR(NUM2+1)
+          OUT=OUT-FUNKNO(IND1)*QFR(NUM2+1)
+        ENDIF
+        IALB=IQFR(NUM2+2)
+        IF((IALB.NE.0).AND.(QFR(NUM2+2).GT.0.0)) THEN
+          IND1=KN(NUM1+2+IELEM**2)
+          IF(IND1.LE.0) CALL XABORT('DREJ02: bug8')
+          GAMMA(IND1)=QFR(NUM2+2)
+          OUT=OUT+FUNKNO(IND1)*QFR(NUM2+2)
+        ENDIF
+        IALB=IQFR(NUM2+3)
+        IF((IALB.NE.0).AND.(QFR(NUM2+3).GT.0.0)) THEN
+          IND1=KN(NUM1+2+2*IELEM**2)
+          IF(IND1.LE.0) CALL XABORT('DREJ02: bug9')
+          GAMMA(IND1)=-QFR(NUM2+3)
+          OUT=OUT-FUNKNO(IND1)*QFR(NUM2+3)
+        ENDIF
+        IALB=IQFR(NUM2+4)
+        IF((IALB.NE.0).AND.(QFR(NUM2+4).GT.0.0)) THEN
+          IND1=KN(NUM1+2+3*IELEM**2)
+          IF(IND1.LE.0) CALL XABORT('DREJ02: bug10')
+          GAMMA(IND1)=QFR(NUM2+4)
+          OUT=OUT+FUNKNO(IND1)*QFR(NUM2+4)
+        ENDIF
+        IALB=IQFR(NUM2+5)
+        IF((IALB.NE.0).AND.(QFR(NUM2+5).GT.0.0)) THEN
+          IND1=KN(NUM1+2+4*IELEM**2)
+          IF(IND1.LE.0) CALL XABORT('DREJ02: bug11')
+          GAMMA(IND1)=-QFR(NUM2+5)
+          OUT=OUT-FUNKNO(IND1)*QFR(NUM2+5)
+        ENDIF
+        IALB=IQFR(NUM2+6)
+        IF((IALB.NE.0).AND.(QFR(NUM2+6).GT.0.0)) THEN
+          IND1=KN(NUM1+2+5*IELEM**2)
+          IF(IND1.LE.0) CALL XABORT('DREJ02: bug12')
+          GAMMA(IND1)=QFR(NUM2+6)
+          OUT=OUT+FUNKNO(IND1)*QFR(NUM2+6)
+        ENDIF
+        IALB=IQFR(NUM2+7)
+        IF((IALB.NE.0).AND.(QFR(NUM2+7).GT.0.0)) THEN
+          IND1=KN(NUM1+2+6*IELEM**2)
+          IF(IND1.LE.0) CALL XABORT('DREJ02: bug13')
+          GAMMA(IND1)=-QFR(NUM2+7)
+          OUT=OUT-FUNKNO(IND1)*QFR(NUM2+7)
+        ENDIF
+        IALB=IQFR(NUM2+8)
+        IF((IALB.NE.0).AND.(QFR(NUM2+8).GT.0.0)) THEN
+          IND1=KN(NUM1+2+7*IELEM**2)
+          IF(IND1.LE.0) CALL XABORT('DREJ02: bug14')
+          GAMMA(IND1)=QFR(NUM2+8)
+          OUT=OUT+FUNKNO(IND1)*QFR(NUM2+8)
+        ENDIF
+   30   NUM1=NUM1+1+8*IELEM**2
+        NUM2=NUM2+8
+   40   CONTINUE
+      ELSE
+        CALL XABORT('DREJ02: TYPE OF GEOMETRY NOT IMPLEMENTED.')
+      ENDIF
+      RETURN
+      END
diff --git a/Donjon/src/DREKOU.f b/Donjon/src/DREKOU.f
new file mode 100644
index 0000000..a9b1a97
--- /dev/null
+++ b/Donjon/src/DREKOU.f
@@ -0,0 +1,511 @@
+*DECK DREKOU
+      SUBROUTINE DREKOU(IPRINT,IPGPT,IPMAC1,IPMAC2,IPFLX,IPTRK,IPGRAD,
+     1 NG,NREG,ITYPE,IELEM,NMIL,NALBP,NUN,NFIS1,NFIS2,ILEAK1,ILEAK2,
+     2 IDF2,MATCOD,KEYFLX,VOL,LNO,RMSD)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute the GPT sources corresponding to the gradient of the RMS
+* absorption distribution. Case with direct effect.
+*
+*Copyright:
+* Copyright (C) 2017 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPRINT  print parameter
+* IPGPT   pointer to the L_SOURCE data structure.
+* IPMAC1  pointer to the actual macrolib structure.
+* IPMAC2  pointer to the reference macrolib structure.
+* IPFLX   pointer to the multigroup flux.
+* IPTRK   pointer to the tracking object.
+* IPGRAD  pointer to the L_OPTIMIZE object.
+* NG      number of energy groups.
+* NREG    number of regions.
+* NMIL    number of material mixtures.
+* NALBP   number of physical albedos.
+* NUN     number of unknowns per energy group.
+* NFIS1   number of fissile isotopes in actual macrolib.
+* NFIS2   number of fissile isotopes in reference macrolib.
+* ILEAK1  type of leakage calculation in actual macrolib
+*         =0: no leakage; =1: homogeneous leakage (Diffon).
+* ILEAK2  type of leakage calculation in reference macrolib.
+* IDF2    ADF type, 0 = none, 1 = Albedo, 2 = FD_B/FD_C/..., 3 = ADF.
+* MATCOD  material mixture indices per region.
+* KEYFLX  position of averaged fluxes in unknown vector.
+* VOL     volumes.
+* LNO     flag set to .true. to exit after calculation of RMS.
+*
+*Parameters: output
+* RMSD    RMS error on rate distribution.
+*
+*Parameters: 
+* ITYPE
+* IELEM
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPGPT,IPMAC1,IPMAC2,IPFLX,IPTRK,IPGRAD
+      INTEGER IPRINT,NG,NREG,ITYPE,IELEM,NMIL,NALBP,NUN,NFIS1,NFIS2,
+     > ILEAK1,ILEAK2,IDF2,MATCOD(NREG),KEYFLX(NREG)
+      REAL VOL(NREG)
+      DOUBLE PRECISION RMSD
+      LOGICAL LNO
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER (NSTATE=40)
+      TYPE(C_PTR) JPMAC1,JPMAC2,KPMAC1,KPMAC2,JPFLX,JPGPT,KPGPT
+      INTEGER ISTATE(NSTATE)
+      DOUBLE PRECISION SOUT1,SOUT2,GRATOT,SOUTOT,AB1TOT,AB2TOT,FI1TOT,
+     > FI2TOT,SUM1,DSUM,DELTA,OUT,SA,SF,SUNGAR,ABS2M,OUT2M,AIL,BIL,DEN1,
+     > DEN2
+      CHARACTER HSMG*131
+      DOUBLE PRECISION, PARAMETER :: EPS=1.0E-4,EPSL=1.0E-4
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IJJ,NJJ,IPOS,IREL,KN,IQFR
+      REAL, ALLOCATABLE, DIMENSION(:) :: GAR,WORK,SUNK,FLUX,QFR,OUTG1,
+     > OUTG2,DIFHOM,DIFF
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: PHI1,PHI2,ABS1,ABS2,NUF1,
+     > NUF2,GAMMA,OUTG2R
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: CHI1,CHI2,RHS1,LHS1,RHS2,
+     > LHS2
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: VARV,GRAD,RHS,CONST
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: SIGA,SIGF
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(PHI1(NMIL,NG),PHI2(NMIL,NG),ABS1(NMIL,NG),ABS2(NMIL,NG),
+     1 RHS1(NMIL,NG,NG),LHS1(NMIL,NG,NG),RHS2(NMIL,NG,NG),
+     2 LHS2(NMIL,NG,NG),CONST(NG),IREL(NG),RHS(NG),GAMMA(NUN,NG),
+     3 OUTG1(NG),OUTG2(NG),OUTG2R(NG,2),SIGA(NMIL,NG),SIGF(NMIL,NG))
+*----
+*  COMPUTE THE ACTUAL AND REFERENCE REACTION RATE MATRICES
+*----
+      CALL LCMGET(IPMAC1,'K-EFFECTIVE',ZKEFF1)
+      CALL LCMGET(IPMAC2,'K-EFFECTIVE',ZKEFF2)
+      IF(IDF2.EQ.1) THEN
+        CALL LCMSIX(IPMAC2,'ADF',1)
+        CALL LCMLEN(IPMAC2,'ALBS00',ILCMLN,ITYLCM)
+        IF(ILCMLN.NE.2*NG) CALL XABORT('DREKOU: WRONG ALBS00 LENGTH.')
+        CALL LCMGET(IPMAC2,'ALBS00',OUTG2R)
+        CALL LCMSIX(IPMAC2,' ',2)
+      ENDIF
+      CALL LCMLEN(IPMAC1,'B2  B1HOM',ILCMLN,ITYLCM)
+      IF(ILCMLN.EQ.1) THEN
+        CALL LCMGET(IPMAC1,'B2  B1HOM',B21)
+      ELSE
+        B21=0.0
+      ENDIF
+      CALL LCMLEN(IPMAC2,'B2  B1HOM',ILCMLN,ITYLCM)
+      IF(ILCMLN.EQ.1) THEN
+        CALL LCMGET(IPMAC2,'B2  B1HOM',B22)
+      ELSE
+        B22=0.0
+      ENDIF
+      IF((ILEAK1.EQ.1).AND.(IPRINT.GT.0)) THEN
+        WRITE(6,'(/22H DREKOU:     MACRO B2=,1P,E12.4)') B21
+      ENDIF
+      IF((ILEAK2.EQ.1).AND.(IPRINT.GT.0)) THEN
+        WRITE(6,'(/22H DREKOU: REFERENCE B2=,1P,E12.4)') B22
+      ENDIF
+      RHS1(:NMIL,:NG,:NG)=0.0
+      LHS1(:NMIL,:NG,:NG)=0.0
+      RHS2(:NMIL,:NG,:NG)=0.0
+      LHS2(:NMIL,:NG,:NG)=0.0
+      SIGA(:NMIL,:NG)=0.0D0
+      SIGF(:NMIL,:NG)=0.0D0
+      JPMAC1=LCMGID(IPMAC1,'GROUP')
+      JPMAC2=LCMGID(IPMAC2,'GROUP')
+      ALLOCATE(IJJ(NMIL),NJJ(NMIL),IPOS(NMIL),GAR(NMIL),WORK(NMIL*NG),
+     1 CHI1(NMIL,NFIS1,NG),NUF1(NMIL,NFIS1),CHI2(NMIL,NFIS2,NG),
+     2 NUF2(NMIL,NFIS2),DIFHOM(NG),DIFF(NMIL))
+      DO IG=1,NG
+        KPMAC1=LCMGIL(JPMAC1,IG)
+        CALL LCMGET(KPMAC1,'CHI',CHI1(1,1,IG))
+        KPMAC2=LCMGIL(JPMAC2,IG)
+        CALL LCMGET(KPMAC2,'CHI',CHI2(1,1,IG))
+        CALL LCMLEN(KPMAC1,'FLUX-INTG',ILG,ITYLCM)
+        IF(ILG.NE.NMIL) CALL XABORT('DREKOU: MISSING ACTUAL FLUX.')
+        CALL LCMLEN(KPMAC2,'FLUX-INTG',ILG,ITYLCM)
+        IF(ILG.NE.NMIL) CALL XABORT('DREKOU: MISSING REFERENCE FLUX.')
+        CALL LCMGET(KPMAC1,'FLUX-INTG',PHI1(1,IG))
+        CALL LCMGET(KPMAC2,'FLUX-INTG',PHI2(1,IG))
+      ENDDO
+      DO IG=1,NG
+        KPMAC1=LCMGIL(JPMAC1,IG)
+        KPMAC2=LCMGIL(JPMAC2,IG)
+        IF(ILEAK1.EQ.1) THEN
+          CALL LCMLEN(KPMAC1,'DIFF',ILCMLN,ITYLCM)
+          IF(ILCMLN.GT.0) THEN
+            CALL LCMGET(KPMAC1,'DIFF',DIFF)
+          ELSE
+            CALL LCMGET(IPMAC1,'DIFHOMB1HOM',DIFHOM)
+            DO IBM=1,NMIL
+              DIFF(IBM)=DIFHOM(IG)
+            ENDDO
+          ENDIF
+        ELSE
+          DIFF(:NMIL)=0.0
+        ENDIF
+        CALL LCMGET(KPMAC1,'NTOT0',GAR)
+        CALL LCMGET(KPMAC1,'SCAT00',WORK)
+        CALL LCMGET(KPMAC1,'NJJS00',NJJ)
+        CALL LCMGET(KPMAC1,'IJJS00',IJJ)
+        CALL LCMGET(KPMAC1,'IPOS00',IPOS)
+        DO IBM=1,NMIL
+          SIGA(IBM,IG)=SIGA(IBM,IG)+GAR(IBM)
+          IPOSDE=IPOS(IBM)
+          DO JG=IJJ(IBM),IJJ(IBM)-NJJ(IBM)+1,-1
+*           IG <-- JG
+            RHS1(IBM,IG,JG)=RHS1(IBM,IG,JG)-WORK(IPOSDE)*PHI1(IBM,JG)
+            SIGA(IBM,JG)=SIGA(IBM,JG)-WORK(IPOSDE)
+            IPOSDE=IPOSDE+1
+          ENDDO
+          RHS1(IBM,IG,IG)=RHS1(IBM,IG,IG)+(GAR(IBM)+B21*DIFF(IBM))*
+     >    PHI1(IBM,IG)
+        ENDDO
+        CALL LCMGET(KPMAC1,'NUSIGF',NUF1)
+        DO IBM=1,NMIL
+          DO IFIS=1,NFIS1
+            DO JG=1,NG
+              LHS1(IBM,JG,IG)=LHS1(IBM,JG,IG)+CHI1(IBM,IFIS,JG)*
+     >        NUF1(IBM,IFIS)*PHI1(IBM,IG)
+              SIGF(IBM,IG)=SIGF(IBM,IG)+CHI1(IBM,IFIS,JG)*NUF1(IBM,IFIS)
+            ENDDO
+          ENDDO
+        ENDDO
+*
+        IF(ILEAK2.EQ.1) THEN
+          CALL LCMLEN(KPMAC2,'DIFF',ILCMLN,ITYLCM)
+          IF(ILCMLN.GT.0) THEN
+            CALL LCMGET(KPMAC2,'DIFF',DIFF)
+          ELSE
+            CALL LCMGET(IPMAC2,'DIFHOMB1HOM',DIFHOM)
+            DO IBM=1,NMIL
+              DIFF(IBM)=DIFHOM(IG)
+            ENDDO
+          ENDIF
+        ELSE
+          DIFF(:NMIL)=0.0
+        ENDIF
+        CALL LCMGET(KPMAC2,'NTOT0',GAR)
+        CALL LCMGET(KPMAC2,'SCAT00',WORK)
+        CALL LCMGET(KPMAC2,'NJJS00',NJJ)
+        CALL LCMGET(KPMAC2,'IJJS00',IJJ)
+        CALL LCMGET(KPMAC2,'IPOS00',IPOS)
+        DO IBM=1,NMIL
+          IPOSDE=IPOS(IBM)
+          DO JG=IJJ(IBM),IJJ(IBM)-NJJ(IBM)+1,-1
+*           IG <-- JG
+            RHS2(IBM,IG,JG)=RHS2(IBM,IG,JG)-WORK(IPOSDE)*PHI2(IBM,JG)
+            IPOSDE=IPOSDE+1
+          ENDDO
+          RHS2(IBM,IG,IG)=RHS2(IBM,IG,IG)+(GAR(IBM)+B22*DIFF(IBM))*
+     >    PHI2(IBM,IG)
+        ENDDO
+        CALL LCMGET(KPMAC2,'NUSIGF',NUF2)
+        DO IBM=1,NMIL
+          DO IFIS=1,NFIS2
+            DO JG=1,NG
+              LHS2(IBM,JG,IG)=LHS2(IBM,JG,IG)+CHI2(IBM,IFIS,JG)*
+     >        NUF2(IBM,IFIS)*PHI2(IBM,IG)
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDDO
+      DEALLOCATE(DIFF,DIFHOM,NUF2,CHI2,NUF1,CHI1,WORK,GAR,IPOS,NJJ,IJJ)
+*----
+*  COMPUTE THE ACTUAL AND REFERENCE ABSORPTION AND FISSION RATES
+*----
+      AB1TOT=0.0D0
+      AB2TOT=0.0D0
+      FI1TOT=0.0D0
+      FI2TOT=0.0D0
+      DO IG=1,NG
+        OUTG1(IG)=0.0
+        OUTG2(IG)=0.0
+        DO IBM=1,NMIL
+          OUTG1(IG)=OUTG1(IG)+SUM(LHS1(IBM,IG,:NG))/ZKEFF1-
+     1    SUM(RHS1(IBM,IG,:NG))
+          OUTG2(IG)=OUTG2(IG)+SUM(LHS2(IBM,IG,:NG))/ZKEFF2-
+     1    SUM(RHS2(IBM,IG,:NG))
+          ABS1(IBM,IG)=SUM(RHS1(IBM,:NG,IG))
+          ABS2(IBM,IG)=SUM(RHS2(IBM,:NG,IG))
+          AB1TOT=AB1TOT+ABS1(IBM,IG)
+          AB2TOT=AB2TOT+ABS2(IBM,IG)
+          FI1TOT=FI1TOT+SUM(LHS1(IBM,:NG,IG))
+          FI2TOT=FI2TOT+SUM(LHS2(IBM,:NG,IG))
+        ENDDO
+        IF(IDF2.EQ.1) OUTG2(IG)=OUTG2R(IG,1)-OUTG2R(IG,2)
+        IF((NALBP.GT.0).AND.(OUTG2(IG).LT.-1.0E-6)) THEN
+          WRITE(HSMG,'(44HDREKOU: INCONSISTENT REFERENCE LEAKAGE IN GR,
+     1    3HOUP,I4,7H. LEAK=,1P,E13.4)') IG,OUTG2(IG)
+          CALL XABORT(HSMG)
+        ENDIF
+      ENDDO
+*----
+*  COMPUTE THE ACTUAL LEAKAGE FROM OUT-CURRENTS
+*----
+      OUT=0.0D0
+      GAMMA(:NUN,:NG)=0.0
+      IF(NALBP.GT.0) THEN
+        CALL LCMLEN(IPTRK,'KN',MAXKN,ITYLCM)
+        CALL LCMLEN(IPTRK,'QFR',MAXQF,ITYLCM)
+        ALLOCATE(KN(MAXKN),QFR(MAXQF),IQFR(MAXQF),FLUX(NUN))
+        CALL LCMGET(IPTRK,'KN',KN)
+        CALL LCMGET(IPTRK,'QFR',QFR)
+        CALL LCMGET(IPTRK,'IQFR',IQFR)
+        JPFLX=LCMGID(IPFLX,'FLUX')
+        DO IG=1,NG
+          CALL LCMGDL(JPFLX,IG,FLUX)
+          CALL DREJ02(ITYPE,IELEM,NREG,NUN,MAXKN,MAXQF,MATCOD,KN,QFR,
+     1    IQFR,VOL,FLUX,OUTG1(IG),GAMMA(1,IG))
+          OUT=OUT+OUTG1(IG)
+          IF(IPRINT.GT.0) WRITE(6,130) IG,OUTG1(IG)/REAL(AB1TOT),
+     1    OUTG2(IG)/REAL(AB2TOT)
+        ENDDO
+        DEALLOCATE(FLUX,IQFR,QFR,KN)
+      ENDIF
+*----
+*  COMPUTE MACRO AND REFERENCE K-EFFECTIVE
+*----
+      DEN1=0.0D0
+      DEN2=0.0D0
+      DO IG=1,NG
+        OUTG1(IG)=OUTG1(IG)+SUM(ABS1(:NMIL,IG))
+        OUTG2(IG)=OUTG2(IG)+SUM(ABS2(:NMIL,IG))
+        DEN1=DEN1+OUTG1(IG)
+        DEN2=DEN2+OUTG2(IG)
+      ENDDO
+      IF(IPRINT.GT.0) THEN
+        WRITE(6,'(/24H DREKOU:     MACRO KEFF=,1P,E12.5)') FI1TOT/DEN1
+        WRITE(6,'(/24H DREKOU: REFERENCE KEFF=,1P,E12.5)') FI2TOT/DEN2
+      ENDIF
+*----
+*  GET INFORMATION FROM L_OPTIMIZE OBJECT
+*----
+      CALL LCMGET(IPGRAD,'DEL-STATE',ISTATE)
+      IF(ISTATE(4).LE.2) CALL XABORT('DREKOU: NO DIRECT EFFECT WITH '
+     > //'THIS TYPE OF PERTURBATION.')
+      IF(ISTATE(7).NE.1) CALL XABORT('DREKOU: IBM1=1 EXPECTED.')
+      IF(ISTATE(8).NE.NMIL) CALL XABORT('DREKOU: IBM2=NMIL EXPECTED.')
+      IMC=ISTATE(4)-2
+      NGR1=ISTATE(5)
+      NGR2=ISTATE(6)
+      IF(IMC.LE.2) THEN
+        NPERT=(NMIL+NALBP)*(NGR2-NGR1+1)
+      ELSE
+        NPERT=NALBP*(NGR2-NGR1+1)
+      ENDIF
+      ALLOCATE(VARV(NPERT))
+      CALL LCMGET(IPGRAD,'VAR-VALUE',VARV)
+*----
+*  COMPUTE THE RMS FUNCTIONAL AND CONSTRAINTS
+*----
+      IREL(:NGR2-NGR1+1)=0
+      RHS(:NGR2-NGR1+1)=0.0D0
+      WEI=REAL(NMIL)
+      RMSD=0.0D0
+      IF(IMC.LE.2) THEN
+        IPERT=0
+        DO IG=NGR1,NGR2
+          SUM1=0.0D0
+          DSUM=0.0D0
+          DO IBM=1,NMIL
+            IPERT=IPERT+1
+            ABS2M=MAX(EPS*AB2TOT,DBLE(ABS2(IBM,IG)))
+            DELTA=ABS1(IBM,IG)*AB2TOT/(ABS2M*AB1TOT)-ABS2(IBM,IG)/ABS2M
+            RMSD=RMSD+DELTA**2
+            SUM1=SUM1+PHI2(IBM,IG)/VARV(IPERT)
+            DSUM=DSUM+PHI2(IBM,IG)
+          ENDDO
+          DELTA=SUM1/DSUM-1.0D0
+          RMSD=RMSD+DELTA**2
+          CONST(IG-NGR1+1)=DELTA
+          IPERT=IPERT+NALBP
+        ENDDO
+      ENDIF
+      IF(NALBP.GT.0) THEN
+        DO IG=1,NG
+          OUT2M=MAX(EPSL*FI2TOT,DBLE(OUTG2(IG)))
+          DELTA=OUTG1(IG)*FI2TOT/(OUT2M*FI1TOT)-OUTG2(IG)/OUT2M
+          RMSD=RMSD+WEI*DELTA**2
+        ENDDO
+      ENDIF
+      IF(IPRINT.GT.0) THEN
+        WRITE(6,100) RMSD
+        IF(IMC.LE.2) THEN
+          DO IG=NGR1,NGR2
+            WRITE(6,110) IG,CONST(IG-NGR1+1)
+          ENDDO
+        ENDIF
+      ENDIF
+      IF((IPRINT.GT.2).AND.(IMC.LE.2)) THEN
+        DO IG=1,NG
+          WRITE(6,'(7H GROUP=,I4)') IG
+          DO IBM=1,NMIL
+            WRITE(6,120) IBM,ABS1(IBM,IG)/REAL(AB1TOT),
+     1                   ABS2(IBM,IG)/REAL(AB2TOT)
+          ENDDO
+        ENDDO
+      ENDIF
+*----
+*  STORE INFORMATION ON L_OPTIMIZE OBJECT
+*----
+      CALL LCMPUT(IPGRAD,'FOBJ-CST-VAL',1,4,RMSD)
+      IF(LNO) GO TO 20
+*----
+*  COMPUTE THE GRADIENT OF THE RMS FUNCTIONAL
+*----
+      ALLOCATE(SUNK(NUN))
+      JPGPT=LCMLID(IPGPT,'ASOUR',1)
+      KPGPT=LCMLIL(JPGPT,1,NG)
+      DO IG=1,NG
+        SUNK(:NUN)=0.0
+        DO IR=1,NREG
+          IUNK=KEYFLX(IR)
+          IF(IUNK.EQ.0) CYCLE
+          IBM=MATCOD(IR)
+          IF(IBM.EQ.0) CYCLE
+          SA=SIGA(IBM,IG)
+          SF=SIGF(IBM,IG)
+          SOUT1=0.0D0
+          SOUT2=0.0D0
+          SUNGAR=0.0D0
+          IF(IMC.LE.2) THEN
+            DO JG=1,NG
+              DO JBM=1,NMIL
+               ABS2M=MAX(EPS*AB2TOT,DBLE(ABS2(JBM,JG)))
+               DELTA=ABS1(JBM,JG)*AB2TOT/(ABS2M*AB1TOT)-ABS2(JBM,JG)/
+     1         ABS2M
+               IF((IG.EQ.JG).AND.(IBM.EQ.JBM)) THEN
+                 SOUT1=SOUT1+DELTA/ABS2M
+               ENDIF
+               SOUT2=SOUT2+(ABS1(JBM,JG)/AB1TOT)*DELTA/ABS2M
+              ENDDO
+            ENDDO
+            SUNGAR=2.0D0*VOL(IR)*SA*AB2TOT*(SOUT1-SOUT2)/AB1TOT
+          ENDIF
+          IF(NALBP.GT.0) THEN
+            SOUT1=0.0D0
+            SOUT2=0.0D0
+            DO JG=1,NG
+              OUT2M=MAX(EPSL*FI2TOT,DBLE(OUTG2(JG)))
+              DELTA=OUTG1(JG)*FI2TOT/(OUT2M*FI1TOT)-OUTG2(JG)/OUT2M
+              IF(IG.EQ.JG) SOUT1=SOUT1+DELTA*SA/OUT2M
+              SOUT2=SOUT2+(OUTG1(JG)/FI1TOT)*DELTA*SF/OUT2M
+            ENDDO
+            SUNGAR=SUNGAR+2.0D0*VOL(IR)*WEI*FI2TOT*(SOUT1-SOUT2)/FI1TOT
+          ENDIF
+          SUNK(IUNK)=REAL(SUNGAR)
+        ENDDO
+        IF(NALBP.GT.0) THEN
+          OUT2M=MAX(EPSL*FI2TOT,DBLE(OUTG2(IG)))
+          DELTA=OUTG1(IG)*FI2TOT/(OUT2M*FI1TOT)-OUTG2(IG)/OUT2M
+          DO IUNK=1,NUN
+            SOUT1=DELTA*GAMMA(IUNK,IG)/OUT2M
+            SUNK(IUNK)=SUNK(IUNK)+2.0*WEI*REAL(FI2TOT*SOUT1/FI1TOT)
+          ENDDO
+        ENDIF
+        CALL LCMPDL(KPGPT,IG,NUN,2,SUNK)
+      ENDDO
+*----
+*  CHECK SOURCE ORTHOGONALITY
+*----
+      ALLOCATE(FLUX(NUN))
+      JPFLX=LCMGID(IPFLX,'FLUX')
+      AIL=0.0D0
+      BIL=0.0D0
+      DO IG=1,NG
+        CALL LCMGDL(KPGPT,IG,SUNK)
+        CALL LCMGDL(JPFLX,IG,FLUX)
+        DO IUNK=1,NUN
+          GAZ=FLUX(IUNK)*SUNK(IUNK)
+          DAZ=FLUX(IUNK)**2
+          AIL=AIL+GAZ
+          BIL=BIL+DAZ
+        ENDDO
+      ENDDO
+      DSUM=ABS(AIL)/ABS(BIL)/REAL(NUN)
+      IF(IPRINT.GT.0) THEN
+        WRITE(6,'(/21H DREKOU: DOT PRODUCT=,1P,E11.4)') DSUM
+      ENDIF
+      IF(ABS(DSUM).GT.1.0E-4) THEN
+        WRITE(HSMG,'(36HDREKOU: NON ORTHOGONAL SOURCE (DSUM=,1P,E11.3,
+     1  2H).)') DSUM
+        CALL XABORT(HSMG)
+      ENDIF
+      DEALLOCATE(FLUX,SUNK)
+*----
+*  COMPUTE THE DIRECT GRADIENTS
+*----
+      ALLOCATE(GRAD(NPERT))
+      GRAD(:NPERT)=0.0D0
+      IF(IMC.GT.2) GO TO 10
+      IPERT=0
+      DO IG=NGR1,NGR2
+        DSUM=0.0D0
+        DO IBM=1,NMIL
+          DSUM=DSUM+PHI2(IBM,IG)
+        ENDDO
+        DO IBM=1,NMIL
+          IPERT=IPERT+1
+          GRATOT=0.0D0
+          DO JG=1,NG
+            DO JBM=1,NMIL
+             SOUTOT=0.0D0
+             IF((IG.EQ.JG).AND.(IBM.EQ.JBM)) SOUTOT=1.0
+             SOUTOT=SOUTOT-ABS1(IBM,IG)/AB1TOT
+             ABS2M=MAX(EPS*AB2TOT,DBLE(ABS2(JBM,JG)))
+             DELTA=ABS1(JBM,JG)*AB2TOT/(ABS2M*AB1TOT)-ABS2(JBM,JG)/ABS2M
+             GRATOT=GRATOT+SOUTOT*ABS1(JBM,JG)*DELTA*AB2TOT/ABS2M
+            ENDDO
+          ENDDO
+          GRAD(IPERT)=2.0D0*GRATOT/AB1TOT/VARV(IPERT)
+          IF(NALBP.GT.0) THEN
+            SOUT1=0.0D0
+            SOUT2=0.0D0
+            DO JG=1,NG
+              OUT2M=MAX(EPSL*FI2TOT,DBLE(OUTG2(JG)))
+              DELTA=OUTG1(JG)*FI2TOT/(OUT2M*FI1TOT)-OUTG2(JG)/OUT2M
+              IF(IG.EQ.JG) SOUT1=SOUT1+ABS1(IBM,IG)*DELTA/OUT2M
+              SOUT2=SOUT2+(OUTG1(JG)/FI1TOT)*SUM(LHS1(IBM,:NG,IG))*
+     1        DELTA/OUT2M
+            ENDDO
+            GRAD(IPERT)=GRAD(IPERT)+2.0D0*WEI*FI2TOT*(SOUT1-SOUT2)/
+     1      FI1TOT/VARV(IPERT)
+          ENDIF
+*         equality constraints
+          GRAD(IPERT)=GRAD(IPERT)-2.0D0*CONST(IG-NGR1+1)*PHI2(IBM,IG)/
+     1    (DSUM*VARV(IPERT)**2)
+        ENDDO
+        IPERT=IPERT+NALBP
+      ENDDO
+   10 CALL LCMPUT(IPGRAD,'GRADIENT-DIR',NPERT,4,GRAD)
+      DEALLOCATE(GRAD)
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+   20 DEALLOCATE(VARV,SIGF,SIGA,OUTG2R,OUTG2,OUTG1,GAMMA,RHS,IREL,CONST,
+     1 LHS2,RHS2,LHS1,RHS1,ABS2,ABS1,PHI2,PHI1)
+      RETURN
+*
+  100 FORMAT(/40H DREKOU: RMS ERROR ON RATE DISTRIBUTION=,1P,E11.4)
+  110 FORMAT(23H DREKOU:    CONSTRAINT(,I4,2H)=,1P,E11.4)
+  120 FORMAT(5X,16HABSORPTION RATE(,I4,2H)=,1P,2E12.4)
+  130 FORMAT(5X,6HGROUP=,I4,9H LEAKAGE=,1P,2E12.4)
+      END
diff --git a/Donjon/src/DRENOU.f b/Donjon/src/DRENOU.f
new file mode 100644
index 0000000..ea5941f
--- /dev/null
+++ b/Donjon/src/DRENOU.f
@@ -0,0 +1,549 @@
+*DECK DRENOU
+      SUBROUTINE DRENOU(IPRINT,IPGPT,IPMAC1,IPMAC2,IPFLX,IPTRK,IPGRAD,
+     1 NG,NREG,ITYPE,IELEM,NMIL,NALBP,NUN,NFIS1,NFIS2,ILEAK1,ILEAK2,
+     2 IDF2,MATCOD,KEYFLX,VOL,LNO,NFUNC,RMSD)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute the GPT sources corresponding to the gradient of the RMS
+* absorption distribution. Case with NFUNC individual components to be
+* used with a Newtonian method.
+*
+*Copyright:
+* Copyright (C) 2019 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPRINT  print parameter
+* IPGPT   pointer to the L_GPT data structure.
+* IPMAC1  pointer to the actual macrolib structure.
+* IPMAC2  pointer to the reference macrolib structure.
+* IPFLX   pointer to the multigroup flux.
+* IPTRK   pointer to the tracking object.
+* IPGRAD  pointer to the L_OPTIMIZE object.
+* NG      number of energy groups.
+* NREG    number of regions.
+* NMIL    number of material mixtures.
+* NALBP   number of physical albedos.
+* NUN     number of unknowns per energy group.
+* NFIS1   number of fissile isotopes in actual macrolib.
+* NFIS2   number of fissile isotopes in reference macrolib.
+* ILEAK1  type of leakage calculation in actual macrolib
+*         =0: no leakage; =1: homogeneous leakage (Diffon).
+* ILEAK2  type of leakage calculation in reference macrolib.
+* IDF2    ADF type, 0 = none, 1 = Albedo, 2 = FD_B/FD_C/..., 3 = ADF.
+* MATCOD  material mixture indices per region.
+* KEYFLX  position of averaged fluxes in unknown vector.
+* VOL     volumes.
+* LNO     flag set to .true. to exit after calculation of RMS.
+*
+*Parameters: output
+* NFUNC   number of individual components in the gradient terms.
+* RMSD    RMS error on rate distribution.
+*
+*Parameters: 
+* ITYPE
+* IELEM
+*
+* Reference:
+*  A. Hebert,"Developpement de la methode SPH: Homogeneisation de
+*  cellules dans un reseau non uniforme et calcul des parametres de
+*  reflecteur," Note CEA-N-2209, Sect. 3.5.1, 1981.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPGPT,IPMAC1,IPMAC2,IPFLX,IPTRK,IPGRAD
+      INTEGER IPRINT,NG,NREG,ITYPE,IELEM,NMIL,NALBP,NUN,NFIS1,NFIS2,
+     > ILEAK1,ILEAK2,IDF2,MATCOD(NREG),KEYFLX(NREG),NFUNC
+      REAL VOL(NREG)
+      DOUBLE PRECISION RMSD
+      LOGICAL LNO
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER (NSTATE=40)
+      TYPE(C_PTR) JPMAC1,JPMAC2,KPMAC1,KPMAC2,JPFLX,JPGPT,KPGPT
+      INTEGER ISTATE(NSTATE)
+      DOUBLE PRECISION SOUT1,SOUT2,SOUTOT,AB1TOT,AB2TOT,FI1TOT,FI2TOT,
+     > SUM1,DSUM,DELTA,OUT,SA,SF,ABS2M,OUT2M,AIL,BIL,DEN1,DEN2
+      CHARACTER HSMG*131
+      DOUBLE PRECISION, PARAMETER :: EPS=1.0E-4,EPSL=1.0E-4
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IJJ,NJJ,IPOS,IREL,KN,IQFR
+      REAL, ALLOCATABLE, DIMENSION(:) :: GAR,WORK,SUNK,FLUX,QFR,OUTG1,
+     > OUTG2,DIFHOM,DIFF
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: PHI1,PHI2,ABS1,ABS2,NUF1,
+     > NUF2,GAMMA,OUTG2R
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: CHI1,CHI2,RHS1,LHS1,RHS2,
+     > LHS2
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: VARV,RHS,CONST,FF
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: SIGA,SIGF,DFF
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(PHI1(NMIL,NG),PHI2(NMIL,NG),ABS1(NMIL,NG),ABS2(NMIL,NG),
+     1 RHS1(NMIL,NG,NG),LHS1(NMIL,NG,NG),RHS2(NMIL,NG,NG),
+     2 LHS2(NMIL,NG,NG),CONST(NG),IREL(NG),RHS(NG),GAMMA(NUN,NG),
+     3 OUTG1(NG),OUTG2(NG),OUTG2R(NG,2),SIGA(NMIL,NG),SIGF(NMIL,NG))
+*----
+*  COMPUTE THE ACTUAL AND REFERENCE REACTION RATE MATRICES
+*----
+      CALL LCMGET(IPMAC1,'K-EFFECTIVE',ZKEFF1)
+      CALL LCMGET(IPMAC2,'K-EFFECTIVE',ZKEFF2)
+      IF(IDF2.EQ.1) THEN
+        CALL LCMSIX(IPMAC2,'ADF',1)
+        CALL LCMLEN(IPMAC2,'ALBS00',ILCMLN,ITYLCM)
+        IF(ILCMLN.NE.2*NG) CALL XABORT('DRENOU: WRONG ALBS00 LENGTH.')
+        CALL LCMGET(IPMAC2,'ALBS00',OUTG2R)
+        CALL LCMSIX(IPMAC2,' ',2)
+      ENDIF
+      CALL LCMLEN(IPMAC1,'B2  B1HOM',ILCMLN,ITYLCM)
+      IF(ILCMLN.EQ.1) THEN
+        CALL LCMGET(IPMAC1,'B2  B1HOM',B21)
+      ELSE
+        B21=0.0
+      ENDIF
+      CALL LCMLEN(IPMAC2,'B2  B1HOM',ILCMLN,ITYLCM)
+      IF(ILCMLN.EQ.1) THEN
+        CALL LCMGET(IPMAC2,'B2  B1HOM',B22)
+      ELSE
+        B22=0.0
+      ENDIF
+      IF((ILEAK1.EQ.1).AND.(IPRINT.GT.0)) THEN
+        WRITE(6,'(/22H DRENOU:     MACRO B2=,1P,E12.4)') B21
+      ENDIF
+      IF((ILEAK2.EQ.1).AND.(IPRINT.GT.0)) THEN
+        WRITE(6,'(/22H DRENOU: REFERENCE B2=,1P,E12.4)') B22
+      ENDIF
+      RHS1(:NMIL,:NG,:NG)=0.0
+      LHS1(:NMIL,:NG,:NG)=0.0
+      RHS2(:NMIL,:NG,:NG)=0.0
+      LHS2(:NMIL,:NG,:NG)=0.0
+      SIGA(:NMIL,:NG)=0.0D0
+      SIGF(:NMIL,:NG)=0.0D0
+      JPMAC1=LCMGID(IPMAC1,'GROUP')
+      JPMAC2=LCMGID(IPMAC2,'GROUP')
+      ALLOCATE(IJJ(NMIL),NJJ(NMIL),IPOS(NMIL),GAR(NMIL),WORK(NMIL*NG),
+     1 CHI1(NMIL,NFIS1,NG),NUF1(NMIL,NFIS1),CHI2(NMIL,NFIS2,NG),
+     2 NUF2(NMIL,NFIS2),DIFHOM(NG),DIFF(NMIL))
+      DO IG=1,NG
+        KPMAC1=LCMGIL(JPMAC1,IG)
+        CALL LCMGET(KPMAC1,'CHI',CHI1(1,1,IG))
+        KPMAC2=LCMGIL(JPMAC2,IG)
+        CALL LCMGET(KPMAC2,'CHI',CHI2(1,1,IG))
+        CALL LCMLEN(KPMAC1,'FLUX-INTG',ILG,ITYLCM)
+        IF(ILG.NE.NMIL) CALL XABORT('DRENOU: MISSING ACTUAL FLUX.')
+        CALL LCMLEN(KPMAC2,'FLUX-INTG',ILG,ITYLCM)
+        IF(ILG.NE.NMIL) CALL XABORT('DRENOU: MISSING REFERENCE FLUX.')
+        CALL LCMGET(KPMAC1,'FLUX-INTG',PHI1(1,IG))
+        CALL LCMGET(KPMAC2,'FLUX-INTG',PHI2(1,IG))
+      ENDDO
+      DO IG=1,NG
+        KPMAC1=LCMGIL(JPMAC1,IG)
+        KPMAC2=LCMGIL(JPMAC2,IG)
+        IF(ILEAK1.EQ.1) THEN
+          CALL LCMLEN(KPMAC1,'DIFF',ILCMLN,ITYLCM)
+          IF(ILCMLN.GT.0) THEN
+            CALL LCMGET(KPMAC1,'DIFF',DIFF)
+          ELSE
+            CALL LCMGET(IPMAC1,'DIFHOMB1HOM',DIFHOM)
+            DO IBM=1,NMIL
+              DIFF(IBM)=DIFHOM(IG)
+            ENDDO
+          ENDIF
+        ELSE
+          DIFF(:NMIL)=0.0
+        ENDIF
+        CALL LCMGET(KPMAC1,'NTOT0',GAR)
+        CALL LCMGET(KPMAC1,'SCAT00',WORK)
+        CALL LCMGET(KPMAC1,'NJJS00',NJJ)
+        CALL LCMGET(KPMAC1,'IJJS00',IJJ)
+        CALL LCMGET(KPMAC1,'IPOS00',IPOS)
+        DO IBM=1,NMIL
+          SIGA(IBM,IG)=SIGA(IBM,IG)+GAR(IBM)
+          IPOSDE=IPOS(IBM)
+          DO JG=IJJ(IBM),IJJ(IBM)-NJJ(IBM)+1,-1
+*           IG <-- JG
+            RHS1(IBM,IG,JG)=RHS1(IBM,IG,JG)-WORK(IPOSDE)*PHI1(IBM,JG)
+            SIGA(IBM,JG)=SIGA(IBM,JG)-WORK(IPOSDE)
+            IPOSDE=IPOSDE+1
+          ENDDO
+          RHS1(IBM,IG,IG)=RHS1(IBM,IG,IG)+(GAR(IBM)+B21*DIFF(IBM))*
+     >    PHI1(IBM,IG)
+        ENDDO
+        CALL LCMGET(KPMAC1,'NUSIGF',NUF1)
+        DO IBM=1,NMIL
+          DO IFIS=1,NFIS1
+            DO JG=1,NG
+              LHS1(IBM,JG,IG)=LHS1(IBM,JG,IG)+CHI1(IBM,IFIS,JG)*
+     >        NUF1(IBM,IFIS)*PHI1(IBM,IG)
+              SIGF(IBM,IG)=SIGF(IBM,IG)+CHI1(IBM,IFIS,JG)*NUF1(IBM,IFIS)
+            ENDDO
+          ENDDO
+        ENDDO
+*
+        IF(ILEAK2.EQ.1) THEN
+          CALL LCMLEN(KPMAC2,'DIFF',ILCMLN,ITYLCM)
+          IF(ILCMLN.GT.0) THEN
+            CALL LCMGET(KPMAC2,'DIFF',DIFF)
+          ELSE
+            CALL LCMGET(IPMAC2,'DIFHOMB1HOM',DIFHOM)
+            DO IBM=1,NMIL
+              DIFF(IBM)=DIFHOM(IG)
+            ENDDO
+          ENDIF
+        ELSE
+          DIFF(:NMIL)=0.0
+        ENDIF
+        CALL LCMGET(KPMAC2,'NTOT0',GAR)
+        CALL LCMGET(KPMAC2,'SCAT00',WORK)
+        CALL LCMGET(KPMAC2,'NJJS00',NJJ)
+        CALL LCMGET(KPMAC2,'IJJS00',IJJ)
+        CALL LCMGET(KPMAC2,'IPOS00',IPOS)
+        DO IBM=1,NMIL
+          IPOSDE=IPOS(IBM)
+          DO JG=IJJ(IBM),IJJ(IBM)-NJJ(IBM)+1,-1
+*           IG <-- JG
+            RHS2(IBM,IG,JG)=RHS2(IBM,IG,JG)-WORK(IPOSDE)*PHI2(IBM,JG)
+            IPOSDE=IPOSDE+1
+          ENDDO
+          RHS2(IBM,IG,IG)=RHS2(IBM,IG,IG)+(GAR(IBM)+B22*DIFF(IBM))*
+     >    PHI2(IBM,IG)
+        ENDDO
+        CALL LCMGET(KPMAC2,'NUSIGF',NUF2)
+        DO IBM=1,NMIL
+          DO IFIS=1,NFIS2
+            DO JG=1,NG
+              LHS2(IBM,JG,IG)=LHS2(IBM,JG,IG)+CHI2(IBM,IFIS,JG)*
+     >        NUF2(IBM,IFIS)*PHI2(IBM,IG)
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDDO
+      DEALLOCATE(DIFF,DIFHOM,NUF2,CHI2,NUF1,CHI1,WORK,GAR,IPOS,NJJ,IJJ)
+*----
+*  COMPUTE THE ACTUAL AND REFERENCE ABSORPTION AND FISSION RATES
+*----
+      AB1TOT=0.0D0
+      AB2TOT=0.0D0
+      FI1TOT=0.0D0
+      FI2TOT=0.0D0
+      DO IG=1,NG
+        OUTG1(IG)=0.0
+        OUTG2(IG)=0.0
+        DO IBM=1,NMIL
+          OUTG1(IG)=OUTG1(IG)+SUM(LHS1(IBM,IG,:NG))/ZKEFF1-
+     1    SUM(RHS1(IBM,IG,:NG))
+          OUTG2(IG)=OUTG2(IG)+SUM(LHS2(IBM,IG,:NG))/ZKEFF2-
+     1    SUM(RHS2(IBM,IG,:NG))
+          ABS1(IBM,IG)=SUM(RHS1(IBM,:NG,IG))
+          ABS2(IBM,IG)=SUM(RHS2(IBM,:NG,IG))
+          AB1TOT=AB1TOT+ABS1(IBM,IG)
+          AB2TOT=AB2TOT+ABS2(IBM,IG)
+          FI1TOT=FI1TOT+SUM(LHS1(IBM,:NG,IG))
+          FI2TOT=FI2TOT+SUM(LHS2(IBM,:NG,IG))
+        ENDDO
+        IF(IDF2.GT.0) OUTG2(IG)=OUTG2R(IG,1)-OUTG2R(IG,2)
+        IF((NALBP.GT.0).AND.(OUTG2(IG).LT.-1.0E-6)) THEN
+          WRITE(HSMG,'(44HDRENOU: INCONSISTENT REFERENCE LEAKAGE IN GR,
+     1    3HOUP,I4,7H. LEAK=,1P,E13.4)') IG,OUTG2(IG)
+          CALL XABORT(HSMG)
+        ENDIF
+      ENDDO
+*----
+*  COMPUTE THE ACTUAL LEAKAGE FROM OUT-CURRENTS
+*----
+      OUT=0.0D0
+      GAMMA(:NUN,:NG)=0.0
+      IF(NALBP.GT.0) THEN
+        CALL LCMLEN(IPTRK,'KN',MAXKN,ITYLCM)
+        CALL LCMLEN(IPTRK,'QFR',MAXQF,ITYLCM)
+        ALLOCATE(KN(MAXKN),QFR(MAXQF),IQFR(MAXQF),FLUX(NUN))
+        CALL LCMGET(IPTRK,'KN',KN)
+        CALL LCMGET(IPTRK,'QFR',QFR)
+        CALL LCMGET(IPTRK,'IQFR',IQFR)
+        JPFLX=LCMGID(IPFLX,'FLUX')
+        DO IG=1,NG
+          CALL LCMGDL(JPFLX,IG,FLUX)
+          CALL DREJ02(ITYPE,IELEM,NREG,NUN,MAXKN,MAXQF,MATCOD,KN,QFR,
+     1    IQFR,VOL,FLUX,OUTG1(IG),GAMMA(1,IG))
+          OUT=OUT+OUTG1(IG)
+          IF(IPRINT.GT.0) THEN
+           WRITE(6,130) IG,OUTG1(IG)/REAL(AB1TOT),OUTG2(IG)/REAL(AB2TOT)
+          ENDIF
+        ENDDO
+        DEALLOCATE(FLUX,IQFR,QFR,KN)
+      ENDIF
+*----
+*  COMPUTE MACRO AND REFERENCE K-EFFECTIVE
+*----
+      DEN1=0.0D0
+      DEN2=0.0D0
+      DO IG=1,NG
+        OUTG1(IG)=OUTG1(IG)+SUM(ABS1(:NMIL,IG))
+        OUTG2(IG)=OUTG2(IG)+SUM(ABS2(:NMIL,IG))
+        DEN1=DEN1+OUTG1(IG)
+        DEN2=DEN2+OUTG2(IG)
+      ENDDO
+      IF(IPRINT.GT.0) THEN
+        WRITE(6,'(/24H DRENOU:     MACRO KEFF=,1P,E12.5)') FI1TOT/DEN1
+        WRITE(6,'(/24H DRENOU: REFERENCE KEFF=,1P,E12.5)') FI2TOT/DEN2
+      ENDIF
+*----
+*  GET INFORMATION FROM L_OPTIMIZE OBJECT
+*----
+      CALL LCMGET(IPGRAD,'DEL-STATE',ISTATE)
+      IF(ISTATE(4).LE.2) CALL XABORT('DRENOU: NO DIRECT EFFECT WITH '
+     > //'THIS TYPE OF PERTURBATION.')
+      IF(ISTATE(7).NE.1) CALL XABORT('DRENOU: IBM1=1 EXPECTED.')
+      IF(ISTATE(8).NE.NMIL) CALL XABORT('DRENOU: IBM2=NMIL EXPECTED.')
+      NGR1=ISTATE(5)
+      NGR2=ISTATE(6)
+      NPERT=(NMIL+NALBP)*(NGR2-NGR1+1)
+      NFUNC=(NMIL+NALBP+1)*(NGR2-NGR1+1)
+      ALLOCATE(VARV(NPERT))
+      ALLOCATE(FF(NFUNC),DFF(NPERT,NFUNC))
+      CALL LCMGET(IPGRAD,'VAR-VALUE',VARV)
+*----
+*  COMPUTE THE RMS FUNCTIONAL AND CONSTRAINTS
+*----
+      IREL(:NGR2-NGR1+1)=0
+      RHS(:NGR2-NGR1+1)=0.0D0
+      FF(:NFUNC)=0.0D0
+      WEI=REAL(NMIL)
+      RMSD=0.0D0
+      IPERT=0
+      IFUNC=0
+      DO IG=NGR1,NGR2
+        SUM1=0.0D0
+        DSUM=0.0D0
+        DO IBM=1,NMIL
+          IPERT=IPERT+1
+          IFUNC=IFUNC+1
+          ABS2M=MAX(EPS*AB2TOT,DBLE(ABS2(IBM,IG)))
+          DELTA=ABS1(IBM,IG)*AB2TOT/(ABS2M*AB1TOT)-ABS2(IBM,IG)/ABS2M
+          FF(IFUNC)=DELTA
+          RMSD=RMSD+DELTA**2
+          SUM1=SUM1+PHI2(IBM,IG)/VARV(IPERT)
+          DSUM=DSUM+PHI2(IBM,IG)
+        ENDDO
+        IF(NALBP.GT.0) THEN
+          OUT2M=MAX(EPSL*FI2TOT,DBLE(OUTG2(IG)))
+          DELTA=OUTG1(IG)*FI2TOT/(OUT2M*FI1TOT)-OUTG2(IG)/OUT2M
+          IFUNC=IFUNC+1
+          FF(IFUNC)=SQRT(WEI)*DELTA
+          RMSD=RMSD+WEI*DELTA**2
+        ENDIF
+        DELTA=SUM1/DSUM-1.0D0
+        IFUNC=IFUNC+1
+        FF(IFUNC)=DELTA
+        RMSD=RMSD+DELTA**2
+        CONST(IG-NGR1+1)=DELTA
+        IPERT=IPERT+NALBP
+      ENDDO
+      IF(IPRINT.GT.0) THEN
+        WRITE(6,100) RMSD,DOT_PRODUCT(FF,FF)
+        DO IG=NGR1,NGR2
+          WRITE(6,110) IG,CONST(IG-NGR1+1)
+        ENDDO
+      ENDIF
+      IF(IPRINT.GT.2) THEN
+        DO IG=1,NG
+          WRITE(6,'(7H GROUP=,I4)') IG
+          DO IBM=1,NMIL
+            WRITE(6,120) IBM,ABS1(IBM,IG)/REAL(AB1TOT),
+     1                   ABS2(IBM,IG)/REAL(AB2TOT)
+          ENDDO
+        ENDDO
+      ENDIF
+*----
+*  STORE INFORMATION ON L_OPTIMIZE OBJECT
+*----
+      CALL LCMPUT(IPGRAD,'FOBJ-CST-VAL',NFUNC,4,FF)
+      IF(LNO) GO TO 10
+*----
+*  COMPUTE THE GRADIENT MATRIX OF THE RMS FUNCTIONAL
+*----
+      ALLOCATE(SUNK(NUN))
+      JPGPT=LCMLID(IPGPT,'ASOUR',NFUNC)
+      IFUNC=0
+      DO IG=NGR1,NGR2
+        DO IBM=1,NMIL
+          ABS2M=MAX(EPS*AB2TOT,DBLE(ABS2(IBM,IG)))
+          SOUTOT=AB2TOT/AB1TOT/ABS2M
+          SOUT2=ABS1(IBM,IG)/AB1TOT
+          IFUNC=IFUNC+1
+          KPGPT=LCMLIL(JPGPT,IFUNC,NG)
+          DO JG=1,NG
+            SUNK(:NUN)=0.0
+            DO IR=1,NREG
+              IUNK=KEYFLX(IR)
+              IF(IUNK.EQ.0) CYCLE
+              JBM=MATCOD(IR)
+              IF(JBM.EQ.0) CYCLE
+              SA=SIGA(JBM,JG)
+              SOUT1=0.0D0
+              IF((IG.EQ.JG).AND.(IBM.EQ.JBM)) SOUT1=1.0D0
+              SUNK(IUNK)=REAL(SOUTOT*VOL(IR)*SA*(SOUT1-SOUT2))
+            ENDDO
+            CALL LCMPDL(KPGPT,JG,NUN,2,SUNK)
+          ENDDO
+        ENDDO
+        IF(NALBP.GT.0) THEN
+          IFUNC=IFUNC+1
+          OUT2M=MAX(EPSL*FI2TOT,DBLE(OUTG2(IG)))
+          SOUTOT=SQRT(WEI)*FI2TOT/FI1TOT/OUT2M
+          SOUT2=OUTG1(IG)/FI1TOT
+          KPGPT=LCMLIL(JPGPT,IFUNC,NG)
+          DO JG=1,NG
+            SUNK(:NUN)=0.0
+            DO IR=1,NREG
+              IUNK=KEYFLX(IR)
+              IF(IUNK.EQ.0) CYCLE
+              JBM=MATCOD(IR)
+              IF(JBM.EQ.0) CYCLE
+              SA=SIGA(JBM,JG)
+              SF=SIGF(JBM,JG)
+              SOUT1=0.0D0
+              IF(IG.EQ.JG) SOUT1=1.0D0
+              SUNK(IUNK)=REAL(SOUTOT*VOL(IR)*(SA*SOUT1-SF*SOUT2))
+            ENDDO
+            IF(IG.EQ.JG) THEN
+              DO IUNK=1,NUN
+                SOUT1=GAMMA(IUNK,IG)
+                SUNK(IUNK)=SUNK(IUNK)+REAL(SOUTOT*SOUT1)
+              ENDDO
+            ENDIF
+            CALL LCMPDL(KPGPT,JG,NUN,2,SUNK)
+          ENDDO
+        ENDIF
+        IFUNC=IFUNC+1
+        KPGPT=LCMLIL(JPGPT,IFUNC,NG)
+        SUNK(:NUN)=0.0
+        DO JG=1,NG
+          CALL LCMPDL(KPGPT,JG,NUN,2,SUNK)
+        ENDDO
+      ENDDO
+*----
+*  CHECK SOURCE ORTHOGONALITY
+*----
+      ALLOCATE(FLUX(NUN))
+      JPFLX=LCMGID(IPFLX,'FLUX')
+      DO IFUNC=1,NFUNC
+        KPGPT=LCMGIL(JPGPT,IFUNC)
+        AIL=0.0D0
+        BIL=0.0D0
+        DO IG=1,NG
+          CALL LCMGDL(KPGPT,IG,SUNK)
+          CALL LCMGDL(JPFLX,IG,FLUX)
+          DO IUNK=1,NUN
+            GAZ=FLUX(IUNK)*SUNK(IUNK)
+            DAZ=FLUX(IUNK)**2
+            AIL=AIL+GAZ
+            BIL=BIL+DAZ
+          ENDDO
+        ENDDO
+        DSUM=ABS(AIL)/ABS(BIL)/REAL(NUN)
+        IF(IPRINT.GT.3) THEN
+          WRITE(6,'(/21H DRENOU: DOT PRODUCT=,1P,E11.4,11H COMPONENT=,
+     1    I5)') DSUM,IFUNC
+        ENDIF
+        IF(ABS(DSUM).GT.1.0E-4) THEN
+          WRITE(HSMG,'(36HDRENOU: NON ORTHOGONAL SOURCE (DSUM=,1P,E11.3,
+     1    26H) FOR INDIVIDUAL COMPONENT,I5,1H.)') DSUM,IFUNC
+          CALL XABORT(HSMG)
+        ENDIF
+      ENDDO
+      DEALLOCATE(FLUX,SUNK)
+*----
+*  COMPUTE THE DIRECT GRADIENT MATRIX
+*----
+      IFUNC=0
+      DFF(:NPERT,:NFUNC)=0.0D0
+      DO IG=NGR1,NGR2
+        DSUM=0.0D0
+        DO IBM=1,NMIL
+          DSUM=DSUM+PHI2(IBM,IG)
+        ENDDO
+        DO IBM=1,NMIL
+          ABS2M=MAX(EPS*AB2TOT,DBLE(ABS2(IBM,IG)))
+          SOUTOT=ABS1(IBM,IG)*AB2TOT/AB1TOT/ABS2M
+          IFUNC=IFUNC+1
+          IPERT=0
+          DO JG=NGR1,NGR2
+            DO JBM=1,NMIL
+              IPERT=IPERT+1
+              IF((IG.EQ.JG).AND.(IBM.EQ.JBM)) THEN
+                DFF(IPERT,IFUNC)=DFF(IPERT,IFUNC)+SOUTOT/VARV(IPERT)
+              ENDIF
+              DFF(IPERT,IFUNC)=DFF(IPERT,IFUNC)-SOUTOT*ABS1(JBM,JG)/
+     >        AB1TOT/VARV(IPERT)
+            ENDDO
+            IF(NALBP.GT.0) IPERT=IPERT+1
+          ENDDO
+        ENDDO
+        IF(NALBP.GT.0) THEN
+          IFUNC=IFUNC+1
+          IPERT=0
+          OUT2M=MAX(EPSL*FI2TOT,DBLE(OUTG2(IG)))
+          SOUTOT=SQRT(WEI)*FI2TOT/FI1TOT/OUT2M
+          DO JG=NGR1,NGR2
+            DO JBM=1,NMIL
+              IPERT=IPERT+1
+              IF(IG.EQ.JG) THEN
+                DFF(IPERT,IFUNC)=DFF(IPERT,IFUNC)+SOUTOT*ABS1(JBM,JG)/
+     >          VARV(IPERT)
+              ENDIF
+              DFF(IPERT,IFUNC)=DFF(IPERT,IFUNC)-SOUTOT*OUTG1(IG)*
+     >        SUM(LHS1(JBM,:NG,JG))/FI1TOT/VARV(IPERT)
+            ENDDO
+            IPERT=IPERT+1
+          ENDDO
+        ENDIF
+        IFUNC=IFUNC+1
+        IPERT=0
+        DO JG=NGR1,NGR2
+          DO JBM=1,NMIL
+            IPERT=IPERT+1
+            IF(IG.EQ.JG) THEN
+              DFF(IPERT,IFUNC)=DFF(IPERT,IFUNC)-PHI2(JBM,IG)/(DSUM*
+     >        VARV(IPERT)**2)
+            ENDIF
+          ENDDO
+          IF(NALBP.GT.0) IPERT=IPERT+1
+        ENDDO
+      ENDDO
+      CALL LCMPUT(IPGRAD,'GRADIENT-DIR',NPERT*NFUNC,4,DFF)
+*----
+*  MODIFY STATE VECTOR OF OPTIMIZE OBJECT
+*----
+   10 CALL LCMGET(IPGRAD,'STATE-VECTOR',ISTATE)
+      ISTATE(2)=NFUNC-1
+      ISTATE(8)=4
+      CALL LCMPUT(IPGRAD,'STATE-VECTOR',NSTATE,1,ISTATE)
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(DFF,FF)
+      DEALLOCATE(VARV,SIGF,SIGA,OUTG2R,OUTG2,OUTG1,GAMMA,RHS,IREL,CONST,
+     1 LHS2,RHS2,LHS1,RHS1,ABS2,ABS1,PHI2,PHI1)
+      RETURN
+*
+  100 FORMAT(/40H DRENOU: RMS ERROR ON RATE DISTRIBUTION=,1P,2E11.4)
+  110 FORMAT(23H DRENOU:    CONSTRAINT(,I4,2H)=,1P,E11.4)
+  120 FORMAT(5X,16HABSORPTION RATE(,I4,2H)=,1P,2E12.4)
+  130 FORMAT(5X,6HGROUP=,I4,9H LEAKAGE=,1P,2E12.4)
+      END
diff --git a/Donjon/src/DRESOU.f b/Donjon/src/DRESOU.f
new file mode 100644
index 0000000..e82d4e3
--- /dev/null
+++ b/Donjon/src/DRESOU.f
@@ -0,0 +1,167 @@
+*DECK DRESOU
+      SUBROUTINE DRESOU(IPRINT,IPGPT,IPMAC1,IPMAC2,IPFLX,IPGRAD,NG,NREG,
+     1 NMIL,NUN,MATCOD,KEYFLX,VOL,LNO,RMSD)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute the GPT sources corresponding to the gradient of the RMS power
+* distribution. Case with no direct effect.
+*
+*Copyright:
+* Copyright (C) 2012 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPRINT  print parameter
+* IPGPT   pointer to the L_GPT data structure.
+* IPMAC1  pointer to the actual macrolib structure.
+* IPMAC2  pointer to the reference macrolib structure.
+* IPFLX   pointer to the multigroup flux.
+* IPGRAD  pointer to the L_OPTIMIZE object.
+* NG      number of energy groups.
+* NREG    number of regions.
+* NMIL    number of material mixtures.
+* NUN     number of unknowns per energy group.
+* MATCOD  material mixture indices per region.
+* KEYFLX  position of averaged fluxes in unknown vector.
+* VOL     volumes.
+* LNO     flag set to .true. to exit after calculation of RMS.
+*
+*Parameters: output
+* RMSD    RMS error on power distribution.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPGPT,IPMAC1,IPMAC2,IPFLX,IPGRAD
+      INTEGER IPRINT,NG,NREG,NMIL,NUN,MATCOD(NREG),KEYFLX(NREG)
+      REAL VOL(NREG)
+      DOUBLE PRECISION RMSD
+      LOGICAL LNO
+*----
+*  LOCAL VARIABLES
+*----
+      TYPE(C_PTR) JPMAC1,JPMAC2,KPMAC1,KPMAC2,JPFLX,JPGPT,KPGPT
+      DOUBLE PRECISION SOUT2,SOUTOT,PW1TOT,PW2TOT,DSUM,AIL,BIL
+      REAL, ALLOCATABLE, DIMENSION(:) :: POW1,H1,F1,POW2,H2,F2,SUNK,
+     1 FLUX
+      CHARACTER HSMG*131
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(POW1(NMIL),H1(NMIL),F1(NMIL),POW2(NMIL),H2(NMIL),
+     1 F2(NMIL))
+*----
+*  COMPUTE THE ACTUAL AND REFERENCE POWER DISTRIBUTION
+*----
+      POW1(:NMIL)=0.0
+      POW2(:NMIL)=0.0
+      JPMAC1=LCMGID(IPMAC1,'GROUP')
+      JPMAC2=LCMGID(IPMAC2,'GROUP')
+      DO IG=1,NG
+         KPMAC1=LCMGIL(JPMAC1,IG)
+         KPMAC2=LCMGIL(JPMAC2,IG)
+         CALL LCMLEN(KPMAC1,'FLUX-INTG',ILG,ITYLCM)
+         IF(ILG.EQ.0) CALL XABORT('DRESOU: MISSING ACTUAL FLUX.')
+         CALL LCMLEN(KPMAC2,'FLUX-INTG',ILG,ITYLCM)
+         IF(ILG.EQ.0) CALL XABORT('DRESOU: MISSING REFERENCE FLUX.')
+         CALL LCMLEN(KPMAC1,'H-FACTOR',ILG,ITYLCM)
+         IF(ILG.EQ.0) CALL XABORT('DRESOU: MISSING ACTUAL H-FACTOR.')
+         CALL LCMLEN(KPMAC2,'H-FACTOR',ILG,ITYLCM)
+         IF(ILG.EQ.0) CALL XABORT('DRESOU: MISSING REFERENCE H-FACTOR.')
+         CALL LCMGET(KPMAC1,'FLUX-INTG',F1)
+         CALL LCMGET(KPMAC2,'FLUX-INTG',F2)
+         CALL LCMGET(KPMAC1,'H-FACTOR',H1)
+         CALL LCMGET(KPMAC2,'H-FACTOR',H2)
+         DO IBM=1,NMIL
+            POW1(IBM)=POW1(IBM)+F1(IBM)*H1(IBM)
+            POW2(IBM)=POW2(IBM)+F2(IBM)*H2(IBM)
+         ENDDO
+      ENDDO
+*----
+*  COMPUTE THE RMS FUNCTIONAL
+*----
+      PW1TOT=0.0D0
+      PW2TOT=0.0D0
+      DO IBM=1,NMIL
+         PW1TOT=PW1TOT+POW1(IBM)
+         PW2TOT=PW2TOT+POW2(IBM)
+      ENDDO
+      RMSD=0.0D0
+      DO IBM=1,NMIL
+         RMSD=RMSD+(POW1(IBM)/PW1TOT-POW2(IBM)/PW2TOT)**2
+      ENDDO
+      CALL LCMPUT(IPGRAD,'FOBJ-CST-VAL',1,4,RMSD)
+      IF(IPRINT.GT.0) WRITE(6,100) RMS
+      IF(LNO) GO TO 10
+*----
+*  COMPUTE THE GRADIENT OF THE RMS FUNCTIONAL
+*----
+      ALLOCATE(SUNK(NUN))
+      JPFLX=LCMGID(IPFLX,'FLUX')
+      JPGPT=LCMLID(IPGPT,'ASOUR',1)
+      KPGPT=LCMLIL(JPGPT,1,NG)
+      DO IG=1,NG
+         SUNK(:NUN)=0.0
+         KPMAC1=LCMGIL(JPMAC1,IG)
+         CALL LCMGET(KPMAC1,'H-FACTOR',H1)
+         DO IR=1,NREG
+            IUNK=KEYFLX(IR)
+            IF(IUNK.EQ.0) CYCLE
+            IBM=MATCOD(IR)
+            IF(IBM.EQ.0) CYCLE
+            SOUT2=0.0D0
+            DO JBM=1,NMIL
+              SOUTOT=0.0D0
+              IF(IBM.EQ.JBM) SOUTOT=1.0D0
+              SOUTOT=SOUTOT-POW1(JBM)/PW1TOT
+              SOUT2=SOUT2+SOUTOT*(POW1(JBM)/PW1TOT-POW2(JBM)/PW2TOT)
+            ENDDO
+            SUNK(IUNK)=2.0*VOL(IR)*H1(IBM)*REAL(SOUT2/PW1TOT)
+         ENDDO
+         CALL LCMPDL(KPGPT,IG,NUN,2,SUNK)
+      ENDDO
+*----
+*  CHECK SOURCE ORTHOGONALITY
+*----
+      ALLOCATE(FLUX(NUN))
+      AIL=0.0D0
+      BIL=0.0D0
+      DO IG=1,NG
+        CALL LCMGDL(KPGPT,IG,SUNK)
+        CALL LCMGDL(JPFLX,IG,FLUX)
+        DO IUNK=1,NUN
+          GAZ=FLUX(IUNK)*SUNK(IUNK)
+          DAZ=FLUX(IUNK)**2
+          AIL=AIL+GAZ
+          BIL=BIL+DAZ
+        ENDDO
+      ENDDO
+      DSUM=ABS(AIL)/ABS(BIL)/REAL(NUN)
+      IF(IPRINT.GT.0) THEN
+        WRITE(6,'(/21H DRESOU: DOT PRODUCT=,1P,E11.4)') DSUM
+      ENDIF
+      IF(ABS(DSUM).GT.1.0E-5) THEN
+        WRITE(HSMG,'(36HDRESOU: NON ORTHOGONAL SOURCE (DSUM=,1P,E11.3,
+     1  2H).)') DSUM
+        CALL XABORT(HSMG)
+      ENDIF
+      DEALLOCATE(FLUX,SUNK)
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+   10 DEALLOCATE(F2,H2,POW2,F1,H1,POW1)
+      RETURN
+*
+  100 FORMAT(/41H DRESOU: RMS ERROR ON POWER DISTRIBUTION=,1P,E11.4)
+      END
diff --git a/Donjon/src/DSET.f b/Donjon/src/DSET.f
new file mode 100644
index 0000000..7c30e46
--- /dev/null
+++ b/Donjon/src/DSET.f
@@ -0,0 +1,165 @@
+*DECK DSET
+      SUBROUTINE DSET(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Set new parameters for the user-selected devices and/or for the
+* groups of devices.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(NSTATE=40,IOUT=6)
+      INTEGER ISTATE(NSTATE),RGRP
+      DOUBLE PRECISION DFLOT
+      CHARACTER TEXT*12,HSIGN*12
+      LOGICAL LROD
+      TYPE(C_PTR) IPDEV
+*----
+*  PARAMETER VALIDATION
+*----
+      IF(NENTRY.GT.1) CALL XABORT('@DSET: ONE PARAMETER ALLOWED.')
+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('@DSET:'
+     1 //' LCM OBJECT EXPECTED AT LHS.')
+      CALL LCMGTC(KENTRY(1),'SIGNATURE',12,HSIGN)
+      IF(HSIGN.NE.'L_DEVICE') THEN
+        TEXT=HENTRY(1)
+        CALL XABORT('@DSET: SIGNATURE OF '//TEXT//' IS '//HSIGN//
+     1  '. L_DEVICE EXPECTED.')
+      ENDIF
+      IF(JENTRY(1).NE.1) CALL XABORT('@DSET: MODIFICATION MODE EX'
+     1 //'PECTED FOR L_DEVICE.')
+      IPDEV=KENTRY(1)
+*----
+*  RECOVER INFORMATION
+*----
+      CALL LCMGET(IPDEV,'STATE-VECTOR',ISTATE)
+      IGEO=ISTATE(1)
+      IF(IGEO.NE.7) CALL XABORT('@DSET: ONLY 3D-CARTESIAN GEOMETRY ALL'
+     1 //'OWED.')
+      NROD=ISTATE(2)
+      RGRP=ISTATE(3)
+      NLZC=ISTATE(4)
+      LGRP=ISTATE(5)
+      IMODE=ISTATE(6)
+      IF((IMODE.EQ.0).AND.(NROD.GT.0)) CALL XABORT('@DSET: IMODE NOT S'
+     1 //'ET.')
+*     READ PRINTING INDEX
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3) CALL XABORT('@DSET: CHARACTER DATA EXPECTED.')
+      IF(TEXT.NE.'EDIT') CALL XABORT('@DSET: KEYWORD EDIT EXPECTED.')
+      CALL REDGET(ITYP,IMPX,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.1) CALL XABORT('@DSET: INTEGER FOR EDIT EXPECTED.')
+      NDEV=0
+      NGRP=0
+   10 NDEV=NDEV+1
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+*----
+*  ROD OPTION
+*----
+      IF(TEXT.EQ.'ROD') THEN
+        CALL REDGET(ITYP,ID,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1) CALL XABORT('@DSET: INTEGER ROD-ID NUMB'
+     1   //'ER EXPECTED.')
+        IF((ID.GT.NROD).OR.(ID.EQ.0)) THEN
+          WRITE(IOUT,*)'@DSET: READ CURRENT ROD-ID #',ID
+          CALL XABORT('@DSET: WRONG ROD-ID NUMBER.')
+        ENDIF
+        IF(IMPX.GT.0) WRITE(IOUT,1000)ID
+        LROD=.TRUE.
+        CALL DSET1D(IPDEV,IMODE,ID,LROD,IMPX)
+*----
+*  LZC OPTION
+*----
+      ELSEIF(TEXT.EQ.'LZC') THEN
+        CALL REDGET(ITYP,ID,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@DSET: INTEGER LZC-ID NUMB'
+     1   //'ER EXPECTED.')
+        IF((ID.GT.NLZC).OR.(ID.EQ.0)) THEN
+          WRITE(IOUT,*)'@DSET: READ CURRENT LZC-ID #',ID
+          CALL XABORT('@DSET: WRONG LZC-ID NUMBER.')
+        ENDIF
+        IF(IMPX.GT.0) WRITE(IOUT,1001)ID
+        LROD=.FALSE.
+        CALL DSET1D(IPDEV,IMODE,ID,LROD,IMPX)
+*----
+*  ROD-GROUP OPTION
+*----
+      ELSEIF(TEXT.EQ.'ROD-GROUP') THEN
+        CALL REDGET(ITYP,IGRP,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@DSET: INTEGER GROUP-ID NUM'
+     1   //'BER EXPECTED.')
+        IF((IGRP.GT.RGRP).OR.(IGRP.LE.0)) THEN
+          WRITE(IOUT,*)'@DSET: READ CURRENT GROUP-ID #',IGRP
+          CALL XABORT('@DSET: WRONG ROD GROUP-ID NUMBER.')
+        ENDIF
+        IF(IMPX.GT.0) WRITE(IOUT,1002)IGRP
+        LROD=.TRUE.
+        CALL DSETGR(IPDEV,IMODE,IGRP,NDGR,LROD,IMPX)
+        NDEV=NDEV+NDGR-1
+        NGRP=NGRP+1
+*----
+*  LZC-GROUP OPTION
+*----
+      ELSEIF(TEXT.EQ.'LZC-GROUP') THEN
+        CALL REDGET(ITYP,IGRP,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@DSET: INTEGER GROUP-ID NUM'
+     1   //'BER EXPECTED.')
+        IF((IGRP.GT.LGRP).OR.(IGRP.LE.0)) THEN
+          WRITE(IOUT,*)'@DSET: READ CURRENT GROUP-ID #',IGRP
+          CALL XABORT('@DSET: WRONG LZC GROUP-ID NUMBER.')
+        ENDIF
+        IF(IMPX.GT.0) WRITE(IOUT,1003)IGRP
+        LROD=.FALSE.
+        CALL DSETGR(IPDEV,IMODE,IGRP,NDGR,LROD,IMPX)
+        NDEV=NDEV+NDGR-1
+        NGRP=NGRP+1
+*
+      ELSEIF(TEXT.EQ.';') THEN
+        GOTO 20
+      ELSE
+        CALL XABORT('@DSET: WRONG KEYWORD '//TEXT)
+      ENDIF
+      GOTO 10
+   20 IF(IMPX.GT.0) WRITE(IOUT,1004)NGRP,NDEV-1
+      IF(IMPX.GT.4) CALL LCMLIB(IPDEV)
+      RETURN
+*
+ 1000 FORMAT(/5X,'DSET: ** SETING PARAMETERS FOR ROD #',I3.3)
+ 1001 FORMAT(/5X,'DSET: ** SETING PARAMETERS FOR LZC #',I2.2)
+ 1002 FORMAT(/5X,'DSET: ** SETING PARAMETERS FOR ROD-GROUP #',I2.2)
+ 1003 FORMAT(/5X,'DSET: ** SETING PARAMETERS FOR LZC-GROUP #',I2.2)
+ 1004 FORMAT(/5X,'--------------------------------------'/
+     1        5X,'TOTAL NUMBER OF UPDATED GROUPS  :',I4/
+     2        5X,'TOTAL NUMBER OF UPDATED DEVICES :',I4/)
+      END
diff --git a/Donjon/src/DSET1D.f b/Donjon/src/DSET1D.f
new file mode 100644
index 0000000..80e5727
--- /dev/null
+++ b/Donjon/src/DSET1D.f
@@ -0,0 +1,245 @@
+*DECK DSET1D
+      SUBROUTINE DSET1D(IPDEV,IMODE,ID,LROD,IMPX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Modify some parameters for a specified device.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki
+*
+*Parameters: input
+* IPDEV  pointer to device information.
+* IMODE  type of displacement: =1 for FADE; =2 for MOVE (DONJON3-type
+*        movement).
+* ID     identification number of a specified device.
+* LROD   flag for the device type:
+*         =.true. if rod-type device; =.false. if lzc-type device.
+* IMPX   printing index (=0 for no print).
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPDEV
+      INTEGER IMODE,ID,IMPX
+      LOGICAL LROD
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(IOUT=6,MAXPRT=10)
+      REAL RODPOS(6,MAXPRT),MAXPOS(6,MAXPRT),EMTPOS(6),FULPOS(6),
+     1 LENG(2),LVOLD,LVNEW,LIMIT(6)
+      DOUBLE PRECISION DFLOT
+      CHARACTER TEXT*12,NXSEQ*12
+      TYPE(C_PTR) JPDEV,KPDEV
+*----
+*  READ OPTION
+*----
+      ILEVEL=0
+      ISPEED=0
+      ISTIME=0
+   10 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('@DSET1D: CHARACTER DATA EXPECTED.')
+      IF(TEXT.EQ.'LEVEL')THEN
+        IF(ILEVEL.EQ.1)CALL XABORT('@DSET1D: LEVEL ALREADY DEFINED.')
+        CALL REDGET(ITYP,NITMA,LVNEW,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@DSET1D: REAL FOR LEVEL EXPECTED.')
+        IF(LVNEW.GT.1.)CALL XABORT('@DSET1D: WRONG LEVEL VALUE > 1.')
+        IF(LVNEW.LT.0.)CALL XABORT('@DSET1D: WRONG LEVEL VALUE < 0.')
+        ILEVEL=1
+      ELSEIF(TEXT.EQ.'SPEED')THEN
+        IF(ISPEED.EQ.1)CALL XABORT('@DSET1D: SPEED ALREADY DEFINED.')
+        CALL REDGET(ITYP,NITMA,SPNEW,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@DSET1D: REAL FOR SPEED EXPECTED.')
+        IF(SPNEW.LT.0.)CALL XABORT('@DSET1D: WRONG SPEED VALUE < 0.')
+        ISPEED=1
+      ELSEIF(TEXT.EQ.'TIME')THEN
+        IF(ISTIME.EQ.1)CALL XABORT('@DSET1D: TIME ALREADY DEFINED.')
+        CALL REDGET(ITYP,NITMA,TMNEW,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@DSET1D: REAL FOR TIME EXPECTED.')
+        IF(TMNEW.LT.0.)CALL XABORT('@DSET1D: WRONG TIME VALUE < 0.')
+        ISTIME=1
+      ELSEIF(TEXT.EQ.'END')THEN
+        GOTO 20
+      ELSE
+        WRITE(IOUT,*)'@DSET1D: INVALID KEYWORD ',TEXT
+        CALL XABORT('@DSET1D: OPTION OR END EXPECTED.')
+      ENDIF
+      GOTO 10
+*----
+*  RECOVER DEVICE
+*----
+   20 IF(LROD)THEN
+        CALL LCMGET(IPDEV,'CORE-LIMITS',LIMIT)
+        JPDEV=LCMGID(IPDEV,'DEV_ROD')
+        KPDEV=LCMGIL(JPDEV,ID)
+        CALL LCMGTC(KPDEV,'ROD-NAME',12,TEXT)
+        IF(IMPX.GT.0) WRITE(IOUT,1011) ID,TEXT
+      ELSE
+        JPDEV=LCMGID(IPDEV,'DEV_LZC')
+        KPDEV=LCMGIL(JPDEV,ID)
+        IF(IMPX.GT.0) WRITE(IOUT,1012) ID
+      ENDIF
+      IF((ILEVEL.NE.0).AND.LROD) THEN
+*----
+*  UPDATE ROD POSITION
+*----
+*       RECOVER OLD ROD PARAMETERS
+        CALL LCMGET(KPDEV,'ROD-PARTS',NPART)
+        CALL LCMGET(KPDEV,'LENGTH',LENG)
+        CALL LCMGET(KPDEV,'AXIS',IAXIS)
+        CALL LCMGET(KPDEV,'FROM',ITOP)
+        CALL LCMLEN(KPDEV,'LEVEL',ILONG,ITYLCM)
+        CALL LCMGTC(KPDEV,'ROD-NAME',12,NXSEQ)
+        IF((ILONG.GT.0).AND.(IMPX.GT.2)) THEN
+          CALL LCMGET(KPDEV,'ROD-POS',RODPOS)
+          CALL LCMGET(KPDEV,'LEVEL',LVOLD)
+          WRITE(IOUT,1000) LVOLD
+          DO 30 IPART=1,NPART
+          WRITE(IOUT,1001) IPART,RODPOS(1,IPART),RODPOS(3,IPART),
+     1           RODPOS(5,IPART),RODPOS(2,IPART),RODPOS(4,IPART),
+     2           RODPOS(6,IPART)
+   30     CONTINUE
+        ENDIF
+*       MODIFY ROD POSITION
+        IF(IMPX.GT.1) WRITE(IOUT,1002) LVNEW
+        IF(IMODE.EQ.1) THEN
+*         FADING ROD
+          DELH=LVNEW*(LENG(2)-LENG(1))
+        ELSE IF(IMODE.EQ.2) THEN
+*         MOVING ROD
+          IF(ITOP.EQ.-1) THEN
+            DELH=LVNEW*(LENG(2)-LIMIT(1))+LIMIT(1)
+          ELSE IF(ITOP.EQ.1) THEN
+            DELH=LIMIT(2)-LVNEW*(LIMIT(2)-LENG(1))
+          ENDIF
+          DELH=MIN(LIMIT(2),MAX(LIMIT(1),DELH))
+          IF(IMPX.GT.3) THEN
+            WRITE(IOUT,*) '    ADJ ',NXSEQ,' LEVEL ',LVNEW*100.,
+     1                    '% OF INSERTION'
+            WRITE(IOUT,*) '    NEW POSITION (L_sup)= ',DELH
+          ENDIF
+        ENDIF
+        CALL LCMGET(KPDEV,'MAX-POS',RODPOS)
+        CALL MOVCHK(IMPX,IMODE,NPART,IAXIS,ITOP,DELH,LENG,RODPOS)
+*       STORE NEW PARAMETERS
+        CALL LCMPUT(KPDEV,'ROD-POS',6*NPART,2,RODPOS)
+        CALL LCMPUT(KPDEV,'LEVEL',1,2,LVNEW)
+*----
+*  UPDATE LZC POSITION
+*----
+      ELSE IF(ILEVEL.NE.0) THEN
+*       RECOVER OLD LZC PARAMETERS
+        CALL LCMGET(KPDEV,'MAX-POS',MAXPOS)
+        CALL LCMGET(KPDEV,'EMPTY-POS',EMTPOS)
+        CALL LCMGET(KPDEV,'FULL-POS',FULPOS)
+        CALL LCMGET(KPDEV,'HEIGHT',HEIGHT)
+        CALL LCMGET(KPDEV,'LEVEL',LVOLD)
+        CALL LCMGET(KPDEV,'AXIS',IAXIS)
+        IF(IMPX.GT.1) WRITE(IOUT,1005) LVOLD,EMTPOS(1),EMTPOS(3),
+     1         EMTPOS(5),EMTPOS(2),EMTPOS(4),EMTPOS(6),FULPOS(1),
+     2         FULPOS(3),FULPOS(5),FULPOS(2),FULPOS(4),FULPOS(6)
+*       MODIFY LZC POSITION
+        DELH=LVNEW*HEIGHT
+        IF(IAXIS.EQ.1) THEN
+          FULPOS(1)=MAXPOS(2,1)-DELH
+          EMTPOS(2)=FULPOS(1)
+        ELSEIF(IAXIS.EQ.2) THEN
+          FULPOS(3)=MAXPOS(4,1)-DELH
+          EMTPOS(4)=FULPOS(3)
+        ELSEIF(IAXIS.EQ.3) THEN
+          FULPOS(5)=MAXPOS(6,1)-DELH
+          EMTPOS(6)=FULPOS(5)
+        ENDIF
+*       STORE NEW PARAMETERS
+        CALL LCMPUT(KPDEV,'LEVEL',1,2,LVNEW)
+        CALL LCMPUT(KPDEV,'EMPTY-POS',6,2,EMTPOS)
+        CALL LCMPUT(KPDEV,'FULL-POS',6,2,FULPOS)
+        IF(IMPX.GT.1) WRITE(IOUT,1006) LVNEW,EMTPOS(1),EMTPOS(3),
+     1         EMTPOS(5),EMTPOS(2),EMTPOS(4),EMTPOS(6),FULPOS(1),
+     2         FULPOS(3),FULPOS(5),FULPOS(2),FULPOS(4),FULPOS(6)
+      ENDIF
+*----
+*  UPDATE SPEED
+*----
+      IF((ISPEED.NE.0).AND.LROD) THEN
+        CALL LCMLEN(KPDEV,'SPEED',ILONG,ITYLCM)
+        IF(ILONG.GT.0) THEN
+          CALL LCMGET(KPDEV,'SPEED',SPOLD)
+          IF(IMPX.GE.2) WRITE(IOUT,1007) SPOLD,SPNEW
+        ELSE
+          IF(IMPX.GE.2) WRITE(IOUT,1008) SPNEW
+        ENDIF
+        CALL LCMPUT(KPDEV,'SPEED',1,2,SPNEW)
+      ELSE IF(ISPEED.NE.0) THEN
+        CALL LCMLEN(KPDEV,'RATE',ILONG,ITYLCM)
+        IF(ILONG.GT.0) THEN
+          CALL LCMGET(KPDEV,'RATE',SPOLD)
+          IF(IMPX.GE.2) WRITE(IOUT,1007) SPOLD,SPNEW
+        ELSE
+          IF(IMPX.GE.2) WRITE(IOUT,1008) SPNEW
+        ENDIF
+        CALL LCMPUT(KPDEV,'RATE',1,2,SPNEW)
+      ENDIF
+*----
+*  UPDATE TIME
+*----
+      IF(ISTIME.NE.0) THEN
+        CALL LCMLEN(KPDEV,'TIME',ILONG,ITYLCM)
+        IF(ILONG.GT.0) THEN
+          CALL LCMGET(KPDEV,'TIME',TMOLD)
+          IF(IMPX.GE.2) WRITE(IOUT,1009) TMOLD,TMNEW
+        ELSE
+          IF(IMPX.GE.2) WRITE(IOUT,1010) TMNEW
+        ENDIF
+        CALL LCMPUT(KPDEV,'TIME',1,2,TMNEW)
+      ENDIF
+      RETURN
+*
+ 1000 FORMAT(
+     1 /5X,'DSET1D: PREVIOUS INSERTION LEVEL =',F8.4)
+ 1001 FORMAT(
+     1 /5X,'DSET1D: PART =',I5/
+     2  5X,'PREVIOUS ROD POSITION :'/
+     3  5X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4/
+     4  5X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4)
+ 1002 FORMAT(
+     1 /5X,'DSET1D: NEW INSERTION LEVEL =',F8.4)
+ 1005 FORMAT(
+     1 /5X,'PREVIOUS LZC LEVEL =',F8.4/
+     2  5X,'PREVIOUS EMPTY-PART POSITION :'/
+     3  5X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4/
+     4  5X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4/
+     5  5X,'PREVIOUS FULL-PART POSITION :'/
+     6  5X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4/
+     7  5X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4/)
+ 1006 FORMAT(
+     1 /5X,'NEW LZC LEVEL =',F8.4/
+     2  5X,'NEW EMPTY-PART POSITION :'/
+     3  5X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4/
+     4  5X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4/
+     5  5X,'NEW FULL-PART POSITION :'/
+     6  5X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4/
+     7  5X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4/)
+ 1007 FORMAT(/5X,'** SETING DEVICE SPEED **',
+     1       /5X,'PREVIOUS SPEED:',F10.4
+     2       /5X,'NEW SPEED:',F10.4/)
+ 1008 FORMAT(/5X,'** SETING DEVICE SPEED **',
+     1       /5X,'PREVIOUS SPEED: (UNDEFINED)'
+     2       /5X,'NEW SPEED:',F10.4/)
+ 1009 FORMAT(/5X,'** SETING DEVICE TIME **',
+     1       /5X,'PREVIOUS TIME:',F10.4
+     2       /5X,'NEW TIME:',F10.4/)
+ 1010 FORMAT(/5X,'** SETING DEVICE TIME **',
+     1       /5X,'PREVIOUS TIME: (UNDEFINED)'
+     2       /5X,'NEW TIME:',F10.4/)
+ 1011 FORMAT(/5X,' =>  ROD #',I3.3,4X,'ROD-NAME:',1X,A)
+ 1012 FORMAT(/5X,' =>  LZC #',I2.2)
+      END
diff --git a/Donjon/src/DSETGR.f b/Donjon/src/DSETGR.f
new file mode 100644
index 0000000..e7aeb9a
--- /dev/null
+++ b/Donjon/src/DSETGR.f
@@ -0,0 +1,273 @@
+*DECK DSETGR
+      SUBROUTINE DSETGR(IPDEV,IMODE,IGRP,NDGR,LROD,IMPX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Modify some parameters for a specified group of devices.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki
+*
+*Parameters: input
+* IPDEV  pointer to device information.
+* IMODE  type of displacement: =1 for FADE; =2 for MOVE (DONJON3-type
+*        movement).
+* IGRP   current group identification number.
+* LROD   flag for the device type:
+*         =.true. if rod-type devices; =.false. if lzc-type devices.
+* IMPX   printing index (=0 for no print).
+*
+*Parameters: output
+* NDGR   number of devices in the group.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPDEV
+      INTEGER IMODE,IGRP,NDGR,IMPX
+      LOGICAL LROD
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(IOUT=6,MAXPRT=10)
+      REAL RODPOS(6,MAXPRT),MAXPOS(6,MAXPRT),EMTPOS(6),FULPOS(6),
+     1 LENG(2),LVOLD,LVNEW,LIMIT(6)
+      DOUBLE PRECISION DFLOT
+      CHARACTER TEXT*12,NXSEQ*12
+      TYPE(C_PTR) JPDEV,KPDEV
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IDEV
+*----
+*  READ OPTION
+*----
+      ILEVEL=0
+      ISPEED=0
+      ISTIME=0
+   10 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('@DSETGR: CHARACTER DATA EXPECTED.')
+      IF(TEXT.EQ.'LEVEL')THEN
+        IF(ILEVEL.EQ.1)CALL XABORT('@DSETGR: LEVEL ALREADY DEFINED.')
+        CALL REDGET(ITYP,NITMA,LVNEW,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@DSETGR: REAL FOR LEVEL EXPECTED.')
+        IF(LVNEW.GT.1.)CALL XABORT('@DSETGR: WRONG LEVEL VALUE > 1.')
+        IF(LVNEW.LT.0.)CALL XABORT('@DSETGR: WRONG LEVEL VALUE < 0.')
+        ILEVEL=1
+      ELSEIF(TEXT.EQ.'SPEED')THEN
+        IF(ISPEED.EQ.1)CALL XABORT('@DSETGR: SPEED ALREADY DEFINED.')
+        CALL REDGET(ITYP,NITMA,SPNEW,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@DSETGR: REAL FOR SPEED EXPECTED.')
+        IF(SPNEW.LT.0.)CALL XABORT('@DSETGR: WRONG SPEED VALUE < 0.')
+        ISPEED=1
+      ELSEIF(TEXT.EQ.'TIME')THEN
+        IF(ISTIME.EQ.1)CALL XABORT('@DSETGR: TIME ALREADY DEFINED.')
+        CALL REDGET(ITYP,NITMA,TMNEW,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@DSETGR: REAL FOR TIME EXPECTED.')
+        IF(TMNEW.LT.0.)CALL XABORT('@DSETGR: WRONG TIME VALUE < 0.')
+        ISTIME=1
+      ELSEIF(TEXT.EQ.'END')THEN
+        GOTO 20
+      ELSE
+        WRITE(IOUT,*)'@DSETGR: INVALID KEYWORD ',TEXT
+        CALL XABORT('@DSETGR: OPTION OR END EXPECTED.')
+      ENDIF
+      GOTO 10
+*----
+*  RECOVER GROUP INFORMATION
+*----
+   20 CALL LCMGET(IPDEV,'CORE-LIMITS',LIMIT)
+      IF(LROD)THEN
+        JPDEV=LCMGID(IPDEV,'ROD_GROUP')
+        KPDEV=LCMGIL(JPDEV,IGRP)
+        CALL LCMGET(KPDEV,'NUM-ROD',NDGR)
+        ALLOCATE(IDEV(NDGR))
+        IDEV(:NDGR)=0
+        CALL LCMGET(KPDEV,'ROD-ID',IDEV)
+      ELSE
+        JPDEV=LCMGID(IPDEV,'LZC_GROUP')
+        KPDEV=LCMGIL(JPDEV,IGRP)
+        CALL LCMGET(KPDEV,'NUM-LZC',NDGR)
+        ALLOCATE(IDEV(NDGR))
+        IDEV(:NDGR)=0
+        CALL LCMGET(KPDEV,'LZC-ID',IDEV)
+      ENDIF
+*----
+*  UPDATE DEVICES
+*----
+      DO 60 I=1,NDGR
+        ID=IDEV(I)
+*       RECOVER ROD
+        IF(LROD)THEN
+          JPDEV=LCMGID(IPDEV,'DEV_ROD')
+          KPDEV=LCMGIL(JPDEV,ID)
+          CALL LCMGTC(KPDEV,'ROD-NAME',12,TEXT)
+          IF(IMPX.GT.0) WRITE(IOUT,1011) ID,TEXT
+        ELSE
+          JPDEV=LCMGID(IPDEV,'DEV_LZC')
+          KPDEV=LCMGIL(JPDEV,ID)
+          IF(IMPX.GT.0) WRITE(IOUT,1012) ID
+        ENDIF
+*----
+*  UPDATE ROD POSITION
+*----
+        IF((ILEVEL.NE.0).AND.LROD) THEN
+*         RECOVER OLD ROD PARAMETERS
+          CALL LCMGET(KPDEV,'ROD-PARTS',NPART)
+          CALL LCMGET(KPDEV,'LENGTH',LENG)
+          CALL LCMGET(KPDEV,'AXIS',IAXIS)
+          CALL LCMGET(KPDEV,'FROM',ITOP)
+          CALL LCMLEN(KPDEV,'LEVEL',ILONG,ITYLCM)
+          CALL LCMGTC(KPDEV,'ROD-NAME',12,NXSEQ)
+          IF((ILONG.GT.0).AND.(IMPX.GT.2)) THEN
+            CALL LCMGET(KPDEV,'ROD-POS',RODPOS)
+            CALL LCMGET(KPDEV,'LEVEL',LVOLD)
+            WRITE(IOUT,1000) LVOLD
+            DO 30 IPART=1,NPART
+            WRITE(IOUT,1001) IPART,RODPOS(1,IPART),RODPOS(3,IPART),
+     1             RODPOS(5,IPART),RODPOS(2,IPART),RODPOS(4,IPART),
+     2             RODPOS(6,IPART)
+   30         CONTINUE
+          ENDIF
+*         MODIFY ROD POSITION
+          IF(IMPX.GT.1) WRITE(IOUT,1002) LVNEW
+          IF(IMODE.EQ.1) THEN
+*           FADING ROD
+            DELH=LVNEW*(LENG(2)-LENG(1))
+          ELSE IF(IMODE.EQ.2) THEN
+*           MOVING ROD
+            IF(ITOP.EQ.-1) THEN
+              DELH=LVNEW*(LENG(2)-LIMIT(1))+LIMIT(1)
+            ELSE IF(ITOP.EQ.1) THEN
+              DELH=LIMIT(2)-LVNEW*(LIMIT(2)-LENG(1))
+            ENDIF
+            DELH=MIN(LIMIT(2),MAX(LIMIT(1),DELH))
+            IF(IMPX.GT.3) THEN
+              WRITE(IOUT,*) '    ADJ ',NXSEQ,' LEVEL ',LVNEW*100.,
+     1                      '% OF INSERTION'
+              WRITE(IOUT,*) '    NEW POSITION (L_sup)= ',DELH
+            ENDIF
+          ENDIF
+          CALL LCMGET(KPDEV,'MAX-POS',RODPOS)
+          CALL MOVCHK(IMPX,IMODE,NPART,IAXIS,ITOP,DELH,LENG,RODPOS)
+*         STORE NEW PARAMETERS
+          CALL LCMPUT(KPDEV,'ROD-POS',6*NPART,2,RODPOS)
+          CALL LCMPUT(KPDEV,'LEVEL',1,2,LVNEW)
+*----
+*  UPDATE LZC POSITION
+*----
+        ELSE IF(ILEVEL.NE.0) THEN
+*         RECOVER OLD LZC PARAMETERS
+          CALL LCMGET(KPDEV,'MAX-POS',MAXPOS)
+          CALL LCMGET(KPDEV,'EMPTY-POS',EMTPOS)
+          CALL LCMGET(KPDEV,'FULL-POS',FULPOS)
+          CALL LCMGET(KPDEV,'HEIGHT',HEIGHT)
+          CALL LCMGET(KPDEV,'LEVEL',LVOLD)
+          CALL LCMGET(KPDEV,'AXIS',IAXIS)
+          IF(IMPX.GT.1) WRITE(IOUT,1005) LVOLD,EMTPOS(1),EMTPOS(3),
+     1           EMTPOS(5),EMTPOS(2),EMTPOS(4),EMTPOS(6),FULPOS(1),
+     2           FULPOS(3),FULPOS(5),FULPOS(2),FULPOS(4),FULPOS(6)
+*         MODIFY LZC POSITION
+          DELH=LVNEW*HEIGHT
+          IF(IAXIS.EQ.1) THEN
+            FULPOS(1)=MAXPOS(2,1)-DELH
+            EMTPOS(2)=FULPOS(1)
+          ELSEIF(IAXIS.EQ.2) THEN
+            FULPOS(3)=MAXPOS(4,1)-DELH
+            EMTPOS(4)=FULPOS(3)
+          ELSEIF(IAXIS.EQ.3) THEN
+            FULPOS(5)=MAXPOS(6,1)-DELH
+            EMTPOS(6)=FULPOS(5)
+          ENDIF
+*         STORE NEW PARAMETERS
+          CALL LCMPUT(KPDEV,'LEVEL',1,2,LVNEW)
+          CALL LCMPUT(KPDEV,'EMPTY-POS',6,2,EMTPOS)
+          CALL LCMPUT(KPDEV,'FULL-POS',6,2,FULPOS)
+          IF(IMPX.GT.1) WRITE(IOUT,1006) LVNEW,EMTPOS(1),EMTPOS(3),
+     1           EMTPOS(5),EMTPOS(2),EMTPOS(4),EMTPOS(6),FULPOS(1),
+     2           FULPOS(3),FULPOS(5),FULPOS(2),FULPOS(4),FULPOS(6)
+        ENDIF
+*----
+*  UPDATE SPEED
+*----
+        IF((ISPEED.NE.0).AND.LROD) THEN
+          CALL LCMLEN(KPDEV,'SPEED',ILONG,ITYLCM)
+          IF(ILONG.GT.0) THEN
+            CALL LCMGET(KPDEV,'SPEED',SPOLD)
+            IF(IMPX.GE.2) WRITE(IOUT,1007) SPOLD,SPNEW
+          ELSE
+            IF(IMPX.GE.2) WRITE(IOUT,1008) SPNEW
+          ENDIF
+          CALL LCMPUT(KPDEV,'SPEED',1,2,SPNEW)
+        ELSE IF(ISPEED.NE.0) THEN
+          CALL LCMLEN(KPDEV,'RATE',ILONG,ITYLCM)
+          IF(ILONG.GT.0) THEN
+            CALL LCMGET(KPDEV,'RATE',SPOLD)
+            IF(IMPX.GE.2) WRITE(IOUT,1007) SPOLD,SPNEW
+          ELSE
+            IF(IMPX.GE.2) WRITE(IOUT,1008) SPNEW
+          ENDIF
+          CALL LCMPUT(KPDEV,'RATE',1,2,SPNEW)
+        ENDIF
+*----
+*  UPDATE TIME
+*----
+        IF(ISTIME.NE.0) THEN
+          CALL LCMLEN(KPDEV,'TIME',ILONG,ITYLCM)
+          IF(ILONG.GT.0) THEN
+            CALL LCMGET(KPDEV,'TIME',TMOLD)
+            IF(IMPX.GE.2) WRITE(IOUT,1009) TMOLD,TMNEW
+          ELSE
+            IF(IMPX.GE.2) WRITE(IOUT,1010) TMNEW
+          ENDIF
+          CALL LCMPUT(KPDEV,'TIME',1,2,TMNEW)
+        ENDIF
+*     PROCEED NEXT ROD
+   60 CONTINUE
+      DEALLOCATE(IDEV)
+      RETURN
+*
+ 1000 FORMAT(
+     1 /5X,'DSETGR: PREVIOUS INSERTION LEVEL =',F8.4)
+ 1001 FORMAT(
+     1 /5X,'DSETGR: PART =',I5/
+     2  5X,'PREVIOUS ROD POSITION :'/
+     3  5X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4/
+     4  5X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4)
+ 1002 FORMAT(
+     1 /5X,'DSETGR: NEW INSERTION LEVEL =',F8.4)
+ 1005 FORMAT(
+     1 /5X,'PREVIOUS LZC LEVEL =',F8.4/
+     2  5X,'PREVIOUS EMPTY-PART POSITION :'/
+     3  5X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4/
+     4  5X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4/
+     5  5X,'PREVIOUS FULL-PART POSITION :'/
+     6  5X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4/
+     7  5X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4/)
+ 1006 FORMAT(
+     1 /5X,'NEW LZC LEVEL =',F8.4/
+     2  5X,'NEW EMPTY-PART POSITION :'/
+     3  5X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4/
+     4  5X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4/
+     5  5X,'NEW FULL-PART POSITION :'/
+     6  5X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4/
+     7  5X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4/)
+ 1007 FORMAT(/5X,'** SETING DEVICE SPEED **',
+     1       /5X,'PREVIOUS SPEED:',F10.4
+     2       /5X,'NEW SPEED:',F10.4/)
+ 1008 FORMAT(/5X,'** SETING DEVICE SPEED **',
+     1       /5X,'PREVIOUS SPEED: (UNDEFINED)'
+     2       /5X,'NEW SPEED:',F10.4/)
+ 1009 FORMAT(/5X,'** SETING DEVICE TIME **',
+     1       /5X,'PREVIOUS TIME:',F10.4
+     2       /5X,'NEW TIME:',F10.4/)
+ 1010 FORMAT(/5X,'** SETING DEVICE TIME **',
+     1       /5X,'PREVIOUS TIME: (UNDEFINED)'
+     2       /5X,'NEW TIME:',F10.4/)
+ 1011 FORMAT(/5X,' =>  ROD #',I3.3,4X,'ROD-NAME:',1X,A)
+ 1012 FORMAT(/5X,' =>  LZC #',I2.2)
+      END
diff --git a/Donjon/src/DSPH.f b/Donjon/src/DSPH.f
new file mode 100644
index 0000000..f52b811
--- /dev/null
+++ b/Donjon/src/DSPH.f
@@ -0,0 +1,544 @@
+*DECK DSPH

+      SUBROUTINE DSPH(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Create a delta Macrolib with respect to a SPH correction.

+*

+*Copyright:

+* Copyright (C) 2017 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* A. Hebert

+*

+*Parameters: input

+* NENTRY  number of data structures transfered to this module.

+* HENTRY  name of the data structures.

+* IENTRY  data structure type where:

+*         IENTRY=1 for LCM memory object;

+*         IENTRY=2 for XSM file;

+*         IENTRY=3 for sequential binary file;

+*         IENTRY=4 for sequential ASCII file.

+* JENTRY  access permission for the data structure where:

+*         JENTRY=0 for a data structure in creation mode;

+*         JENTRY=1 for a data structure in modifications mode;

+*         JENTRY=2 for a data structure in read-only mode.

+* KENTRY  data structure pointer.

+*

+*-----------------------------------------------------------------------

+*

+      USE GANLIB

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      INTEGER NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)

+      CHARACTER HENTRY(NENTRY)*12

+      TYPE(C_PTR) KENTRY(NENTRY)

+*----

+*  LOCAL VARIABLES

+*----

+      PARAMETER(NSTATE=40)

+      CHARACTER HSIGN*12,TEXT2*2,TEXT8*8,TEXT12*12

+      DOUBLE PRECISION DFLOTT

+      INTEGER ISTATE(NSTATE)

+      DOUBLE PRECISION OPTPRR(NSTATE)

+      TYPE(C_PTR) IPOPT,IPNEW,IPOLD,JPNEW,JPOLD,KPNEW,KPOLD,LPNEW,MPNEW

+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IJJ,NJJ,IPOS

+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: IHEDIT

+      REAL, ALLOCATABLE, DIMENSION(:) :: DIFHOM,GAR,PER,GAR1,PER1

+      REAL, ALLOCATABLE, DIMENSION(:,:) :: SPH,GAR2,PER2,ALBP,PALBP

+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: PSIGS

+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: VARV

+*----

+*  PARAMETER VALIDATION

+*----

+      IF(NENTRY.NE.3)CALL XABORT('DSPH: THREE PARAMETERS EXPECTED.')

+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2))CALL XABORT('@DSPH'

+     1 //': LCM OBJECT EXPECTED AT LHS.')

+      IF(JENTRY(1).EQ.0)THEN

+        HSIGN='L_MACROLIB'

+        CALL LCMPTC(KENTRY(1),'SIGNATURE',12,HSIGN)

+      ELSE

+        CALL XABORT('DSPH: EMPTY DELTA MACROLIB EXPECTED AT LHS.')

+      ENDIF

+      IPNEW=KENTRY(1)

+      IF((IENTRY(2).NE.1).AND.(IENTRY(2).NE.2))CALL XABORT('DSPH: LCM '

+     1 //'OBJECT EXPECTED AT LHS.')

+      IF(JENTRY(2).EQ.0)THEN

+        HSIGN='L_OPTIMIZE'

+        CALL LCMPTC(KENTRY(2),'SIGNATURE',12,HSIGN)

+      ELSE IF(JENTRY(2).EQ.1)THEN

+        CALL LCMGTC(KENTRY(2),'SIGNATURE',12,HSIGN)

+        IF(HSIGN.NE.'L_OPTIMIZE')THEN

+          CALL XABORT('DSPH: SIGNATURE OF '//HENTRY(2)//' IS '//HSIGN//

+     1    '. L_OPTIMIZE EXPECTED.')

+        ENDIF

+      ELSE IF(JENTRY(2).EQ.2)THEN

+        CALL XABORT('DSPH: OPTIMIZE OBJECT IN CREATION OR MODIFICATION'

+     1  //' MODE EXPECTED.')

+      ENDIF

+      IPOPT=KENTRY(2)

+      IF((IENTRY(3).NE.1).AND.(IENTRY(3).NE.2))CALL XABORT('DSPH: LCM '

+     1 //'OBJECT EXPECTED AT RHS.')

+      IF(JENTRY(3).NE.2)CALL XABORT('DSPH: MACROLIB IN READ-ONLY MODE '

+     1 //'EXPECTED AT RHS.')

+      CALL LCMGTC(KENTRY(3),'SIGNATURE',12,HSIGN)

+      IF(HSIGN.NE.'L_MACROLIB')THEN

+        CALL XABORT('DSPH: SIGNATURE OF '//HENTRY(3)//' IS '//HSIGN//

+     1  '. L_MACROLIB EXPECTED.')

+      ENDIF

+      IPOLD=KENTRY(3)

+      CALL LCMGET(IPOLD,'STATE-VECTOR',ISTATE)

+      NGRP=ISTATE(1)

+      NMIX=ISTATE(2)

+      NL=ISTATE(3)

+      NIFISS=ISTATE(4)

+      NED=ISTATE(5)

+      NDEL=ISTATE(7)

+      NALBP=ISTATE(8)

+      ILEAKS=ISTATE(9)

+*----

+*  READ THE INPUT DATA

+*----

+      IMPX=1

+      IMC=2

+      NGR1=1

+      NGR2=NGRP

+      NMIXP=NMIX

+   20 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)

+      IF(INDIC.EQ.10) GO TO 30

+      IF(INDIC.NE.3) CALL XABORT('DSPH: CHARACTER DATA EXPECTED(1).')

+      IF(TEXT12.EQ.'EDIT') THEN

+*       READ THE PRINT INDEX.

+        CALL REDGET(INDIC,IMPX,FLOTT,TEXT12,DFLOTT)

+        IF(INDIC.NE.1) CALL XABORT('DSPH: INTEGER DATA EXPECTED(1).')

+      ELSE IF(TEXT12.EQ.'SPH') THEN

+*       READ THE TYPE OF SPH CORRECTION.

+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)

+        IF(INDIC.NE.3) CALL XABORT('DSPH: CHARACTER DATA EXPECTED(2).')

+        IF(TEXT12.EQ.'PN') THEN

+          IMC=1

+        ELSE IF(TEXT12.EQ.'SN') THEN

+          IMC=2

+        ELSE IF(TEXT12.EQ.'ALBEDO') THEN

+          IMC=3

+        ELSE

+          CALL XABORT('DSPH: INVALID TYPE OF SPH CORRECTION.')

+        ENDIF

+      ELSE IF(TEXT12.EQ.'GRPMIN') THEN

+*       READ THE MINIMUM GROUP INDEX.

+        CALL REDGET(INDIC,NGR1,FLOTT,TEXT12,DFLOTT)

+        IF(INDIC.NE.1) CALL XABORT('DSPH: INTEGER DATA EXPECTED(4).')

+        IF((NGR1.LE.0).OR.(NGR1.GT.NGRP)) CALL XABORT('DSPH: INVALID '

+     1  //'VALUE OF GRPMIN.')

+      ELSE IF(TEXT12.EQ.'GRPMAX') THEN

+*       READ THE MAXIMUM GROUP INDEX.

+        CALL REDGET(INDIC,NGR2,FLOTT,TEXT12,DFLOTT)

+        IF(INDIC.NE.1) CALL XABORT('DSPH: INTEGER DATA EXPECTED(5).')

+        IF((NGR2.LT.NGR1).OR.(NGR2.GT.NGRP)) CALL XABORT('DSPH: INVAL'

+     1  //'ID VALUE OF GRPMAX.')

+      ELSE IF(TEXT12.EQ.';') THEN

+        GO TO 30

+      ELSE

+        CALL XABORT('DSPH: '//TEXT12//' IS AN INVALID KEYWORD.')

+      ENDIF

+      GO TO 20

+   30 IF(NGR2.LT.NGR1) CALL XABORT('DSPH: INVALID GROUP INDICES.')

+      NMIXP=NMIX

+      IF(IMC.EQ.3) NMIXP=0

+      NPERT=(NMIXP+NALBP)*(NGR2-NGR1+1)

+      IF(IMPX.GT.0) WRITE(6,'(/36H DSPH: NUMBER OF CROSS-SECTION PERTU,

+     1 9HRBATIONS=,I5)') NPERT

+*----

+*  SET THE PERTURBED MACROLIB

+*----

+      JPNEW=LCMLID(IPNEW,'STEP',NPERT)

+      JPOLD=LCMGID(IPOLD,'GROUP')

+      IPERT=0

+      ALLOCATE(SPH(NMIXP+NALBP,NGRP),VARV(NPERT),ALBP(NALBP,NGRP),

+     1 PALBP(NALBP,NGRP))

+      ALLOCATE(IHEDIT(2,NED+1),IJJ(NMIX),NJJ(NMIX),IPOS(NMIX))

+      ALLOCATE(DIFHOM(NGRP),GAR(NMIX),PER(NMIX),GAR1(NMIX*NGRP),

+     1 PER1(NMIX*NGRP),GAR2(NMIX,NIFISS),PER2(NMIX,NIFISS),

+     2 PSIGS(NMIX,NGRP,NL))

+*----

+*  RECOVER SPH FACTORS

+*----

+      IF(NALBP.GT.0) CALL LCMGET(IPOLD,'ALBEDO',ALBP)

+      SPH(:NMIXP+NALBP,:NGRP)=1.0

+      DO 40 IGRP=NGR1,NGR2

+      KPOLD=LCMGIL(JPOLD,IGRP)

+      CALL LCMLEN(KPOLD,'NSPH',ILCMLN,ITYLCM)

+      IF(ILCMLN.EQ.NMIX) THEN

+        CALL LCMGET(KPOLD,'NSPH',SPH(1,IGRP))

+        IF(NALBP.GT.0) SPH(NMIXP+1:NMIXP+NALBP,IGRP)=1.0

+      ELSE

+        SPH(:NMIXP+NALBP,IGRP)=1.0

+      ENDIF

+   40 CONTINUE

+*----

+*  MACROSCOPIC TOTAL CROSS SECTIONS

+*----

+      DO 190 IGRP=NGR1,NGR2

+      DO 130 IBMP=1,NMIXP

+      PSIGS(:NMIX,:NGRP,:NL)=0.0

+      IPERT=IPERT+1

+      IF(IPERT.GT.NPERT) CALL XABORT('DSPH: NPERT OVERFLOW(1).')

+      VARV(IPERT)=SPH(IBMP,IGRP)

+      KPNEW=LCMDIL(JPNEW,IPERT)

+      IF(NALBP.GT.0) THEN

+        PALBP(:NALBP,:NGRP)=1.0

+        CALL LCMPUT(KPNEW,'ALBEDO',NALBP*NGRP,2,PALBP)

+      ENDIF

+      LPNEW=LCMLID(KPNEW,'GROUP',NGRP)

+      DO 110 IGR=1,NGRP

+      MPNEW=LCMDIL(LPNEW,IGR)

+      KPOLD=LCMGIL(JPOLD,IGR)

+      GAR(:NMIX)=0.0

+      NJJ(:NMIX)=1

+      IJJ(:NMIX)=IGR

+      CALL LCMPUT(MPNEW,'NTOT0',NMIX,2,GAR)

+      CALL LCMPUT(MPNEW,'SIGS00',NMIX,2,GAR)

+      CALL LCMPUT(MPNEW,'SIGW00',NMIX,2,GAR)

+      CALL LCMPUT(MPNEW,'SCAT00',NMIX,2,GAR)

+      CALL LCMPUT(MPNEW,'NJJS00',NMIX,1,NJJ)

+      CALL LCMPUT(MPNEW,'IJJS00',NMIX,1,IJJ)

+      CALL LCMPUT(MPNEW,'IPOS00',NMIX,1,NJJ)

+*----

+*  MACROSCOPIC TOTAL CROSS SECTIONS

+*----

+      PER(:NMIX)=0.0

+      CALL LCMLEN(KPOLD,'NTOT0',ILCMLN,ITYLCM)

+      IF(ILCMLN.EQ.0) CALL XABORT('DSPH: MISSING NTOT0 INFO')

+      CALL LCMGET(KPOLD,'NTOT0',GAR)

+      IF(IMC.EQ.1) THEN

+        IF(IGR.EQ.IGRP) PER(IBMP)=GAR(IBMP)/SPH(IBMP,IGR)

+        CALL LCMPUT(MPNEW,'NTOT0',NMIX,2,PER)

+      ENDIF

+      PER(:NMIX)=0.0

+      CALL LCMLEN(KPOLD,'NTOT1',ILCMLN,ITYLCM)

+      IF(ILCMLN.GT.0) CALL LCMGET(KPOLD,'NTOT1',GAR)

+      IF(IMC.EQ.1) THEN

+        IF(IGR.EQ.IGRP) PER(IBMP)=-GAR(IBMP)/SPH(IBMP,IGR)

+        CALL LCMPUT(MPNEW,'NTOT1',NMIX,2,PER)

+      ENDIF

+*----

+*  MACROSCOPIC NU*FISSION CROSS SECTIONS (STEADY-STATE AND DELAYED)

+*----

+      IF(NIFISS.GT.0) THEN

+        PER2(:NMIX,:NIFISS)=0.0

+        CALL LCMGET(KPOLD,'NUSIGF',GAR2)

+        IF(IGR.EQ.IGRP) THEN

+          DO 50 IFIS=1,NIFISS

+          PER2(IBMP,IFIS)=GAR2(IBMP,IFIS)/SPH(IBMP,IGR)

+   50     CONTINUE

+        ENDIF

+        CALL LCMPUT(MPNEW,'NUSIGF',NMIX*NIFISS,2,PER2)

+        DO 70 IDEL=1,NDEL

+        WRITE(TEXT12,'(6HNUSIGF,I2.2)') IDEL

+        PER2(:NMIX,:NIFISS)=0.0

+        CALL LCMGET(KPOLD,TEXT12,GAR2)

+        IF(IGR.EQ.IGRP) THEN

+          DO 60 IFIS=1,NIFISS

+          PER2(IBMP,IFIS)=GAR2(IBMP,IFIS)/SPH(IBMP,IGR)

+   60     CONTINUE

+        ENDIF

+        CALL LCMPUT(MPNEW,TEXT12,NMIX*NIFISS,2,PER2)

+   70   CONTINUE

+      ENDIF

+*----

+*  MACROSCOPIC SCATTERING CROSS SECTIONS

+*----

+      DO 90 IL=1,NL

+      WRITE(TEXT2,'(I2.2)') IL-1

+      CALL LCMLEN(KPOLD,'NJJS'//TEXT2,ILCMLN,ITYLCM)

+      IF(ILCMLN.GT.0) THEN

+        CALL LCMGET(KPOLD,'NJJS'//TEXT2,NJJ)

+        CALL LCMGET(KPOLD,'IJJS'//TEXT2,IJJ)

+        CALL LCMGET(KPOLD,'IPOS'//TEXT2,IPOS)

+        CALL LCMGET(KPOLD,'SCAT'//TEXT2,GAR1)

+        CALL LCMLEN(KPOLD,'NTOT1',ILCMLN,ITYLCM)

+        IF((MOD(IL-1,2).EQ.1).AND.(ILCMLN.GT.0)) THEN

+          CALL LCMGET(KPOLD,'NTOT1',GAR)

+        ELSE

+          CALL LCMGET(KPOLD,'NTOT0',GAR)

+        ENDIF

+        PER1(:NMIX*NGRP)=0.0

+        IPO=IPOS(IBMP)

+        DO 80 JGR=IJJ(IBMP),IJJ(IBMP)-NJJ(IBMP)+1,-1

+        IF(MOD(IL-1,2).EQ.0) THEN

+          IF((IGR.EQ.JGR).AND.(IMC.GT.1)) THEN

+            IF(IGR.EQ.IGRP) THEN

+              PER1(IPO)=GAR1(IPO)/SPH(IBMP,IGR)-GAR(IBMP)/SPH(IBMP,IGR)

+            ENDIF

+          ELSE

+            IF(JGR.EQ.IGRP) THEN

+              PER1(IPO)=GAR1(IPO)/SPH(IBMP,JGR) ! IGR <- JGR

+            ENDIF

+          ENDIF

+        ELSE

+          IF((IGR.EQ.JGR).AND.(IMC.GT.1)) THEN

+            IF(IGR.EQ.IGRP) THEN

+              PER1(IPO)=-GAR1(IPO)/SPH(IBMP,IGR)+GAR(IBMP)/SPH(IBMP,IGR)

+            ENDIF

+          ELSE

+            IF(IGR.EQ.IGRP) THEN

+              PER1(IPO)=-GAR1(IPO)/SPH(IBMP,IGR)

+            ENDIF

+          ENDIF

+        ENDIF

+        PSIGS(IBMP,IGR,IL)=PSIGS(IBMP,IGR,IL)+PER1(IPO)

+        IPO=IPO+1

+   80   CONTINUE

+        CALL LCMPUT(MPNEW,'NJJS'//TEXT2,NMIX,1,NJJ)

+        CALL LCMPUT(MPNEW,'IJJS'//TEXT2,NMIX,1,IJJ)

+        CALL LCMPUT(MPNEW,'IPOS'//TEXT2,NMIX,1,IPOS)

+        CALL LCMPUT(MPNEW,'SCAT'//TEXT2,IPOS(NMIX)+NJJ(NMIX)-1,2,PER1)

+      ENDIF

+      CALL LCMLEN(KPOLD,'SIGW'//TEXT2,ILCMLN,ITYLCM)

+      IF(ILCMLN.GT.0) THEN

+        PER(:NMIX)=0.0

+        CALL LCMGET(KPOLD,'SIGW'//TEXT2,GAR1)

+        CALL LCMLEN(KPOLD,'NTOT1',ILCMLN,ITYLCM)

+        IF((MOD(IL-1,2).EQ.1).AND.(ILCMLN.GT.0)) THEN

+          CALL LCMGET(KPOLD,'NTOT1',GAR)

+        ELSE

+          CALL LCMGET(KPOLD,'NTOT0',GAR)

+        ENDIF

+        IF(MOD(IL-1,2).EQ.0) THEN

+          IF(IMC.EQ.1) THEN

+            IF(IGR.EQ.IGRP) THEN

+              PER(IBMP)=GAR1(IBMP)/SPH(IBMP,IGR)

+            ENDIF

+          ELSE

+            IF(IGR.EQ.IGRP) THEN

+             PER(IBMP)=-GAR1(IBMP)/SPH(IBMP,IGR)+GAR(IBMP)/SPH(IBMP,IGR)

+            ENDIF

+          ENDIF

+        ELSE

+          IF(IMC.EQ.1) THEN

+            IF(IGR.EQ.IGRP) THEN

+              PER(IBMP)=-GAR1(IBMP)/SPH(IBMP,IGR)

+            ENDIF

+          ELSE

+            IF(IGR.EQ.IGRP) THEN

+             PER(IBMP)=-GAR1(IBMP)/SPH(IBMP,IGR)+GAR(IBMP)/SPH(IBMP,IGR)

+            ENDIF

+          ENDIF

+        ENDIF

+        CALL LCMPUT(MPNEW,'SIGW'//TEXT2,NMIX,2,PER)

+      ENDIF

+   90 CONTINUE

+*----

+*  DIFFUSION COEFFICIENTS

+*----

+      IF(ILEAKS.EQ.1) THEN

+        CALL LCMLEN(KPOLD,'DIFF',ILCMLN,ITYLCM)

+        IF(ILCMLN.GT.0) THEN

+          PER(:NMIX)=0.0

+          CALL LCMGET(KPOLD,'DIFF',GAR)

+          IF(IGR.EQ.IGRP) PER(IBMP)=GAR(IBMP)/SPH(IBMP,IGR)

+        ELSE

+          PER(:NMIX)=0.0

+          CALL LCMGET(IPOLD,'DIFHOMB1HOM',DIFHOM)

+          IF(IGR.EQ.IGRP) PER(IBMP)=DIFHOM(IGR)/SPH(IBMP,IGR)

+        ENDIF

+        CALL LCMPUT(MPNEW,'DIFF',NMIX,2,PER)

+      ELSE IF(ILEAKS.EQ.2) THEN

+        CALL LCMLEN(KPOLD,'DIFFX',ILCMLN,ITYLCM)

+        IF(ILCMLN.GT.0) THEN

+          PER(:NMIX)=0.0

+          CALL LCMGET(KPOLD,'DIFFX',GAR)

+          IF(IGR.EQ.IGRP) PER(IBMP)=GAR(IBMP)/SPH(IBMP,IGR)

+          CALL LCMPUT(MPNEW,'DIFFX',NMIX,2,PER)

+        ENDIF

+        CALL LCMLEN(KPOLD,'DIFFY',ILCMLN,ITYLCM)

+        IF(ILCMLN.GT.0) THEN

+          PER(:NMIX)=0.0

+          CALL LCMGET(KPOLD,'DIFFY',GAR)

+          IF(IGR.EQ.IGRP) PER(IBMP)=GAR(IBMP)/SPH(IBMP,IGR)

+          CALL LCMPUT(MPNEW,'DIFFY',NMIX,2,PER)

+        ENDIF

+        CALL LCMLEN(KPOLD,'DIFFZ',ILCMLN,ITYLCM)

+        IF(ILCMLN.GT.0) THEN

+          PER(:NMIX)=0.0

+          CALL LCMGET(KPOLD,'DIFFZ',GAR)

+          IF(IGR.EQ.IGRP) PER(IBMP)=GAR(IBMP)/SPH(IBMP,IGR)

+          CALL LCMPUT(MPNEW,'DIFFZ',NMIX,2,PER)

+        ENDIF

+      ENDIF

+*----

+*  SPECIFIC REACTIONS

+*----

+      CALL LCMLEN(KPOLD,'TRANC',ILCMLN,ITYLCM)

+      IF(ILCMLN.GT.0) THEN

+        PER(:NMIX)=0.0

+        CALL LCMGET(KPOLD,'TRANC',GAR)

+        IF(IGR.EQ.IGRP) PER(IBMP)=-GAR(IBMP)/SPH(IBMP,IGR)

+        CALL LCMPUT(MPNEW,'TRANC',NMIX,2,PER)

+      ENDIF

+*----

+*  ADDITIONAL PHI-WEIGHTED EDITS

+*----

+      DO 100 IED=1,NED

+      WRITE(TEXT8,'(2A4)') (IHEDIT(I0,IED),I0=1,2)

+      IF(TEXT8(:5).EQ.'TRANC') GO TO 100

+      CALL LCMLEN(KPOLD,TEXT8,ILCMLN,ITYLCM)

+      IF(ILCMLN.GT.0) THEN

+        PER(:NMIX)=0.0

+        CALL LCMGET(KPOLD,TEXT8,GAR)

+        IF(TEXT8(:4).EQ.'STRD') THEN

+          IF(IGR.EQ.IGRP) PER(IBMP)=GAR(IBMP)/SPH(IBMP,IGR)

+        ELSE

+          IF(IGR.EQ.IGRP) PER(IBMP)=GAR(IBMP)*SPH(IBMP,IGR)

+        ENDIF

+        CALL LCMPUT(MPNEW,TEXT8,NMIX,2,PER)

+      ENDIF

+  100 CONTINUE

+  110 CONTINUE

+*----

+* STORE SCATTERING CROSS SECTIONS

+*----

+      DO 125 IGR=1,NGRP

+      MPNEW=LCMDIL(LPNEW,IGR)

+      KPOLD=LCMGIL(JPOLD,IGR)

+      CALL LCMLEN(KPOLD,'SIGS00',ILCMLN,ITYLCM)

+      IF(ILCMLN.GT.0) THEN

+        PSIGS(:NMIX,IGR,1)=0.0

+        CALL LCMGET(KPOLD,'SIGS00',GAR1)

+        CALL LCMGET(KPOLD,'NTOT0',GAR)

+        IF(IMC.EQ.1) THEN

+          IF(IGR.EQ.IGRP) PSIGS(IBMP,IGR,1)=GAR1(IBMP)/SPH(IBMP,IGR)

+        ELSE

+          IF(IGR.EQ.IGRP) PSIGS(IBMP,IGR,1)=GAR1(IBMP)/SPH(IBMP,IGR)-

+     >    GAR(IBMP)/SPH(IBMP,IGR)

+        ENDIF

+      ENDIF

+      DO 120 IL=1,NL

+      WRITE(TEXT2,'(I2.2)') IL-1

+      CALL LCMLEN(KPOLD,'SIGS'//TEXT2,ILCMLN,ITYLCM)

+      IF(ILCMLN.GT.0) THEN

+        CALL LCMPUT(MPNEW,'SIGS'//TEXT2,NMIX,2,PSIGS(1,IGR,IL))

+      ENDIF

+  120 CONTINUE

+  125 CONTINUE

+  130 CONTINUE

+*----

+* DERIVATIVE RELATIVE TO PHYSICAL ALBEDOS

+*----

+      DO 180 IALP=1,NALBP

+      IPERT=IPERT+1

+      IF(IPERT.GT.NPERT) CALL XABORT('DSPH: NPERT OVERFLOW(2).')

+      VARV(IPERT)=SPH(NMIXP+IALP,IGRP)

+      KPNEW=LCMDIL(JPNEW,IPERT)

+      PALBP(:NALBP,:NGRP)=1.0

+      FAT=0.5*(1.0-ALBP(IALP,IGRP))/(1.0+ALBP(IALP,IGRP))/

+     1 REAL(VARV(IPERT))

+      PALBP(IALP,IGRP)=(1.0-2.0*FAT)/(1.0+2.0*FAT)

+      LPNEW=LCMLID(KPNEW,'GROUP',NGRP)

+      CALL LCMPUT(KPNEW,'ALBEDO',NALBP*NGRP,2,PALBP)

+      DO 170 IGR=1,NGRP

+      MPNEW=LCMDIL(LPNEW,IGR)

+      GAR(:NMIX)=0.0

+      NJJ(:NMIX)=1

+      DO 140 IMIX=1,NMIX

+      IJJ(IMIX)=IGR

+  140 CONTINUE

+      CALL LCMPUT(MPNEW,'NTOT0',NMIX,2,GAR)

+      CALL LCMPUT(MPNEW,'SIGS00',NMIX,2,GAR)

+      CALL LCMPUT(MPNEW,'SIGW00',NMIX,2,GAR)

+      CALL LCMPUT(MPNEW,'SCAT00',NMIX,2,GAR)

+      CALL LCMPUT(MPNEW,'NJJS00',NMIX,1,NJJ)

+      CALL LCMPUT(MPNEW,'IJJS00',NMIX,1,IJJ)

+      CALL LCMPUT(MPNEW,'IPOS00',NMIX,1,NJJ)

+      CALL LCMPUT(MPNEW,'NTOT0',NMIX,2,GAR)

+      CALL LCMPUT(MPNEW,'NTOT1',NMIX,2,GAR)

+      IF(NIFISS.GT.0) THEN

+        PER2(:NMIX,:NIFISS)=0.0

+        CALL LCMPUT(MPNEW,'NUSIGF',NMIX*NIFISS,2,PER2)

+        DO 150 IDEL=1,NDEL

+        WRITE(TEXT12,'(6HNUSIGF,I2.2)') IDEL

+        PER2(:NMIX,:NIFISS)=0.0

+        CALL LCMPUT(MPNEW,TEXT12,NMIX*NIFISS,2,PER2)

+  150   CONTINUE

+      ENDIF

+      IF(ILEAKS.EQ.1) THEN

+        CALL LCMPUT(MPNEW,'DIFF',NMIX,2,GAR)

+      ELSE IF(ILEAKS.EQ.2) THEN

+        CALL LCMPUT(MPNEW,'DIFFX',NMIX,2,GAR)

+        CALL LCMPUT(MPNEW,'DIFFY',NMIX,2,GAR)

+        CALL LCMPUT(MPNEW,'DIFFZ',NMIX,2,GAR)

+      ENDIF

+      DO 160 IED=1,NED

+      WRITE(TEXT8,'(2A4)') (IHEDIT(I0,IED),I0=1,2)

+      IF(TEXT8(:5).EQ.'TRANC') GO TO 160

+      CALL LCMPUT(MPNEW,TEXT8,NMIX,2,GAR)

+  160 CONTINUE

+*----

+* END OF LOOP OVER PERTURBED MACROLIBS

+*----

+  170 CONTINUE

+  180 CONTINUE

+  190 CONTINUE

+      DEALLOCATE(PSIGS,PER2,GAR2,PER1,GAR1,PER,GAR,DIFHOM)

+      DEALLOCATE(IPOS,NJJ,IJJ,IHEDIT)

+      DEALLOCATE(PALBP,ALBP,SPH)

+*----

+*  SET THE PERTURBED MACROLIB STATE-VECTOR

+*----

+      ISTATE(:NSTATE)=0

+      ISTATE(1)=NGRP

+      ISTATE(2)=NMIX

+      ISTATE(3)=1

+      ISTATE(7)=NALBP

+      ISTATE(9)=ILEAKS

+      ISTATE(11)=NPERT

+      CALL LCMPUT(IPNEW,'STATE-VECTOR',NSTATE,1,ISTATE)

+      IF(IMPX.GT.1) CALL LCMLIB(IPNEW)

+*----

+*  PUT OPTIMIZE OBJECT INFORMATION

+*----

+      CALL LCMPUT(IPOPT,'VAR-VALUE',NPERT,4,VARV)

+      DEALLOCATE(VARV)

+      IF(JENTRY(2).EQ.0)THEN

+        ISTATE(:NSTATE)=0

+        ISTATE(1)=NGRP

+        ISTATE(2)=NMIX

+        ISTATE(3)=1

+        ISTATE(4)=2+IMC

+        ISTATE(5)=NGR1

+        ISTATE(6)=NGR2

+        ISTATE(7)=1

+        ISTATE(8)=NMIX

+        ISTATE(9)=NALBP

+        IF(IMPX.GT.0) WRITE(6,200) (ISTATE(I),I=1,6)

+        CALL LCMPUT(IPOPT,'DEL-STATE',NSTATE,1,ISTATE)

+        ISTATE(:NSTATE)=0

+        ISTATE(1)=NPERT

+        ISTATE(2)=0

+        ISTATE(3)=1

+        ISTATE(4)=0

+        ISTATE(5)=0

+        ISTATE(6)=2

+        ISTATE(9)=2

+        ISTATE(10)=0

+        CALL LCMPUT(IPOPT,'STATE-VECTOR',NSTATE,1,ISTATE)

+        OPTPRR(:NSTATE)=0.0D0

+        OPTPRR(1)=1.0D0

+        OPTPRR(2)=0.1D0

+        OPTPRR(3)=1.0D-4

+        OPTPRR(4)=1.0D-4

+        OPTPRR(5)=1.0D-4

+        CALL LCMPUT(IPOPT,'OPT-PARAM-R',NSTATE,4,OPTPRR)

+      ENDIF

+      RETURN

+*

+  200 FORMAT(/18H DEL-STATE OPTIONS/18H -----------------/

+     1 7H NGRP  ,I8,28H   (NUMBER OF ENERGY GROUPS)/

+     2 7H NMIX  ,I8,32H   (NUMBER OF MATERIAL MIXTURES)/

+     3 7H ITYPE ,I8,13H   (NOT USED)/

+     4 7H IDELTA,I8,43H   (=3/4/5: USE PN-TYPE/USE SN-TYPE/ALBEDO)/

+     5 7H NGR1  ,I8,24H   (MINIMUM GROUP INDEX)/

+     6 7H NGR2  ,I8,24H   (MAXIMUM GROUP INDEX))

+      END

diff --git a/Donjon/src/FLFSTH.f b/Donjon/src/FLFSTH.f
new file mode 100644
index 0000000..0878021
--- /dev/null
+++ b/Donjon/src/FLFSTH.f
@@ -0,0 +1,62 @@
+*DECK FLFSTH
+      SUBROUTINE FLFSTH(PTOT,POWER,POWC,POWB,FLUX,NGRP,NCH,
+     +            NB,NEL,FSTH,FLUB)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Update the fuel average fluxes and the channel and bundle powers
+* over the fuel lattice using FTSH
+*
+*Copyright:
+* Copyright (C) 2010 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* M. Guyot
+*
+*Parameters: input
+* PTOT   total power in MW
+* POWER  total power computed with H-factors in MW
+* POWC   channel powers in kW
+* POWB   bundle powers in kW
+* FLUX   average fluxes per regions
+* NGRP   number of energy groups
+* NCH    number of reactor channels.
+* NB     number of fuel bundles per channel.
+* NEL    total number of finite elements.
+* FSTH   thermal to fission ratio power
+* FLUB   average fluxers per bundles
+*
+*-----------------------------------------------------------------------
+*
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER NCH,NB,NGRP,NEL
+      REAL FLUX(NEL,NGRP),FSTH,FLUB(NCH,NB,NGRP),
+     1     POWB(NCH,NB),POWC(NCH)
+      DOUBLE PRECISION POWER,FACT,PTOT
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER I,J,K
+*
+      FACT=PTOT/POWER
+      FACT= FACT/FSTH
+      DO 10 I=1,NCH
+        POWC(I)=POWC(I)*REAL(FACT)
+        DO 20 J=1,NB
+          POWB(I,J)=POWB(I,J)*REAL(FACT)
+          DO 30 K=1,NGRP
+            FLUB(I,J,K)=FLUB(I,J,K)*REAL(FACT)  
+   30     CONTINUE
+   20   CONTINUE
+   10 CONTINUE
+      DO 40 I=1,NEL
+        DO 50 J=1,NGRP
+          FLUX(I,J)=FLUX(I,J)*REAL(FACT)
+   50   CONTINUE
+   40 CONTINUE
+      RETURN
+      END
diff --git a/Donjon/src/FLPDRV.f b/Donjon/src/FLPDRV.f
new file mode 100644
index 0000000..c57c28b
--- /dev/null
+++ b/Donjon/src/FLPDRV.f
@@ -0,0 +1,304 @@
+*DECK FLPDRV
+      SUBROUTINE FLPDRV(IPPOW,IPNFX,IPFLX,IPKIN,IPTRK,IPMTX,IPMAP,
+     1 IPMAC,PTOT,LNEW,LMAP,JMOD,LFLX,LPOW,LRAT,IMPX,FSTH,LFSTH,LFLU,
+     2 LBUN,LNRM)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Driver for the powers and fluxes computations.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki, M. Guyot
+*
+*Parameters: input/output
+* IPPOW  pointer to power information.
+* IPNFX  pointer to normalized flux information.
+* IPFLX  pointer to flux information.
+* IPKIN  pointer to kinetics information.
+* IPTRK  pointer to tracking information.
+* IPMTX  pointer to matex information.
+* IPMAP  pointer to fuel-map information.
+* IPMAC  pointer to macrolib information.
+* PTOT   given total reactor power in mega-watts.
+* LNEW   new total power flag (=.true. for new computation).
+* LMAP   fuel-map printing on file flag (=.true. for print).
+* JMOD   modification index for L_MAP object.
+* LFLX   flux printing on file flag (=.true. for print).
+* LPOW   power printing on file flag (=.true. for print).
+* LRAT   flux-ratio printing on file flag (=.true. for print).
+* IMPX   printing on screen index (=0 for no print).
+* FSTH   thermal to fission power ratio
+* LFSTH  =.true if the thermal fission ratio is specified
+* LFLU   =.true. if an output flux is to be created
+* LBUN   =.true. if the output flux is a flux per bundle
+* LNRM   =.true. if the output flux is a flux per mesh-splitted element
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPPOW,IPNFX,IPFLX,IPKIN,IPTRK,IPMTX,IPMAP,IPMAC
+      INTEGER JMOD,IMPX
+      LOGICAL LNEW,LMAP,LFLX,LPOW,LRAT,LFSTH,LFLU,LBUN,LNRM
+      REAL PTOT,FSTH
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(NSTATE=40)
+      INTEGER ISTATE(NSTATE),IGR,NUN,NGRP,IGEO
+      DOUBLE PRECISION ZNRM,VTOT,POWR
+      CHARACTER HSIGN*12
+      TYPE(C_PTR) JPMAC,KPMAC,MPFLUX
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: MAT,IDL,FMIX
+      REAL, ALLOCATABLE, DIMENSION(:) :: HFC,VECT,FLUX,VOL,FXYZ,RAT,
+     1 PXYZ,VMAP,FMAP,POWC,POWB,VECNR
+*----
+*  CHECK THE TYPE OF FLUX SELECTED FOR OUTPUT
+*----
+      IF(LFLU)THEN
+        IF(LNRM.AND.LBUN) CALL XABORT('@FLPDRV: KEYWORD NORM AND BUND '
+     1    //'BOTH SELECTED.')
+        IF((.NOT.LNRM).AND.(.NOT.LBUN)) THEN
+          LNRM=.TRUE.
+          WRITE(6,*) 'FLPDRV: default option for L_FLUX object is NORM.'
+        ENDIF
+      ENDIF
+*----
+*  RECOVER INFORMATION
+*----
+      ISTATE(:NSTATE)=0
+      IF(C_ASSOCIATED(IPFLX)) THEN
+*       L_FLUX object
+        CALL LCMGET(IPFLX,'STATE-VECTOR',ISTATE)
+        NGRP=ISTATE(1)
+        NUN=ISTATE(2)
+        CALL LCMGET(IPFLX,'K-EFFECTIVE',FKEFF)
+      ELSE IF(C_ASSOCIATED(IPKIN)) THEN
+*       L_KINET object
+        CALL LCMGET(IPKIN,'STATE-VECTOR',ISTATE)
+        NGRP=ISTATE(3)
+        NUN=ISTATE(6)
+        CALL LCMGET(IPKIN,'E-KEFF',FKEFF)
+        CALL LCMGET(IPKIN,'E-POW',PTOT)
+      ENDIF
+      ISTATE(:NSTATE)=0
+      CALL LCMGET(IPTRK,'STATE-VECTOR',ISTATE)
+      NEL=ISTATE(1)
+      IF(ISTATE(2).NE.NUN) CALL XABORT('@FLPDRV: INCOMPATIBLE L_TRACK '
+     1 //'AND L_FLUX/L_KINET OBJECTS')
+      LX=ISTATE(14)
+      LY=ISTATE(15)
+      LZ=ISTATE(16)
+*----
+*  RECOVER H-FACTOR
+*----
+      ISTATE(:NSTATE)=0
+      IF(C_ASSOCIATED(IPMAC))THEN
+        CALL LCMGET(IPMAC,'STATE-VECTOR',ISTATE)
+        IF(ISTATE(1).NE.NGRP)CALL XABORT('@FLPDRV: INVALID NUM'
+     1   //'BER OF ENERGY GROUPS IN MACROLIB.')
+        NMIX=ISTATE(2)
+        ALLOCATE(HFC(NMIX*NGRP))
+        JPMAC=LCMGID(IPMAC,'GROUP')
+        DO JGR=1,NGRP
+          KPMAC=LCMGIL(JPMAC,JGR)
+          CALL LCMLEN(KPMAC,'H-FACTOR',LENGT,ITYP)
+          IF(LENGT.NE.NMIX)CALL XABORT('@FLPDRV: UNABLE TO FIND'
+     1     //' H-FACTOR BLOCK DATA IN THE MACROLIB.')
+          CALL LCMGET(KPMAC,'H-FACTOR',HFC((JGR-1)*NMIX+1))
+        ENDDO
+      ELSEIF(C_ASSOCIATED(IPMTX))THEN
+        CALL LCMGET(IPMTX,'STATE-VECTOR',ISTATE)
+        IF(ISTATE(1).NE.NGRP)CALL XABORT('@FLPDRV: INVALID NUM'
+     1   //'BER OF ENERGY GROUPS IN MATEX.')
+        NMIX=ISTATE(2)
+        ALLOCATE(HFC(NMIX*NGRP))
+        HFC(:NMIX*NGRP)=0.0
+        CALL LCMGET(IPMTX,'H-FACTOR',HFC)
+      ENDIF
+*----
+*  RECOVER FUELMAP AND MATEX INFORMATION
+*----
+      IF(C_ASSOCIATED(IPMAP).AND.C_ASSOCIATED(IPMTX))THEN
+        CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+        NB=ISTATE(1)
+        NCH=ISTATE(2)
+        IGEO=ISTATE(12)
+        IF((IGEO.NE.7).AND.(IGEO.NE.9))CALL XABORT('@FLPDRV: INVALID'
+     1   //' GEOMETRY IN FUEL MAP : ONLY 3-D CARTESIAN OR 3-D HEXAGO'
+     2   //'NAL GEOMETRIES AVAILABLE') 
+        IF(ISTATE(4).NE.NGRP)CALL XABORT('@FLPDRV: INVALID NUM'
+     1   //'BER OF ENERGY GROUPS IN FUEL MAP OR FLUX.')
+        ISTATE(:NSTATE)=0
+        CALL LCMGET(IPMTX,'STATE-VECTOR',ISTATE)
+        NMIX=ISTATE(2)
+        NTOT=ISTATE(5)
+        IF(ISTATE(6).NE.IGEO)CALL XABORT('@FLPDRV: GEOMETRIES IN'
+     1   //' MATEX AND FUEL MAP ARE DIFFERENT')
+        IF(ISTATE(7).NE.NEL)CALL XABORT('@FLPDRV: INVALID TOTAL'
+     1   //' NUMBER OF REGIONS IN FUEL MAP OR TRACK.')
+      ENDIF
+*----
+*  FLUX NORMALIZATION
+*----
+      ALLOCATE(VECT(NUN*NGRP),FLUX(NEL*NGRP),MAT(NEL),VOL(NEL),IDL(NEL))
+      IF(LNEW)THEN
+*       NEW TOTAL REACTOR POWER
+        CALL LCMLEN(IPPOW,'NORM',LENGT,ITYP)
+        IF(LENGT.EQ.0)CALL XABORT('@FLPDRV: UNABLE TO F'
+     1   //'IND FLUX NORMALIZATION FACTOR IN L_POWER.')
+        CALL LCMGET(IPPOW,'NORM',ZNRM)
+        CALL FLPTOT(IPFLX,IPKIN,IPTRK,NMIX,NGRP,NEL,NUN,VECT,FLUX,MAT,
+     1  VOL,IDL,HFC,POWR,ZNRM,IMPX)
+      ELSE
+*       GIVEN TOTAL REACTOR POWER
+        POWR=DBLE(PTOT*10**6)
+        IF(PTOT.EQ.0.0)CALL XABORT('@FLPDRV: PTOT IS NOT DEFINED')
+        CALL FLPNRM(IPFLX,IPKIN,IPTRK,NMIX,NGRP,NEL,NUN,VECT,FLUX,MAT,
+     1  VOL,IDL,HFC,POWR,ZNRM,IMPX)
+        CALL LCMPUT(IPPOW,'NORM',1,4,ZNRM)
+      ENDIF
+      DEALLOCATE(IDL)
+      CALL LCMPUT(IPPOW,'FLUX',NEL*NGRP,2,FLUX)
+      POWR=POWR/(10**6)
+      CALL LCMPUT(IPPOW,'PTOT',1,4,POWR)
+*----
+*  WHOLE REACTOR
+*----
+      ALLOCATE(FXYZ(NEL*NGRP),RAT(NEL*(NGRP-1)))
+*     FLUX DISTRIBUTION
+      IF(IGEO.EQ.7) THEN
+        CALL FLPFLX(NGRP,NEL,LX,LY,LZ,MAT,VOL,FLUX,FXYZ,RAT,VTOT,IMPX,
+     1  LFLX,LRAT)
+      ELSEIF(IGEO.EQ.9) THEN
+        CALL FLPHFX(NGRP,NEL,LX,LZ,MAT,VOL,FLUX,FXYZ,RAT,VTOT,IMPX,
+     1  LFLX,LRAT)
+      ENDIF
+      CALL LCMPUT(IPPOW,'VTOT',1,4,VTOT)
+      CALL LCMPUT(IPPOW,'FLUX-DISTR',NEL*NGRP,2,FXYZ)
+      IF(NGRP.GT.1) CALL LCMPUT(IPPOW,'FLUX-RATIO',NEL*(NGRP-1),2,RAT)
+      DEALLOCATE(RAT,FXYZ)
+*     POWER DISTRIBUTION
+      ALLOCATE(PXYZ(NEL))
+      IF(IGEO.EQ.7) THEN
+        CALL FLPOWR(NMIX,NGRP,NEL,LX,LY,LZ,MAT,VOL,FLUX,HFC,PXYZ,VTOT,
+     1  IMPX,LPOW)
+      ELSEIF(IGEO.EQ.9) THEN
+        CALL FLPHPW(NMIX,NGRP,NEL,LX,LZ,MAT,VOL,FLUX,HFC,PXYZ,VTOT,
+     1  IMPX,LPOW)
+      ENDIF
+      CALL LCMPUT(IPPOW,'POWER-DISTR',NEL,2,PXYZ)
+      DEALLOCATE(PXYZ)
+      CALL LCMPUT(IPPOW,'K-EFFECTIVE',1,2,FKEFF)
+*----
+*  FUEL-MAP
+*----
+      IF((C_ASSOCIATED(IPMAP)).AND.(C_ASSOCIATED(IPMTX))) THEN
+        ALLOCATE(FMIX(NCH*NB),VMAP(NCH*NB),FMAP(NCH*NB*NGRP))
+        CALL LCMGET(IPMAP,'FLMIX',FMIX)
+*       COMPUTE FLUXES
+        CALL FLPFLB(IPMTX,NTOT,NGRP,NEL,NCH,NB,FLUX,VOL,FMIX,VMAP,FMAP,
+     1  IMPX,LMAP)
+        ALLOCATE(POWC(NCH),POWB(NCH*NB))
+*       COMPUTE POWERS
+        CALL FLPOWB(IPPOW,IPMAP,IPMTX,NMIX,NTOT,NGRP,NCH,NB,NEL,MAT,
+     1  VOL,HFC,FLUX,POWB,POWC,IMPX,POWR,FSTH,LFSTH,FMIX,FMAP,IGEO)
+        CALL LCMPUT(IPPOW,'POWER-CHAN',NCH,2,POWC)
+        CALL LCMPUT(IPPOW,'POWER-BUND',NCH*NB,2,POWB)
+        CALL LCMPUT(IPPOW,'FLUX',NEL*NGRP,2,FLUX)
+        CALL LCMPUT(IPPOW,'VOLU-BUND',NCH*NB,2,VMAP)
+        CALL LCMPUT(IPPOW,'FLUX-BUND',NCH*NB*NGRP,2,FMAP)
+        CALL LCMPUT(IPPOW,'FLMIX',NCH*NB,1,FMIX)
+        IF(JMOD.GE.1) THEN
+          CALL LCMPUT(IPMAP,'TOT-PW',1,2,PTOT)
+          CALL LCMPUT(IPMAP,'BUND-PW',NCH*NB,2,POWB)
+          CALL LCMPUT(IPMAP,'FLUX-AV',NCH*NB*NGRP,2,FMAP)
+          IF(JMOD.EQ.2) THEN
+            CALL LCMPUT(IPMAP,'BUND-PW-INI',NCH*NB,2,POWB)
+          ENDIF
+          PTOT=0.0
+          DO I=1,NCH*NB
+            PTOT=PTOT+POWB(I)
+          ENDDO
+          PTOT=PTOT/1.0E3
+          CALL LCMPUT(IPMAP,'REACTOR-PW',1,2,PTOT)
+        ENDIF
+        DEALLOCATE(POWB,POWC)
+      ENDIF
+      DEALLOCATE(VOL,MAT,FLUX,HFC)
+
+      IF(LFLU) THEN
+*----
+*  STATE-VECTOR FOR L_FLUX OBJECT
+*----
+        IF(LNRM) THEN
+          ISTATE(:NSTATE)=0
+          IF(C_ASSOCIATED(IPFLX)) THEN
+            CALL LCMGET(IPFLX,'STATE-VECTOR',ISTATE)
+          ELSE IF(C_ASSOCIATED(IPKIN)) THEN
+            ISTATE(1)=NGRP
+            ISTATE(2)=NUN
+          ENDIF
+          CALL LCMPUT(IPNFX,'STATE-VECTOR',NSTATE,1,ISTATE)
+          HSIGN='L_FLUX'
+          CALL LCMPTC(IPNFX,'SIGNATURE',12,HSIGN)
+          ALLOCATE(VECNR(NUN*NGRP))
+          DO 10 I=1,NUN*NGRP
+            VECNR(I)=VECT(I)*REAL(ZNRM)
+   10     CONTINUE
+          MPFLUX=LCMLID(IPNFX,'FLUX',NGRP)
+          DO 20 IGR=1,NGRP
+            IOFSET=(IGR-1)*NUN
+            CALL LCMPDL(MPFLUX,IGR,NUN,2,VECNR(IOFSET+1))
+   20     CONTINUE        
+          DEALLOCATE(VECNR)
+        ELSE
+          MPFLUX=LCMLID(IPNFX,'FLUX',NGRP)
+          DO 30 IGR=1,NGRP
+              IOFSET=(IGR-1)*NB*NCH
+              CALL LCMPDL(MPFLUX,IGR,NB*NCH,2,FMAP(IOFSET+1))
+   30     CONTINUE 
+        ENDIF
+      ENDIF
+      IF(C_ASSOCIATED(IPMAP)) DEALLOCATE(VMAP,FMAP,FMIX)
+      DEALLOCATE(VECT)
+*----
+*  STATE-VECTOR FOR L_FLUX OBJECT
+*----
+      IF(LFLU) THEN
+        ISTATE(:NSTATE)=0
+        IF(C_ASSOCIATED(IPFLX)) THEN
+          CALL LCMGET(IPFLX,'STATE-VECTOR',ISTATE)
+        ELSE IF(C_ASSOCIATED(IPKIN)) THEN
+          ISTATE(1)=NGRP
+          ISTATE(2)=NUN
+        ENDIF
+        IF(LBUN) ISTATE(2)=NB*NCH
+        CALL LCMPUT(IPNFX,'STATE-VECTOR',NSTATE,1,ISTATE)
+        HSIGN='L_FLUX'
+        CALL LCMPTC(IPNFX,'SIGNATURE',12,HSIGN)
+      ENDIF
+*----
+*  STATE-VECTOR FOR L_POWER OBJECT
+*----
+      ISTATE(:NSTATE)=0
+      ISTATE(1)=NGRP
+      ISTATE(2)=NEL
+      ISTATE(3)=LX
+      ISTATE(4)=LY
+      ISTATE(5)=LZ
+      ISTATE(6)=NCH
+      ISTATE(7)=NB
+      ISTATE(8)=IGEO
+      CALL LCMPUT(IPPOW,'STATE-VECTOR',NSTATE,1,ISTATE)
+      HSIGN='L_POWER'
+      CALL LCMPTC(IPPOW,'SIGNATURE',12,HSIGN)
+      IF(IMPX.GT.1)CALL LCMLIB(IPPOW)
+      RETURN
+      END
diff --git a/Donjon/src/FLPFLB.f b/Donjon/src/FLPFLB.f
new file mode 100644
index 0000000..c6e3e2e
--- /dev/null
+++ b/Donjon/src/FLPFLB.f
@@ -0,0 +1,163 @@
+*DECK FLPFLB

+      SUBROUTINE FLPFLB(IPMTX,NMAT,NGRP,NEL,NCH,NB,FLUX,VOL,FMIX,VOLB,

+     1 FLXB,IMPX,LMAP)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Compute average fluxes per fuel bundle and other related quantities;

+* print bundle fluxes on file.

+*

+*Copyright:

+* Copyright (C) 2007 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* D. Sekki

+*

+*Parameters: input

+* IPMTX  pointer to matex information.

+* NMAT   total number of mixtures (includes virtual regions).

+* NGRP   number of energy groups.

+* NEL    total number of elements.

+* NCH    number of reactor channels.

+* NB     number of fuel bundles per channel.

+* FLUX   normalized fluxes associated with each volume.

+* VOL    element-ordered mesh-splitted volumes.

+* IMPX   printing index (=0 for no print).

+* LMAP   flux printing flag (=.true. print on file).

+* FMIX   fuel bundle indices.

+*

+*Parameters: output

+* VOLB   bundle volumes.

+* FLXB   bundle fluxes.

+*

+*-----------------------------------------------------------------------

+*

+      USE GANLIB

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      TYPE(C_PTR) IPMTX

+      INTEGER NMAT,NEL,NGRP,NCH,NB,IMPX,FMIX(NCH*NB)

+      REAL FLUX(NEL,NGRP),VOL(NEL),VOLB(NCH,NB),FLXB(NCH,NB,NGRP)

+      LOGICAL LMAP

+*----

+*  LOCAL VARIABLES

+*----

+      PARAMETER(IOUT=6,INIT=1)

+      INTEGER FMAT(NMAT)

+      CHARACTER TEXT*12,FNAM*12

+      REAL RATIO(NCH,NB,NGRP-1)

+      DOUBLE PRECISION FAVG(NGRP)

+*----

+*  PERFORM CALCULATION

+*----

+      FMAX=0.

+      ICM=0

+      IBM=0

+      MGR=0

+      FAVG(:NGRP)=0.0D0

+      FMAT(:NMAT)=0

+      CALL LCMGET(IPMTX,'MAT',FMAT)

+      FLXB(:NCH,:NB,:NGRP)=0.0

+      IF(IMPX.GT.0)WRITE(IOUT,1004)

+      NTOT=0

+      VTOT=0.0

+      DO 45 IB=1,NB

+      DO 40 ICH=1,NCH

+      NUM=(IB-1)*NCH+ICH

+      VOLB(ICH,IB)=0.0

+      IF(FMIX(NUM).EQ.0) GO TO 40

+      NTOT=NTOT+1

+      DO 20 IEL=1,NEL

+      IF(FMAT(IEL).NE.-NTOT)GOTO 20

+      DO 10 JGR=1,NGRP

+      FLXB(ICH,IB,JGR)=FLXB(ICH,IB,JGR)+FLUX(IEL,JGR)*VOL(IEL)

+   10 CONTINUE

+      VOLB(ICH,IB)=VOLB(ICH,IB)+VOL(IEL)

+   20 CONTINUE

+      DO JGR=1,NGRP

+        FLXB(ICH,IB,JGR)=FLXB(ICH,IB,JGR)/VOLB(ICH,IB)

+        IF(ABS(FLXB(ICH,IB,JGR)).GT.FMAX)THEN

+          FMAX=FLXB(ICH,IB,JGR)

+          ICM=ICH

+          IBM=IB

+          MGR=JGR

+        ENDIF

+        FAVG(JGR)=FAVG(JGR)+FLXB(ICH,IB,JGR)*VOLB(ICH,IB)

+      ENDDO

+      VTOT=VTOT+VOLB(ICH,IB)

+   40 CONTINUE

+   45 CONTINUE

+*     MAX AND CORE-AVERAGE FLUXES

+      IF(IMPX.GT.0)WRITE(IOUT,1007)FMAX,ICM,IBM,MGR

+      DO JGR=1,NGRP

+        FAVG(JGR)=FAVG(JGR)/VTOT

+        IF(IMPX.GT.0)WRITE(IOUT,1008)FAVG(JGR),JGR

+      ENDDO

+*     FORM FACTOR

+      IF(MGR.EQ.0) CALL XABORT('FLPFLB: FLUX NORMALIZATION FAILURE.')

+      FACT=REAL(FAVG(MGR))/FMAX

+      FACT2=1./FACT

+      IF(IMPX.GT.0)WRITE(IOUT,1009)MGR,FACT,FACT2,VTOT

+*     FLUXES RATIOS

+      RATIO(:NCH,:NB,:NGRP-1)=0.0

+      DO 52 IB=1,NB

+      DO 51 ICH=1,NCH

+      DO 50 JGR=1,NGRP-1

+      RATIO(ICH,IB,JGR)=FLXB(ICH,IB,JGR)/FLXB(ICH,IB,NGRP)

+   50 CONTINUE

+   51 CONTINUE

+   52 CONTINUE

+      IF(.NOT.LMAP)GOTO 80

+*----

+*  PRINTING

+*----

+      FNAM='FluxMAP.res'

+      OPEN(UNIT=INIT,FILE=FNAM,STATUS='UNKNOWN')

+      WRITE(INIT,1000)NCH,NB,NGRP

+      DO 65 JGR=1,NGRP

+      WRITE(INIT,1001)JGR

+      DO 60 ICH=1,NCH

+      WRITE(TEXT,'(A9,I3.3)')'CHANNEL #',ICH

+      WRITE(INIT,1002)TEXT

+      WRITE(INIT,1003)(FLXB(ICH,IB,JGR),IB=1,NB)

+   60 CONTINUE

+   65 CONTINUE

+      WRITE(INIT,1010)

+      DO 75 JGR=1,NGRP-1

+      WRITE(INIT,1011)JGR,NGRP

+      DO 70 ICH=1,NCH

+      WRITE(TEXT,'(A9,I3.3)')'CHANNEL #',ICH

+      WRITE(INIT,1002)TEXT

+      WRITE(INIT,1012)(RATIO(ICH,IB,JGR),IB=1,NB)

+   70 CONTINUE

+   75 CONTINUE

+      CLOSE(UNIT=INIT)

+      IF(IMPX.GT.0)WRITE(IOUT,1006)FNAM

+   80 RETURN

+*

+ 1000 FORMAT(/20X,5('*'),3X,'AVERAGE FUEL-BUNDLES ',

+     1 'FLUXES',3X,5('*')//5X,'NUMBER OF CHANNELS:',

+     2 1X,I3,4X,'NUMBER OF BUNDLES:',1X,I2,4X,

+     3 'NUMBER OF GROUPS:',I2)

+ 1001 FORMAT(//18X,'ENERGY GROUP =>',1X,I2.2)

+ 1002 FORMAT(/1X,A12)

+ 1003 FORMAT(6(1P,E15.8))

+ 1004 FORMAT(/1X,'** COMPUTING AVERAGE',1X,'BUNDLE FLUXES **'/)

+ 1006 FORMAT(/1X,'PRINTING BUNDLE FLUXES ON FILE:',

+     1 1X,'<',A11,'>',3X,'=>',2X,'DONE.')

+ 1007 FORMAT(1X,'MAX FLUX =',1P,E13.6,2X,'=>',

+     1 2X,'CHANNEL #',I3.3,2X,'BUNDLE #',I2.2,

+     2 2X,'GROUP #',I2.2/)

+ 1008 FORMAT(1X,'FUEL-ZONE AVERAGE FLUX =',

+     1 1P,E13.6,3X,'=>',2X,'GROUP #',I2.2)

+ 1009 FORMAT(/1X,'FLUX-FORM FACTOR FOR GROUP #',I2.2,

+     1 2X,'=>',2X,'AVG/MAX = ',F8.4,2X,'(MAX/AVG = ',

+     2 F8.4,')'/' FUEL-ZONE VOLUME =',1P,E13.6,' CM3'/)

+ 1010 FORMAT(//16X,5('*'),3X,'FUEL-BUNDLES',

+     1 1X,'FLUXES RATIOS',3X,5('*')/)

+ 1011 FORMAT(/18X,'FLUX RATIO: GROUP #',I2.2,

+     1 1X,'=>',1X,'GROUP #',I2.2)

+ 1012 FORMAT(6(1P,E13.6))

+      END

diff --git a/Donjon/src/FLPFLX.f b/Donjon/src/FLPFLX.f
new file mode 100644
index 0000000..85c08ff
--- /dev/null
+++ b/Donjon/src/FLPFLX.f
@@ -0,0 +1,168 @@
+*DECK FLPFLX

+      SUBROUTINE FLPFLX(NGRP,NEL,LX,LY,LZ,MAT,VOL,FLUX,FXYZ,RATIO,VTOT,

+     1 IMPX,LFLX,LRAT)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Compute the flux distributions and ratios over the whole reactor core;

+* print the normalized fluxes on files.

+*

+*Copyright:

+* Copyright (C) 2007 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* D. Sekki

+*

+*Parameters: input

+* NGRP   total number of energy groups.

+* NEL    total number of finite elements.

+* LX     number of elements along x-axis.

+* LY     number of elements along y-axis.

+* LZ     number of elements along z-axis.

+* MAT    index-number of mixture assigned to each volume.

+* VOL    element-ordered mesh-splitted volumes.

+* FLUX   normalized fluxes associated with each volume.

+* IMPX   screen printing index (=0 for no print).

+* LFLX   fluxes printing flag: =.true. print on files.

+* LRAT   ratios printing flag: =.true. print on files.

+*

+*Parameters: output

+* FXYZ   mesh-ordered fluxes.

+* RATIO  fluxes ratios with respect to thermal fluxes.

+* VTOT   total reactor-core volume.

+*

+*-----------------------------------------------------------------------

+*

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      INTEGER NGRP,NEL,LX,LY,LZ,MAT(NEL),IMPX

+      REAL FXYZ(LX,LY,LZ,NGRP),FLUX(NEL,NGRP),

+     1     RATIO(LX,LY,LZ,NGRP-1),VOL(NEL)

+      DOUBLE PRECISION VTOT

+      LOGICAL LFLX,LRAT

+*----

+*  LOCAL VARIABLES

+*----

+      PARAMETER(IOUT=6,INIT=1)

+      CHARACTER TEXT*12

+      DOUBLE PRECISION FAVG(NGRP)

+*----

+*  PERFORM CALCULATION

+*----

+      IF(IMPX.GT.0)WRITE(IOUT,1010)

+      FMAX=0.

+      IM=0

+      KM=0

+      MGR=0

+      VTOT=0.0D0

+      FAVG(:NGRP)=0.0D0

+      FXYZ(:LX,:LY,:LZ,:NGRP)=0.0

+      IEL=0

+      DO 12 K=1,LZ

+      DO 11 J=1,LY

+      DO 10 I=1,LX

+      IEL=IEL+1

+      IF(MAT(IEL).EQ.0)GOTO 10

+      VTOT=VTOT+VOL(IEL)

+      DO JGR=1,NGRP

+        FXYZ(I,J,K,JGR)=FLUX(IEL,JGR)

+        IF(ABS(FXYZ(I,J,K,JGR)).GT.FMAX)THEN

+          FMAX=FXYZ(I,J,K,JGR)

+          IM=I

+          JM=J

+          KM=K

+          MGR=JGR

+        ENDIF

+        FAVG(JGR)=FAVG(JGR)+FXYZ(I,J,K,JGR)*VOL(IEL)

+      ENDDO

+   10 CONTINUE

+   11 CONTINUE

+   12 CONTINUE

+*     MAX AND CORE-AVERAGE FLUXES

+      IF(IMPX.GT.0)WRITE(IOUT,1000)FMAX,IM,JM,KM,MGR

+      DO JGR=1,NGRP

+        FAVG(JGR)=FAVG(JGR)/VTOT

+        IF(IMPX.GT.0)WRITE(IOUT,1001)FAVG(JGR),JGR

+      ENDDO

+      IF(MGR.EQ.0) CALL XABORT('FLPFLX: FLUX NORMALIZATION FAILURE.')

+      FACT=REAL(FAVG(MGR))/FMAX

+      FACT2=1./FACT 

+      IF(IMPX.GT.0)WRITE(IOUT,1002)MGR,FACT,FACT2,VTOT

+*     FLUXES RATIOS

+      RATIO(:LX,:LY,:LZ,:NGRP-1)=0.0

+      DO 32 K=1,LZ

+      DO 31 J=1,LY

+      DO 30 I=1,LX

+      IF(FXYZ(I,J,K,NGRP).EQ.0.)GOTO 30

+      DO 20 JGR=1,NGRP-1

+      RATIO(I,J,K,JGR)=FXYZ(I,J,K,JGR)/FXYZ(I,J,K,NGRP)

+   20 CONTINUE

+   30 CONTINUE

+   31 CONTINUE

+   32 CONTINUE

+      IF(.NOT.LFLX)GOTO 60

+*----

+*  PRINTING

+*----

+      IF(IMPX.GT.0)WRITE(IOUT,1006)

+*     FLUXES

+      DO 50 JGR=1,NGRP

+        WRITE(TEXT,'(A4,I2.2,A4)')'Flux',JGR,'.res'

+        OPEN(UNIT=INIT,FILE=TEXT,STATUS='UNKNOWN')

+        WRITE(INIT,1011)LX,LY,LZ,JGR

+        DO 40 K=1,LZ

+        DO J=1,LY

+        WRITE(INIT,1009)J,K

+        WRITE(INIT,1005) (FXYZ(I,J,K,JGR),I=1,LX)

+        ENDDO

+   40   CONTINUE

+        CLOSE(UNIT=INIT)

+        IF(IMPX.GT.0)WRITE(IOUT,1003)JGR,TEXT

+   50 CONTINUE

+*

+   60 IF(.NOT.LRAT)GOTO 90

+      IF(IMPX.GT.0)WRITE(IOUT,1007)

+*     RATIOS

+      DO 80 JGR=1,NGRP-1

+        WRITE(TEXT,'(A4,I2.2,A4)')'Rati',JGR,'.res'

+        OPEN(UNIT=INIT,FILE=TEXT,STATUS='UNKNOWN')

+        WRITE(INIT,1012)JGR,NGRP,LX,LY,LZ

+        DO 70 K=1,LZ

+        DO J=1,LY

+        WRITE(INIT,1009)J,K

+        WRITE(INIT,1008) (RATIO(I,J,K,JGR),I=1,LX)

+        ENDDO

+   70   CONTINUE

+        CLOSE(UNIT=INIT)

+        IF(IMPX.GT.0)WRITE(IOUT,1004)JGR,NGRP,TEXT

+   80 CONTINUE

+   90 RETURN

+*

+ 1000 FORMAT(1X,'MAX FLUX =',1P,E13.6,4X,'AT COORD :',1X,

+     1 'I =',I3,2X,'J =',I3,2X,'K =',I3,2X,'GROUP #',I2.2/)

+ 1001 FORMAT(1X,'CORE-AVERAGE FLUX =',1P,E13.6,

+     1 2X,'=>',2X,'GROUP #',I2.2)

+ 1002 FORMAT(/1X,'OVERALL FLUX-FORM FACTOR FOR GROUP #',I2.2,

+     1 2X,'=>',2X,'AVG/MAX =',1X,F8.4,2X,'(MAX/AVG = ',F8.4,

+     2 ')'/1X,'TOTAL CORE VOLUME =',1P,E13.6,1X,'CM3'/)

+ 1003 FORMAT(1X,'FLUXES',2X,'=>',2X,'GROUP #',I2.2,2X,

+     1 '=>',2X,'FILE NAME: <',A10,'>',2X,'=>',2X,'DONE.')

+ 1004 FORMAT(1X,'FLUX RATIOS',2X,'=>',2X,'GR.#',I2.2,

+     1 '/GR.#',I2.2,2X,'=>',2X,'FILE NAME: <',A10,'>',

+     1 2X,'=>',2X,'DONE.')

+ 1005 FORMAT(1X,1P,6E16.8)

+ 1006 FORMAT(/15X,'** PRINTING OF FLUXES ON FILES **'/)

+ 1007 FORMAT(/15X,'** PRINTING OF RATIOS ON FILES **'/)

+ 1008 FORMAT(1X,1P,6E14.6)

+ 1009 FORMAT(//3X,'PLANE-Y #',I2.2,5X,'PLANE-Z #',I2.2/)

+ 1010 FORMAT(/1X,'** COMPUTING FLUX-DISTRIBUTION',

+     1 1X,'OVER THE REACTOR CORE **'/)

+ 1011 FORMAT(/10X,5('*'),3X,'FLUX-DISTRIBUTION OVER THE',

+     1 1X,'REACTOR CORE',3X,5('*')//21X,'NX=',I2,',',2X,

+     2 'NY=',I2,',',2X,'NZ=',I2,',',2X,'GROUP #',I2.2)

+ 1012 FORMAT(/10X,5('*'),3X,'FLUXES RATIO',1X,'#',I2.2,

+     1 '/#',I2.2,1X,'OVER THE REACTOR CORE',3X,5('*')//

+     2 25X,'NX=',I2,',',2X,'NY=',I2,',',2X,'NZ=',I2)

+      END

diff --git a/Donjon/src/FLPHFX.f b/Donjon/src/FLPHFX.f
new file mode 100644
index 0000000..17268f7
--- /dev/null
+++ b/Donjon/src/FLPHFX.f
@@ -0,0 +1,161 @@
+*DECK FLPHFX

+      SUBROUTINE FLPHFX(NGRP,NEL,LX,LZ,MAT,VOL,FLUX,FXYZ,RATIO,VTOT,

+     1 IMPX,LFLX,LRAT)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Compute the flux distributions and ratios over the whole reactor core;

+* print the normalized fluxes on files.

+*

+*Copyright:

+* Copyright (C) 2007 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* D. Sekki

+*

+*Update(s):

+* V. Descotes 5/06/2010

+*

+*Parameters: input

+* NGRP   total number of energy groups.

+* NEL    total number of finite elements.

+* LX     number of hexagons.

+* LZ     number of elements along z-axis.

+* MAT    index-number of mixture assigned to each volume.

+* VOL    element-ordered mesh-splitted volumes.

+* FLUX   normalized fluxes associated with each volume.

+* IMPX   screen printing index (=0 for no print).

+* LFLX   fluxes printing flag: =.true. print on files.

+* LRAT   ratios printing flag: =.true. print on files.

+*

+*Parameters: output

+* FXYZ   mesh-ordered fluxes.

+* RATIO  fluxes ratios with respect to thermal fluxes.

+* VTOT   total reactor-core volume.

+*

+*-----------------------------------------------------------------------

+*

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      INTEGER NGRP,NEL,LX,LZ,MAT(NEL),IMPX

+      REAL FXYZ(LX,LZ,NGRP),FLUX(NEL,NGRP),

+     1     RATIO(LX,LZ,NGRP-1),VOL(NEL)

+      DOUBLE PRECISION VTOT

+      LOGICAL LFLX,LRAT

+*----

+*  LOCAL VARIABLES

+*----

+      PARAMETER(IOUT=6,INIT=1)

+      CHARACTER TEXT*12

+      DOUBLE PRECISION FAVG(NGRP)

+*----

+*  PERFORM CALCULATION

+*----

+      IF(IMPX.GT.0)WRITE(IOUT,1010)

+      FMAX=0.

+      IM=0

+      KM=0

+      MGR=0

+      VTOT=0.0D0

+      FAVG(:NGRP)=0.0D0

+      FXYZ(:LX,:LZ,:NGRP)=0.0

+      IEL=0

+      DO 15 K=1,LZ

+      DO 10 I=1,LX

+      IEL=IEL+1

+      IF(MAT(IEL).EQ.0)GOTO 10

+      VTOT=VTOT+VOL(IEL)

+      DO JGR=1,NGRP

+        FXYZ(I,K,JGR)=FLUX(IEL,JGR)

+        IF(ABS(FXYZ(I,K,JGR)).GT.FMAX)THEN

+          FMAX=FXYZ(I,K,JGR)

+          IM=I

+          KM=K

+          MGR=JGR

+        ENDIF

+        FAVG(JGR)=FAVG(JGR)+FXYZ(I,K,JGR)*VOL(IEL)

+      ENDDO

+   10 CONTINUE

+   15 CONTINUE

+*     MAX AND CORE-AVERAGE FLUXES

+      IF(IMPX.GT.0)WRITE(IOUT,1000)FMAX,IM,KM,MGR

+      DO JGR=1,NGRP

+        FAVG(JGR)=FAVG(JGR)/VTOT

+        IF(IMPX.GT.0)WRITE(IOUT,1001)FAVG(JGR),JGR

+      ENDDO

+      IF(MGR.EQ.0) CALL XABORT('FLPHFX: FLUX NORMALIZATION FAILURE.')

+      FACT=REAL(FAVG(MGR))/FMAX

+      FACT2=1./FACT 

+      IF(IMPX.GT.0)WRITE(IOUT,1002)MGR,FACT,FACT2,VTOT

+*     FLUXES RATIOS

+      RATIO(:LX,:LZ,:NGRP-1)=0.0

+      DO 35 K=1,LZ

+      DO 30 I=1,LX

+      IF(FXYZ(I,K,NGRP).EQ.0.)GOTO 30

+      DO 20 JGR=1,NGRP-1

+      RATIO(I,K,JGR)=FXYZ(I,K,JGR)/FXYZ(I,K,NGRP)

+   20 CONTINUE

+   30 CONTINUE

+   35 CONTINUE

+      IF(.NOT.LFLX)GOTO 60

+*----

+*  PRINTING

+*----

+      IF(IMPX.GT.0)WRITE(IOUT,1006)

+*     FLUXES

+      DO 50 JGR=1,NGRP

+        WRITE(TEXT,'(A4,I2.2,A4)')'Flux',JGR,'.res'

+        OPEN(UNIT=INIT,FILE=TEXT,STATUS='UNKNOWN')

+        WRITE(INIT,1011)LX,LZ,JGR

+        DO 40 K=1,LZ

+        WRITE(INIT,1009)K

+        WRITE(INIT,1005) (FXYZ(I,K,JGR),I=1,LX)

+   40   CONTINUE

+        CLOSE(UNIT=INIT)

+        IF(IMPX.GT.0)WRITE(IOUT,1003)JGR,TEXT

+   50 CONTINUE

+*

+   60 IF(.NOT.LRAT)GOTO 90

+      IF(IMPX.GT.0)WRITE(IOUT,1007)

+*     RATIOS

+      DO 80 JGR=1,NGRP-1

+        WRITE(TEXT,'(A4,I2.2,A4)')'Rati',JGR,'.res'

+        OPEN(UNIT=INIT,FILE=TEXT,STATUS='UNKNOWN')

+        WRITE(INIT,1012)JGR,NGRP,LX,LZ

+        DO 70 K=1,LZ

+        WRITE(INIT,1009)K

+        WRITE(INIT,1008) (RATIO(I,K,JGR),I=1,LX)

+   70   CONTINUE

+        CLOSE(UNIT=INIT)

+        IF(IMPX.GT.0)WRITE(IOUT,1004)JGR,NGRP,TEXT

+   80 CONTINUE

+   90 RETURN

+*

+ 1000 FORMAT(1X,'MAX FLUX =',1X,1PE12.6,4X,'AT COORD :',1X,

+     1 'HEX # =',I3,2X,'K =',I3,2X,'GROUP #',I2.2/)

+ 1001 FORMAT(1X,'CORE-AVERAGE FLUX =',1X,1PE12.6,

+     1 2X,'=>',2X,'GROUP #',I2.2)

+ 1002 FORMAT(/1X,'OVERALL FLUX-FORM FACTOR FOR GROUP #',I2.2,

+     1 2X,'=>',2X,'AVG/MAX =',1X,F8.4,2X,'(MAX/AVG = ',F8.4,

+     2 ')'/1X,'TOTAL CORE VOLUME =',1X,1PE12.6,1X,'CM3'/)

+ 1003 FORMAT(1X,'FLUXES',2X,'=>',2X,'GROUP #',I2.2,2X,

+     1 '=>',2X,'FILE NAME: <',A10,'>',2X,'=>',2X,'DONE.')

+ 1004 FORMAT(1X,'FLUX RATIOS',2X,'=>',2X,'GR.#',I2.2,

+     1 '/GR.#',I2.2,2X,'=>',2X,'FILE NAME: <',A10,'>',

+     1 2X,'=>',2X,'DONE.')

+ 1005 FORMAT(1X,1P,6E16.8)

+ 1006 FORMAT(/15X,'** PRINTING OF FLUXES ON FILES **'/)

+ 1007 FORMAT(/15X,'** PRINTING OF RATIOS ON FILES **'/)

+ 1008 FORMAT(1X,1P,6E14.6)

+ 1009 FORMAT(//5X,'PLANE-Z #',I2.2/)

+ 1010 FORMAT(/1X,'** COMPUTING FLUX-DISTRIBUTION',

+     1 1X,'OVER THE REACTOR CORE (HEXAGONAL GEOMETRY) **'/)

+ 1011 FORMAT(/10X,5('*'),3X,'FLUX-DISTRIBUTION OVER THE',

+     1 1X,'REACTOR CORE',3X,5('*')//21X,'HEX#=',I2,',',2X,

+     2 'NZ=',I2,',',2X,'GROUP #',I2.2)

+ 1012 FORMAT(/10X,5('*'),3X,'FLUXES RATIO',1X,'#',I2.2,

+     1 '/#',I2.2,1X,'OVER THE REACTOR CORE',3X,5('*')//

+     2 25X,'HEX # =',I2,',',2X,'NZ=',I2)

+      END

diff --git a/Donjon/src/FLPHPR.f b/Donjon/src/FLPHPR.f
new file mode 100644
index 0000000..fd46631
--- /dev/null
+++ b/Donjon/src/FLPHPR.f
@@ -0,0 +1,188 @@
+*DECK FLPHPR

+      SUBROUTINE FLPHPR(IPMAP,NCH,NB,NX,NZ,POWB,PBNM,ICHM,IBNM,POWC,

+     1 PCHM,BAVG,BFACT,CAVG,CFACT,IMPX)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Print the bundle and channel powers over the fuel lattice. Adapted

+* from FLPRNT.

+*

+*Copyright:

+* Copyright (C) 2010 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* V. Descotes

+*

+*Parameters: input/output

+* IPMAP  pointer to fuel-map information.

+* NCH    number of reactor channels.

+* NB     number of fuel bundles per channel.

+* NX     number of elements along x-axis.

+* NZ     number of elements along z-axis.

+* POWB   bundle powers in kW.

+* PBNM   maximum bundle power.

+* ICHM   maximum-power channel number.

+* IBNM   maximum-power bundle number.

+* POWC   channel powers in kW.

+* PCHM   maximum channel power.

+* BAVG   average bundle power.

+* BFACT  bundle power-form factor.

+* CAVG   average channel power.

+* CFACT  channel power-form factor.

+* IMPX   printing index:  0 = no print

+*                         1 = minimal printing

+*                         2 = channel power only

+*                         3 = bundle power by plane only

+*                         10 = bundle power by channel

+*                         any added values of 2, 3 and 10: 5,12,13,15

+*

+*-----------------------------------------------------------------------

+*

+      USE GANLIB

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      TYPE(C_PTR) IPMAP

+      INTEGER NCH,NB,NX,NZ,ICHM,IBNM,IMPX

+      REAL POWB(NCH,NB),POWC(NCH),PBNM,PCHM

+      DOUBLE PRECISION BAVG,CAVG,BFACT

+*----

+*  LOCAL VARIABLES

+*----

+      PARAMETER(IOUT=6)

+      REAL RADB(NX,NB),RADC(NX)

+      INTEGER MIX(NX,NZ)

+      CHARACTER TEXT*12

+*

+      MIX(:NX,:NZ)=0

+      CALL LCMGET(IPMAP,'BMIX',MIX)

+*----

+*  BUNDLE POWERS OVER EACH CHANNEL

+*----

+      WRITE(IOUT,1009)

+      IEL=0

+      ICH=0

+      DO 10 I=1,NX

+      IEL=IEL+1

+      DO 5 K=1,NZ

+      IF(MIX(IEL,K).NE.0)GOTO 6

+    5 CONTINUE

+      GO TO 10

+    6 ICH=ICH+1

+      IF(IMPX.GE.10) THEN

+        WRITE(TEXT,'(A9,I3.3)')'CHANNEL #',ICH

+        WRITE(IOUT,1000)TEXT,POWC(ICH)

+        IF(PBNM.LT.1.)THEN

+          WRITE(IOUT,'(1X,1P,12E11.4)')(POWB(ICH,IB),IB=1,NB)

+        ELSE IF(PBNM.LT.1000.)THEN

+          WRITE(IOUT,'(1X,12F11.3)')(POWB(ICH,IB),IB=1,NB)

+        ELSE

+          WRITE(IOUT,'(1X,12F11.1)')(POWB(ICH,IB),IB=1,NB)

+        ENDIF

+      ENDIF

+   10 CONTINUE

+*

+      IF((IMPX.LT.3).OR.((IMPX.GE.10).AND.(IMPX.LT.13)))GOTO 50

+*----

+*  BUNDLE POWERS PER RADIAL PLANE

+*----

+      RADB(:NX,:NB)=0.0

+      WRITE(IOUT,1010)

+      DO IB=1,NB

+        IEL=0

+        ICH=0

+        DO 20 I=1,NX

+        IEL=IEL+1

+        DO 15 K=1,NZ

+        IF(MIX(IEL,K).NE.0)GOTO 16

+   15   CONTINUE

+        GO TO 20

+   16   ICH=ICH+1

+        RADB(I,IB)=POWB(ICH,IB)

+   20   CONTINUE

+      ENDDO

+      DO IB=1,NB

+        WRITE(IOUT,1011)IB

+      ENDDO

+   50 IF((IMPX.EQ.0).OR.(IMPX.EQ.1).OR.(IMPX.EQ.3).OR.(IMPX.EQ.4)

+     1 .OR.(IMPX.EQ.10).OR.(IMPX.EQ.11).OR.(IMPX.EQ.13).OR.(IMPX.EQ.14))

+     2  GOTO 90

+*----

+*  CHANNEL POWERS IN RADIAL PLANE

+*----

+      RADC(:NX)=0.0

+      WRITE(IOUT,1013)

+      IEL=0

+      ICH=0

+      DO 60 I=1,NX

+      IEL=IEL+1

+      DO 55 K=1,NZ

+      IF(MIX(IEL,K).NE.0)GOTO 56

+   55 CONTINUE

+      GO TO 60

+   56 ICH=ICH+1

+      RADC(I)=POWC(ICH)

+   60 CONTINUE

+      WRITE(IOUT,*)' '

+*----

+*  FINAL INFORMATION

+*----

+   90 WRITE(IOUT,1002)      

+      IF(PBNM.LT.1000.)THEN

+        WRITE(IOUT,1003)PBNM,IBNM

+      ELSE

+        WRITE(IOUT,1016)PBNM,ICHM,IBNM

+      ENDIF

+      IF(BAVG.LT.1000.)THEN

+        WRITE(IOUT,1005)BAVG

+      ELSE

+        WRITE(IOUT,1017)BAVG

+      ENDIF

+      FACT=1./REAL(BFACT)

+      WRITE(IOUT,1006)BFACT,FACT

+      IF(PCHM.LT.10000.)THEN

+        WRITE(IOUT,1004)PCHM,ICHM

+      ELSE

+        WRITE(IOUT,1018)PCHM,ICHM

+      ENDIF

+      IF(CAVG.LT.10000.)THEN

+        WRITE(IOUT,1007)CAVG

+      ELSE

+        WRITE(IOUT,1019)CAVG

+      ENDIF

+      FACT=1./CFACT

+      WRITE(IOUT,1008)CFACT,FACT

+      RETURN

+*

+ 1000 FORMAT(/5X,A12,5X,'CHANNEL POWER =',1X,1P,E11.4,'kW')

+ 1002 FORMAT(/5X,5('--o--',6X)/)

+ 1003 FORMAT(/1X,'MAXIMUM BUNDLE POWER  =',1X,F9.1,1X,'kW',

+     1 3X,'=>',3X,'BUNDLE #',I2.2)

+ 1004 FORMAT(/1X,'MAXIMUM CHANNEL POWER =',1X,F9.1,1X,'kW',

+     1 3X,'=>',3X,'CHANNEL #',I2,3X)

+ 1005 FORMAT(1X,'AVERAGE POWER OVER ALL BUNDLES',

+     1 1X,'=',1X,F9.1,1X,'kW')

+ 1006 FORMAT(1X,'BUNDLE-POWER FORM FACTOR',2X,'=>',2X,

+     1 'AVG/MAX =',1X,F8.4,3X,'(MAX/AVG = ',F8.4,')')

+ 1007 FORMAT(1X,'AVERAGE POWER OVER ALL CHANNELS',

+     1 1X,'=',1X,F9.1,1X,'kW')

+ 1008 FORMAT(1X,'CHANNEL-POWER FORM FACTOR',2X,'=>',2X,

+     1 'AVG/MAX =',1X,F8.4,2X,'(MAX/AVG = ',F8.4,')'/)

+ 1009 FORMAT(/20X,'** BUNDLE POWERS OVER EACH',

+     1 1X,'CHANNEL (kW) **'/)

+ 1010 FORMAT(//20X,'** BUNDLE POWERS PER RADIAL',

+     1 1X,'PLANE **'/)

+ 1011 FORMAT(//1X,'BUNDLE POWERS',1X,'(kW)',1X,

+     1 '=>',1X,'RADIAL PLANE',1X,'#',I2.2/)

+ 1013 FORMAT(//20X,'** CHANNEL POWERS IN RADIAL',

+     1 1X,'PLANE (kW) **'/)

+ 1016 FORMAT(/1X,'MAXIMUM BUNDLE POWER  =',1X,F9.1,1X,'kW',

+     1 3X,'=>',3X,'CHANNEL #',1X,I2,3X,'BUNDLE #',I2.2)

+ 1017 FORMAT(1X,'AVERAGE POWER OVER ALL BUNDLES',

+     1 1X,'=',1X,F9.1,1X,'kW')

+ 1018 FORMAT(/1X,'MAXIMUM CHANNEL POWER =',1X,F9.1,1X,'kW',

+     1 3X,'=>',3X,'CHANNEL #',1X,I2)

+ 1019 FORMAT(1X,'AVERAGE POWER OVER ALL CHANNELS',

+     1 1X,'=',1X,F9.1,1X,'kW')

+      END

diff --git a/Donjon/src/FLPHPW.f b/Donjon/src/FLPHPW.f
new file mode 100644
index 0000000..3ea0bbc
--- /dev/null
+++ b/Donjon/src/FLPHPW.f
@@ -0,0 +1,116 @@
+*DECK FLPHPW

+      SUBROUTINE FLPHPW(NMIX,NGRP,NEL,LX,LZ,MAT,VOL,FLUX,HFAC,PXYZ,

+     1 VTOT,IMPX,LPOW)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Compute and print a power distribution over the whole reactor core

+* in hexagonal geometry.

+*

+*Copyright:

+* Copyright (C) 2007 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* D. Sekki

+*

+*Update(s):

+* V. Descotes 5/06/2010

+*

+*Parameters: input

+* NMIX   maximum number of material mixtures.

+* NGRP   total number of energy groups.

+* NEL    total number of finite elements.

+* LX     number of hexagons.

+* LZ     number of elements along z-axis.

+* FLUX   normalized fluxes associated with each volume.

+* MAT    index-number of mixture assigned to each volume.

+* VOL    element-ordered mesh-splitted volumes.

+* HFAC   h-factors over the reactor core.

+* VTOT   total reactor core volume.

+* IMPX   printing index (=0 for no print).

+* LPOW   file printing flag: =.true. print on file.

+*

+*Parameters: output

+* PXYZ   power distribution over the reactor core.

+*

+*-----------------------------------------------------------------------

+*

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      INTEGER NGRP,NMIX,NEL,LX,LZ,MAT(NEL),IMPX

+      REAL FLUX(NEL,NGRP),VOL(NEL),HFAC(NMIX,NGRP),PXYZ(LX,LZ)

+      DOUBLE PRECISION VTOT

+      LOGICAL LPOW

+*----

+*  LOCAL VARIABLES

+*----

+      PARAMETER(IOUT=6,INIT=1)

+      DOUBLE PRECISION PTOT,XDRCST,EVJ

+      CHARACTER TEXT*12

+*----

+*  CHECK TOTAL POWER

+*----

+      IF(IMPX.GT.0)WRITE(IOUT,1005)

+      EVJ=XDRCST('eV','J')

+      PTOT=0.0D0

+      DO 20 IEL=1,NEL

+      IF(MAT(IEL).EQ.0)GOTO 20

+      DO 10 JGR=1,NGRP

+      PTOT=PTOT+FLUX(IEL,JGR)*VOL(IEL)*HFAC(MAT(IEL),JGR)*EVJ

+   10 CONTINUE

+   20 CONTINUE

+      PAVG=REAL(PTOT/VTOT)

+      IF(IMPX.GT.0)WRITE(IOUT,1001)PTOT,PAVG

+*----

+*  PERFORM CALCULATION

+*----

+      PXYZ(:LX,:LZ)=0.0

+      IEL=0

+      PMAX=0.

+      DO 55 K=1,LZ

+      DO 50 I=1,LX

+      IEL=IEL+1

+      IF(MAT(IEL).EQ.0)GOTO 50

+      DO 40 JGR=1,NGRP

+      PXYZ(I,K)=PXYZ(I,K)+

+     1          HFAC(MAT(IEL),JGR)*FLUX(IEL,JGR)*VOL(IEL)*REAL(EVJ)

+   40 CONTINUE

+      IF(PXYZ(I,K).GT.PMAX)THEN

+        PMAX=PXYZ(I,K)

+        IMX=I

+        KMX=K

+      ENDIF

+   50 CONTINUE

+   55 CONTINUE

+      IF(IMPX.GT.0)WRITE(IOUT,1000)PMAX,IMX,KMX

+      IF(.NOT.LPOW)GOTO 70

+*----

+*  PRINTING

+*----

+      TEXT='Pdistr.res'

+      OPEN(UNIT=INIT,FILE=TEXT,STATUS='UNKNOWN')

+      WRITE(INIT,1008)LX,LZ

+      DO 60 K=1,LZ

+      WRITE(INIT,1007)K

+      WRITE(INIT,1002) (PXYZ(I,K),I=1,LX)

+   60 CONTINUE

+      CLOSE(UNIT=INIT)

+      IF(IMPX.GT.0)WRITE(IOUT,1006)TEXT

+   70 RETURN

+*

+ 1000 FORMAT(/1X,'MAX POWER =',1P,E13.6,1X,'WATTS',4X,

+     1 'AT COORD :',1X,'HEX # =',I3,2X,'K =',I3/)

+ 1001 FORMAT(1X,'COMPUTED TOTAL POWER :',1P,E15.8,1X,'WATTS'/

+     1 1X,'MEAN POWER DENSITY',3X,':',1P,E15.8,1X,'WATTS/CM3')

+ 1002 FORMAT(6(1P,E15.8))

+ 1005 FORMAT(/1X,'** COMPUTING POWER-DISTRIBUTION OVER',

+     1 1X,'THE REACTOR CORE (HEXAGONAL GEOMETRY) **'/)

+ 1006 FORMAT(/1X,'PRINTING POWER-DISTRIBUTION ON FILE:',

+     1 1X,'<',A10,'>',3X,'=>',2X,'DONE.')

+ 1007 FORMAT(//3X,'PLANE-Z #',I2.2/)

+ 1008 FORMAT(/10X,5('*'),3X,'POWER-DISTRIBUTION OVER THE',

+     1 1X,'REACTOR CORE',3X,5('*')//25X,'NHEX=',I2,',',

+     2 2X,'NZ=',I2)

+      END

diff --git a/Donjon/src/FLPNRM.f b/Donjon/src/FLPNRM.f
new file mode 100644
index 0000000..d22c3e5
--- /dev/null
+++ b/Donjon/src/FLPNRM.f
@@ -0,0 +1,104 @@
+*DECK FLPNRM
+      SUBROUTINE FLPNRM(IPFLX,IPKIN,IPTRK,NMIX,NGRP,NEL,NUN,EVECT,FLUX,
+     1 MAT,VOL,IDL,HFAC,PTOT,ZNRM,IMPX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover element-ordered fluxes associated with each mesh-splitted
+* volume over the whole reactor core, normalize fluxes to a given
+* total reactor power.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki
+*
+*Parameters: input
+* IPFLX  pointer to flux information.
+* IPKIN  pointer to kinetics information.
+* IPTRK  pointer to tracking information.
+* NMIX   maximum number of material mixtures.
+* NGRP   total number of energy groups.
+* NEL    total number of finite elements.
+* NUN    total number of unknowns per group.
+* HFAC   h-factors over the reactor core.
+* PTOT   given total reactor power in watts.
+* IMPX   printing index (=0 for no print).
+*
+*Parameters: output
+* FLUX   normalized fluxes associated with each volume.
+* MAT    index-number of mixture assigned to each volume.
+* VOL    element-ordered mesh-splitted volumes.
+* ZNRM   flux normalization factor.
+*
+*Parameters: scratch
+* EVECT
+* IDL
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPFLX,IPKIN,IPTRK
+      INTEGER NUN,NEL,NGRP,NMIX,IMPX,IDL(NEL),MAT(NEL)
+      REAL FLUX(NEL,NGRP),EVECT(NUN,NGRP),HFAC(NMIX,NGRP),VOL(NEL)
+      DOUBLE PRECISION ZNRM,PTOT
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(IOUT=6)
+      TYPE(C_PTR) JPFLX
+      DOUBLE PRECISION XDRCST,EVJ
+*----
+*  RECOVER INFORMATION
+*----
+      EVECT(:NUN,:NGRP)=0.0
+      IF(C_ASSOCIATED(IPFLX)) THEN
+*       L_FLUX object
+        JPFLX=LCMGID(IPFLX,'FLUX')
+        DO 10 JGR=1,NGRP
+        CALL LCMGDL(JPFLX,JGR,EVECT(1,JGR))
+   10   CONTINUE
+      ELSE IF(C_ASSOCIATED(IPKIN)) THEN
+*       L_KINET object
+        CALL LCMGET(IPKIN,'E-VECTOR',EVECT)
+      ENDIF
+*
+      MAT(:NEL)=0
+      CALL LCMGET(IPTRK,'MATCOD',MAT)
+      IDL(:NEL)=0
+      CALL LCMGET(IPTRK,'KEYFLX',IDL)
+      VOL(:NEL)=0.0
+      CALL LCMGET(IPTRK,'VOLUME',VOL)
+*----
+*  FLUX NORMALIZATION
+*----
+      EVJ=XDRCST('eV','J')
+      ZNRM=0.0D0
+      IF(IMPX.GT.0)WRITE(IOUT,1002)
+      FLUX(:NEL,:NGRP)=0.0
+      DO 25 JGR=1,NGRP
+      DO 20 IEL=1,NEL
+      IF(MAT(IEL).EQ.0)GOTO 20
+      FLUX(IEL,JGR)=EVECT(IDL(IEL),JGR)
+      ZNRM=ZNRM+HFAC(MAT(IEL),JGR)*FLUX(IEL,JGR)*VOL(IEL)*EVJ
+   20 CONTINUE
+   25 CONTINUE
+      ZNRM=PTOT/ZNRM
+      IF(IMPX.GT.0)WRITE(IOUT,1000) PTOT,ZNRM
+      DO 35 JGR=1,NGRP
+      DO 30 IEL=1,NEL
+      FLUX(IEL,JGR)=FLUX(IEL,JGR)*REAL(ZNRM)
+   30 CONTINUE
+   35 CONTINUE
+      RETURN
+*
+ 1000 FORMAT(/37H FLPNRM: GIVEN TOTAL REACTOR POWER =>,1P,E15.8,1X,
+     1 5HWATTS/37H FLPNRM: FLUX NORMALIZATION FACTOR =>,1P,E15.8)
+ 1002 FORMAT(/53H FLPNRM: ** NORMALIZING FLUXES TO A GIVEN REACTOR POW,
+     1 5HER **)
+      END
diff --git a/Donjon/src/FLPOW.f b/Donjon/src/FLPOW.f
new file mode 100644
index 0000000..7de9241
--- /dev/null
+++ b/Donjon/src/FLPOW.f
@@ -0,0 +1,291 @@
+*DECK FLPOW
+      SUBROUTINE FLPOW(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* compute and print power and flux distributions over the reactor core.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki
+*
+*Update(s):
+*  M. Guyot 15/07/10 : Creation of L_FLUX object to be used by
+*  module DETECT:, 
+*  
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The FLPOW: module specifications are:
+* Option 1
+* POWER [ NRMFLUX ] [ FMAP ] := FLPOW:  [ POWOLD ] FMAP
+*  { FLUX | KINET } TRACK MATEX [ MACRO ] :: (descflpow} ;
+* Option 2
+* POWER := FLPOW:  [ POWOLD ] { FLUX | KINET }  TRACK MACRO :: (descflpow) ;
+* where
+*   POWER   : name of the \emph{power} object that will be created by the 
+*     module. It will contain the information related to the reactor fluxes 
+*     and powers.
+*   NRMFLUX : name of the \emph{flux} object, in creation mode. According to 
+*     the chosen option, this object contains either the fluxes normalized to 
+*     the given total reactor power or the fluxes per bundle. Is it useful if 
+*     you want to compute the detectors readings with the DETECT: module.
+*   POWOLD  : name of the read-only \emph{power} object. It must contain the 
+*     previously computed flux normalization factor, which corresponds to the 
+*     reactor nominal or equilibrium conditions.
+*   FMAP    : name of the \emph{fmap} object containing the fuel lattice 
+*     specification. When FMAP is specified on the RHS, the fluxes and powers 
+*     calculations are performed over the fuel lattice as well as over the 
+*     whole reactor geometry. If FMAP is specified on the LHS, its records 
+*     'BUND-PW' and 'FLUX-AV' will be set according to the information present 
+*     in POWER.
+*   FLUX    : name of the \emph{flux} object, previously created by the 
+*     FLUD: module. The numerical flux solution contained in FLUX is 
+*     recovered and all flux are normalized to the given total reactor power.
+*   KINET   : name of the \emph{kinet} object, previously created by the 
+*     KINSOL: module. The numerical flux solution contained in KINET is 
+*     recovered.
+*   TRACK   : name of the \emph{track} object, created by the TRIVAT: module. 
+*     The information stored in TRACK is recovered and used for the average 
+*     flux calculation.
+*   MATEX   : name of the \emph{matex} object, containing the reactor material 
+*     index and the h-factors that will be recovered and used for the power 
+*     calculation.
+*   MACRO name of the \emph{macrolib} object, containing the h-factors that 
+*     will be recovered and used for the power calculation.
+*   (descflpow) : structure describing the input data to the FLPOW: module .
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      CHARACTER HSIGN*12,TEXT*12
+      LOGICAL LNEW,LMAP,LFLX,LRAT,LPOW,LFSTH,LFLU,LNRM,LBUN
+      DOUBLE PRECISION DFLOT
+      TYPE(C_PTR) IPPOW,IPFLX,IPKIN,IPTRK,IPMTX,IPMAP,IPMAC,IPNFX
+*----
+*  PARAMETER VALIDATION
+*----
+      LFLU=.FALSE.
+      IF(NENTRY.LT.4)CALL XABORT('@FLPOW: PARAMETER EXPECTED.')
+      TEXT=HENTRY(1)
+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2))CALL XABORT('@FLPOW'
+     1 //': LCM OBJECT FOR L_POWER EXPECTED AT LHS ('//TEXT//').')
+      IF(JENTRY(1).NE.0)CALL XABORT('@FLPOW: CREATE MODE FOR L_POW'
+     1 //'ER EXPECTED AT LHS ('//TEXT//').')
+      IPPOW=KENTRY(1)
+      IF(JENTRY(2).EQ.0)THEN
+        LFLU=.TRUE.
+        IPNFX=KENTRY(2)
+      ENDIF
+      IPFLX=C_NULL_PTR
+      IPKIN=C_NULL_PTR
+      IPTRK=C_NULL_PTR
+      IPMTX=C_NULL_PTR
+      IPMAP=C_NULL_PTR
+      IPMAC=C_NULL_PTR
+      LNEW=.FALSE.
+      JMOD=0
+      IF(LFLU)THEN
+        NRHS=3
+      ELSE
+        NRHS=2
+        IPNFX=C_NULL_PTR
+      ENDIF
+      DO 10 IEN=NRHS,NENTRY
+      IF((IENTRY(IEN).NE.1).AND.(IENTRY(IEN).NE.2))CALL XABORT('@F'
+     1 //'LPOW: LCM OBJECT EXPECTED AT THE RHS.')
+      CALL LCMGTC(KENTRY(IEN),'SIGNATURE',12,HSIGN)
+      IF(HSIGN.EQ.'L_POWER')THEN
+        IF(JENTRY(IEN).NE.2)CALL XABORT('@FLPOW: READ-ONLY MODE EXPE'
+     1  //'CTED FOR THE L_POWER OBJECT AT RHS.')
+        IF(LNEW)CALL XABORT('@FLPOW: L_POWER ALREADY DEFINED AT RHS.')
+        CALL LCMEQU(KENTRY(IEN),IPPOW)
+        LNEW=.TRUE.
+      ELSEIF(HSIGN.EQ.'L_MATEX')THEN
+        IF(JENTRY(IEN).NE.2)CALL XABORT('@FLPOW: READ-ONLY MODE EXPE'
+     1  //'CTED FOR THE L_MATEX OBJECT AT RHS.')
+        IF(.NOT.C_ASSOCIATED(IPMTX))THEN
+          IPMTX=KENTRY(IEN)
+        ELSE
+          CALL XABORT('@FLPOW: L_MATEX ALREADY DEFINED.')
+        ENDIF
+      ELSEIF(HSIGN.EQ.'L_FLUX')THEN
+        IF(JENTRY(IEN).NE.2)CALL XABORT('@FLPOW: READ-ONLY MODE EXPE'
+     1  //'CTED FOR THE L_FLUX OBJECT AT RHS.')
+        IF(.NOT.C_ASSOCIATED(IPFLX))THEN
+          IPFLX=KENTRY(IEN)
+        ELSE
+          CALL XABORT('@FLPOW: L_FLUX ALREADY DEFINED.')
+        ENDIF
+      ELSEIF(HSIGN.EQ.'L_KINET')THEN
+        IF(JENTRY(IEN).NE.2)CALL XABORT('@FLPOW: READ-ONLY MODE EXPE'
+     1  //'CTED FOR THE L_KINET OBJECT AT RHS.')
+        IF(.NOT.C_ASSOCIATED(IPKIN))THEN
+          IPKIN=KENTRY(IEN)
+        ELSE
+          CALL XABORT('@FLPOW: L_KINET ALREADY DEFINED.')
+        ENDIF
+      ELSEIF(HSIGN.EQ.'L_TRACK')THEN
+        IF(JENTRY(IEN).NE.2)CALL XABORT('@FLPOW: READ-ONLY MODE EXPE'
+     1  //'CTED FOR THE L_TRACK OBJECT AT RHS.')
+        IF(.NOT.C_ASSOCIATED(IPTRK))THEN
+          IPTRK=KENTRY(IEN)
+        ELSE
+          CALL XABORT('@FLPOW: L_TRACK ALREADY DEFINED.')
+        ENDIF
+      ELSEIF(HSIGN.EQ.'L_MACROLIB')THEN
+        IF(JENTRY(IEN).NE.2)CALL XABORT('@FLPOW: READ-ONLY MODE EXPE'
+     1  //'CTED FOR THE L_MACROLIB OBJECT AT RHS.')
+        IF(.NOT.C_ASSOCIATED(IPMAC))THEN
+          IPMAC=KENTRY(IEN)
+        ELSE
+          CALL XABORT('@FLPOW: L_MACROLIB ALREADY DEFINED.')
+        ENDIF
+      ELSEIF(HSIGN.EQ.'L_MAP')THEN
+        IF(JENTRY(IEN).EQ.1) JMOD=1
+        IF(.NOT.C_ASSOCIATED(IPMAP))THEN
+          IPMAP=KENTRY(IEN)
+        ELSE
+          CALL XABORT('@FLPOW: L_MAP ALREADY DEFINED.')
+        ENDIF
+      ENDIF
+   10 CONTINUE
+      IF((.NOT.C_ASSOCIATED(IPFLX)).AND.(.NOT.C_ASSOCIATED(IPKIN))) THEN
+         CALL XABORT('@FLPOW: MISSING L_FLUX OR L_KINET OBJECT.')
+      ELSE IF((C_ASSOCIATED(IPFLX)).AND.(C_ASSOCIATED(IPKIN))) THEN
+         CALL XABORT('@FLPOW: L_FLUX AND L_KINET OBJECTS BOTH DEFINED.')
+      ELSE IF(.NOT.C_ASSOCIATED(IPTRK)) THEN
+         CALL XABORT('@FLPOW: MISSING L_TRACK OBJECT.')
+      ELSE IF((C_ASSOCIATED(IPMAP)).AND.(.NOT.C_ASSOCIATED(IPMTX))) THEN
+         CALL XABORT('@FLPOW: MISSING L_MATEX OBJECT.')
+      ELSE IF((.NOT.C_ASSOCIATED(IPMAP)).AND.(C_ASSOCIATED(IPMTX))) THEN
+         CALL XABORT('@FLPOW: MISSING L_MAP OBJECT.')
+      ELSE IF((.NOT.C_ASSOCIATED(IPMTX)).AND.
+     1        (.NOT.C_ASSOCIATED(IPMAC))) THEN
+         CALL XABORT('@FLPOW: MISSING L_MATEX OR L_MACROLIB OBJECT.')
+      ELSE IF((.NOT.C_ASSOCIATED(IPMAP)).AND.
+     1        (.NOT.C_ASSOCIATED(IPMAC))) THEN
+         CALL XABORT('@FLPOW: MISSING L_MAP OR L_MACROLIB OBJECT.')
+      ENDIF
+*----
+*  READ KEYWORD
+*----
+      IMPX=1
+      PTOT=0.0
+      LFSTH=.FALSE.
+      LNRM=.FALSE.
+      LBUN=.FALSE.
+      FSTH=0.0
+      LFLX=.FALSE.
+      LPOW=.FALSE.
+      LMAP=.FALSE.
+      LRAT=.FALSE.
+   20 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.EQ.10) GO TO 40
+   30 IF(ITYP.NE.3)CALL XABORT('@FLPOW: CHARACTER DATA EXPECTED.')
+      IF(TEXT.EQ.'EDIT') THEN
+*       PRINTING INDEX
+        CALL REDGET(ITYP,IMPX,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@FLPOW: INTEGER DATA EXPECTED.')
+      ELSE IF(TEXT.EQ.'P-NEW') THEN
+        IF(.NOT.LNEW)CALL XABORT('@FLPOW: MISSING READ-ONLY L_POWER'
+     1  //' OBJECT AT RHS.')
+      ELSE IF(TEXT.EQ.'PTOT') THEN
+        IF(LNEW)CALL XABORT('@FLPOW: ONLY ONE L_POWER OBJECT IN CRE'
+     1  //'ATE MODE EXPECTED WITH PTOT OPTION.')
+        CALL REDGET(ITYP,NITMA,PTOT,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@FLPOW: REAL FOR PTOT EXPECTED.')
+        IF(PTOT.LE.0.)CALL XABORT('@FLPOW: INVALID VALUE PTOT < 0.')
+      ELSE IF(TEXT.EQ.'FSTH') THEN
+        CALL REDGET(ITYP,NITMA,FSTH,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@FLPOW: REAL DATA EXPECTED FOR FSTH.')
+        IF((FSTH.GT.1.0).OR.(FSTH.LE.0.0)) CALL XABORT('@FLPOW: FSTH '
+     1  //'SHOULD BE BETWEEN 0.0 AND 1.0.')
+        LFSTH=.TRUE.
+      ELSE IF(TEXT.EQ.'NORM') THEN
+        LNRM=.TRUE.
+      ELSE IF(TEXT.EQ.'BUND') THEN
+        IF(.NOT.C_ASSOCIATED(IPMAP)) CALL XABORT('@FLPOW: NO RHS FUELM'
+     1  //'AP DEFINED.')
+        LBUN=.TRUE.
+      ELSE IF(TEXT.EQ.'PRINT') THEN
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(TEXT.EQ.'MAP')THEN
+          IF(.NOT.C_ASSOCIATED(IPMAP))CALL XABORT('@FLPOW: INVALID KEY'
+     1    //'WORD MAP. MISSING L_MAP OBJECT FOR PRINT.')
+          LMAP=.TRUE.
+        ELSEIF(TEXT.EQ.'ALL')THEN
+          LFLX=.TRUE.
+          LPOW=.TRUE.
+          IF(C_ASSOCIATED(IPMAP))LMAP=.TRUE.
+          LRAT=.TRUE.
+        ELSEIF(TEXT.EQ.'DISTR')THEN
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+          IF(ITYP.NE.3)CALL XABORT('@FLPOW: CHARACTER DATA EXPECTED AF'
+     1    //'TER DISTR.')
+          IF(TEXT.EQ.'FLUX')THEN
+            IF(LFLX)CALL XABORT('@FLPOW: KEYWORD FLUX ALREADY READ.')
+            LFLX=.TRUE.
+          ELSEIF(TEXT.EQ.'POWER')THEN
+            IF(LPOW)CALL XABORT('@FLPOW: KEYWORD POWER ALREADY READ.')
+            LPOW=.TRUE.
+          ELSEIF(TEXT.EQ.'RATIO')THEN
+            IF(LRAT)CALL XABORT('@FLPOW: KEYWORD RATIO ALREADY READ.')
+            LRAT=.TRUE.
+          ELSE
+            GO TO 30
+          ENDIF
+        ELSE
+          CALL XABORT('@FLPOW: KEYWORD MAP/DISTR/ALL EXPECTED.')
+        ENDIF
+      ELSE IF(TEXT.EQ.'INIT') THEN
+        IF(JENTRY(IEN).EQ.1) JMOD=2
+      ELSE IF(TEXT.EQ.';') THEN
+        GO TO 40
+      ELSE
+        CALL XABORT('@FLPOW: INVALID KEYWORD '//TEXT//'.')
+      ENDIF
+      GO TO 20
+*----
+*  CHECK CONSISTENCY
+*----
+   40 IF(LMAP) THEN
+        IF(.NOT.C_ASSOCIATED(IPMAP)) THEN
+           CALL XABORT('@FLPOW: MISSING L_MAP OBJECT.')
+        ELSE IF(.NOT.C_ASSOCIATED(IPMTX)) THEN
+           CALL XABORT('@FLPOW: MISSING L_MATEX OBJECT.')
+        ELSE IF(.NOT.C_ASSOCIATED(IPMAC)) THEN
+           CALL XABORT('@FLPOW: MISSING L_MACROLIB OBJECT.')
+        ENDIF
+      ENDIF
+*----
+*  PERFORM CALCULATION
+*----
+      CALL FLPDRV(IPPOW,IPNFX,IPFLX,IPKIN,IPTRK,IPMTX,IPMAP,IPMAC,PTOT,
+     1 LNEW,LMAP,JMOD,LFLX,LPOW,LRAT,IMPX,FSTH,LFSTH,LFLU,LBUN,LNRM)
+      RETURN
+      END
diff --git a/Donjon/src/FLPOWB.f b/Donjon/src/FLPOWB.f
new file mode 100644
index 0000000..2bafb80
--- /dev/null
+++ b/Donjon/src/FLPOWB.f
@@ -0,0 +1,230 @@
+*DECK FLPOWB

+      SUBROUTINE FLPOWB(IPPOW,IPMAP,IPMTX,NMIX,NMAT,NGRP,NCH,NB,NEL,MAT,

+     1 VOL,HFAC,FLUX,POWB,POWC,IMPX,PTOT,FSTH,LFSTH,FMIX,FLUB,IGEO)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Compute the channel and bundle powers over the fuel lattice.

+*

+*Copyright:

+* Copyright (C) 2007 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* D. Sekki, M. Guyot, V. Descotes

+*

+*Parameters: input

+* IPPOW  pointer to power information.

+* IPMAP  pointer to fuel-map information.

+* IPMTX  pointer to matex information.

+* NMIX   maximum number of material mixtures.

+* NMAT   total number of mixtures (includes virtual regions).

+* NGRP   number of energy groups.

+* NCH    number of reactor channels.

+* NB     number of fuel bundles per channel.

+* NEL    total number of finite elements.

+* MAT    index-number of mixture assigned to each volume.

+* VOL    element-ordered mesh-splitted volumes.

+* HFAC   h-factors over the reactor core.

+* FLUX   normalized average fluxes associated with each volume.

+* IMPX   printing index (=0 for no print).

+* PTOT   total power in MW

+* FSTH   thermal to fission ratio power

+* LFSTH  boolean =.true. if FSTH is specified

+* FMIX   fuel bundle indices.

+* FLUB   normalized average fluxes associated with each bundle

+* IGEO   type of the geometry (=7 or =9)

+*

+*Parameters: output

+* POWB   bundle powers in kW.

+* POWC   channel powers in kW.

+*

+*-----------------------------------------------------------------------

+*

+      USE GANLIB

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      TYPE(C_PTR) IPPOW,IPMAP,IPMTX

+      INTEGER NMIX,NMAT,NCH,NB,NGRP,NEL,MAT(NEL),IMPX,NX,NY,NZ,IGEO,

+     1        FMIX(NCH*NB)

+      REAL HFAC(NMIX,NGRP),VOL(NEL),FLUX(NEL,NGRP),BFACT1,CFACT1,

+     1     POWB(NCH,NB),POWC(NCH),FSTH,FLUB(NCH,NB,NGRP)

+      LOGICAL LFSTH

+*----

+*  LOCAL VARIABLES

+*----

+      PARAMETER(NSTATE=40,IOUT=6)

+      INTEGER IGST(NSTATE),FMAT(NMAT),IB,ICH,IEL,ICMX,IBMX,IPCH

+      DOUBLE PRECISION POWER,BAVG,CAVG,BFACT,XDRCST,EVJ

+      REAL PBMX,VTOT,VOLB(NCH,NB)

+      CHARACTER TEXT*12

+      TYPE(C_PTR) JPMAP

+*----

+*  BUNDLE POWERS

+*----

+      PBMX=0.

+      BAVG=0.0D0

+      POWER=0.0D0

+      IBMX=0

+      ICMX=0

+      FMAT(:NMAT)=0

+      CALL LCMGET(IPMTX,'MAT',FMAT)

+      POWB(:NCH,:NB)=0.0

+      IF(IMPX.GT.0)WRITE(IOUT,1004)

+*

+      EVJ=XDRCST('eV','J')

+      NTOT=0

+      DO 35 IB=1,NB

+      DO 30 ICH=1,NCH

+      POWB(ICH,IB)=0.0

+      VOLB(ICH,IB)=0.0

+      NUM=(IB-1)*NCH+ICH

+      IF(FMIX(NUM).EQ.0) GO TO 30

+      NTOT=NTOT+1

+      DO 20 IEL=1,NEL

+      IF((FMAT(IEL).EQ.-NTOT).AND.(MAT(IEL).GT.0)) THEN

+         DO 10 JGR=1,NGRP

+         POWB(ICH,IB)=POWB(ICH,IB)+

+     1     FLUX(IEL,JGR)*HFAC(MAT(IEL),JGR)*VOL(IEL)*REAL(EVJ)

+   10    CONTINUE

+         VOLB(ICH,IB)=VOLB(ICH,IB)+VOL(IEL)

+      ENDIF

+   20 CONTINUE

+      POWER=POWER+DBLE(POWB(ICH,IB))

+   30 CONTINUE

+   35 CONTINUE

+      POWER=POWER/(10**6)

+      VTOT=0.0

+      DO 45 IB=1,NB

+      DO 40 ICH=1,NCH

+      POWB(ICH,IB)=POWB(ICH,IB)/1000.

+      IF(POWB(ICH,IB).GT.PBMX)THEN

+        PBMX=POWB(ICH,IB)

+        ICMX=ICH

+        IBMX=IB

+      ENDIF

+      BAVG=BAVG+DBLE(POWB(ICH,IB)*VOLB(ICH,IB))

+      VTOT=VTOT+VOLB(ICH,IB)

+   40 CONTINUE

+   45 CONTINUE

+      BAVG=BAVG/VTOT

+      BFACT=BAVG/PBMX

+

+*     CHECK TOTAL POWER

+      IF(IMPX.EQ.99)WRITE(IOUT,1000)POWER

+      IF((IMPX.EQ.0).OR.(IMPX.GT.1))GOTO 50

+      WRITE(TEXT,'(A9,I3.3)')'CHANNEL #',ICMX

+      IF(PBMX.LT.1000.)THEN

+        WRITE(IOUT,1001)PBMX,TEXT,IBMX

+      ELSE

+        WRITE(IOUT,1011)PBMX,TEXT,IBMX

+      ENDIF

+      IF(BAVG.LT.1000.)THEN

+        WRITE(IOUT,1007)BAVG

+      ELSE

+        WRITE(IOUT,1012)BAVG

+      ENDIF

+      FACT=1./REAL(BFACT)

+      WRITE(IOUT,1009)BFACT,FACT

+*----

+*  CHANNEL POWERS

+*----

+   50 PCMX=0.

+      CAVG=0.0D0

+      POWER=0.0D0

+      POWC(:NCH)=0.0

+      DO 70 ICH=1,NCH

+      VOLCH=0.0

+      DO 60 IB=1,NB

+      POWC(ICH)=POWC(ICH)+POWB(ICH,IB)

+      VOLCH=VOLCH+VOLB(ICH,IB)

+   60 CONTINUE

+      POWER=POWER+DBLE(POWC(ICH))

+      IF(POWC(ICH).GT.PCMX)THEN

+        PCMX=POWC(ICH)

+        IPCH=ICH

+      ENDIF

+      CAVG=CAVG+DBLE(POWC(ICH)*VOLCH)

+   70 CONTINUE

+      POWER=POWER/(10**3)

+      CAVG=CAVG/VTOT

+      CFACT=REAL(CAVG)/PCMX

+*----

+*  THERMAL TO FISSION RATIO POWER

+*----

+      IF(LFSTH) THEN

+        CALL FLFSTH(PTOT,POWER,POWC,POWB,FLUX,NGRP,NCH,

+     +              NB,NEL,FSTH,FLUB)

+      ENDIF

+

+      IF(IMPX.EQ.0)GOTO 90

+*     CHECK TOTAL POWER

+      IF(IMPX.EQ.99)WRITE(IOUT,1002)POWER

+      IF(IMPX.GT.1)GOTO 80

+      WRITE(TEXT,'(A9,I3.3)')'CHANNEL #',IPCH

+      IF(PCMX.LT.10000.)THEN

+        WRITE(IOUT,1003)PCMX,TEXT

+      ELSE

+        WRITE(IOUT,1013)PCMX,TEXT

+      ENDIF

+      IF(CAVG.LT.10000.)THEN

+        WRITE(IOUT,1008)CAVG

+      ELSE

+        WRITE(IOUT,1014)CAVG

+      ENDIF

+      FACT=1./CFACT

+      WRITE(IOUT,1010)CFACT,FACT

+      GOTO 90

+*----

+*  PRINTING

+*----

+   80 JPMAP=LCMGID(IPMAP,'GEOMAP')

+      CALL LCMGET(JPMAP,'STATE-VECTOR',IGST)

+      NX=IGST(3)

+      NY=IGST(4)

+      NZ=IGST(5)

+      IF(IGEO.NE.IGST(1)) CALL XABORT('@FLPOWB: WRONG GEOMETRY '

+     1 // 'EMBEDDED IN THE FUEL MAP')

+      IF(IGEO.EQ.7) THEN

+        CALL FLPRNT(IPMAP,NCH,NB,NX,NY,NZ,POWB,PBMX,ICMX,

+     1   IBMX,POWC,PCMX,IPCH,BAVG,BFACT,CAVG,CFACT,IMPX)

+      ELSEIF(IGEO.EQ.9) THEN

+        CALL FLPHPR(IPMAP,NCH,NB,NX,NZ,POWB,PBMX,ICMX,

+     1   IBMX,POWC,PCMX,BAVG,BFACT,CAVG,CFACT,IMPX)

+      ENDIF

+   90 BFACT1=1./REAL(BFACT)

+      CALL LCMPUT(IPPOW,'PMAX-BUND',1,2,PBMX)

+      CALL LCMPUT(IPPOW,'FORM-BUND',1,2,BFACT1)

+      CFACT1=1./CFACT

+      CALL LCMPUT(IPPOW,'PMAX-CHAN',1,2,PCMX)

+      CALL LCMPUT(IPPOW,'FORM-CHAN',1,2,CFACT1)

+      RETURN

+*

+ 1000 FORMAT(1X,'COMPUTED TOTAL POWER OVER ',

+     1  'ALL BUNDLES =>',1P,E13.6,1X,'MW')

+ 1001 FORMAT(1X,'MAXIMUM BUNDLE POWER =',1X,F9.1,

+     1  1X,'kW',2X,'=>',2X,A12,2X,'BUNDLE #',I2.2)

+ 1002 FORMAT(1X,'COMPUTED TOTAL POWER OVER',

+     1  'ALL CHANNELS =>',1P,E13.6,1X,'MW')

+ 1003 FORMAT(1X,'MAXIMUM CHANNEL POWER =',1X,F9.1,

+     1  1X,'kW',2X,'=>',2X,A12)

+ 1004 FORMAT(/1X,'** COMPUTING CHANNEL AND',

+     1 1X,'BUNDLE POWERS **'/)

+ 1007 FORMAT(1X,'AVERAGE POWER OVER ALL BUNDLES',

+     1 1X,'=',1X,F9.1,1X,'kW')

+ 1008 FORMAT(1X,'AVERAGE POWER OVER ALL CHANNELS',

+     1 1X,'=',1X,F9.1,1X,'kW')

+ 1009 FORMAT(1X,'BUNDLE-POWER FORM FACTOR',2X,'=>',2X,

+     1 'AVG/MAX =',1X,F8.4,3X,'(MAX/AVG = ',F8.4,')'/)

+ 1010 FORMAT(1X,'CHANNEL-POWER FORM FACTOR',2X,'=>',2X,

+     1 'AVG/MAX =',1X,F8.4,3X,'(MAX/AVG = ',F8.4,')'/)

+ 1011 FORMAT(1X,'MAXIMUM BUNDLE POWER =',1X,F9.1,

+     1  1X,'kW',2X,'=>',2X,A12,2X,'BUNDLE #',I2.2)

+ 1012 FORMAT(1X,'AVERAGE POWER OVER ALL BUNDLES',

+     1 1X,'=',1X,F9.1,1X,'kW')

+ 1013 FORMAT(1X,'MAXIMUM CHANNEL POWER =',1X,F9.1,

+     1  1X,'kW',2X,'=>',2X,A12)

+ 1014 FORMAT(1X,'AVERAGE POWER OVER ALL CHANNELS',

+     1 1X,'=',1X,F9.1,1X,'kW')

+      END

diff --git a/Donjon/src/FLPOWR.f b/Donjon/src/FLPOWR.f
new file mode 100644
index 0000000..7125b83
--- /dev/null
+++ b/Donjon/src/FLPOWR.f
@@ -0,0 +1,118 @@
+*DECK FLPOWR

+      SUBROUTINE FLPOWR(NMIX,NGRP,NEL,LX,LY,LZ,MAT,VOL,FLUX,HFAC,PXYZ,

+     1 VTOT,IMPX,LPOW)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Compute and print a power distribution over the whole reactor core.

+*

+*Copyright:

+* Copyright (C) 2007 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* D. Sekki

+*

+*Parameters: input

+* NMIX   maximum number of material mixtures.

+* NGRP   total number of energy groups.

+* NEL    total number of finite elements.

+* LX     number of elements along x-axis.

+* LY     number of elements along y-axis.

+* LZ     number of elements along z-axis.

+* FLUX   normalized fluxes associated with each volume.

+* MAT    index-number of mixture assigned to each volume.

+* VOL    element-ordered mesh-splitted volumes.

+* HFAC   h-factors over the reactor core.

+* VTOT   total reactor core volume.

+* IMPX   printing index (=0 for no print).

+* LPOW   file printing flag: =.true. print on file.

+*

+*Parameters: output

+* PXYZ   power distribution over the reactor core.

+*

+*-----------------------------------------------------------------------

+*

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      INTEGER NGRP,NMIX,NEL,LX,LY,LZ,MAT(NEL),IMPX

+      REAL FLUX(NEL,NGRP),VOL(NEL),HFAC(NMIX,NGRP),PXYZ(LX,LY,LZ)

+      DOUBLE PRECISION VTOT

+      LOGICAL LPOW

+*----

+*  LOCAL VARIABLES

+*----

+      PARAMETER(IOUT=6,INIT=1)

+      DOUBLE PRECISION PTOT,XDRCST,EVJ

+      CHARACTER TEXT*12

+*----

+*  CHECK TOTAL POWER

+*----

+      IF(IMPX.GT.0)WRITE(IOUT,1005)

+      EVJ=XDRCST('eV','J')

+      PTOT=0.0D0

+      DO 20 IEL=1,NEL

+      IF(MAT(IEL).EQ.0)GOTO 20

+      DO 10 JGR=1,NGRP

+      PTOT=PTOT+FLUX(IEL,JGR)*VOL(IEL)*HFAC(MAT(IEL),JGR)*EVJ

+   10 CONTINUE

+   20 CONTINUE

+      PAVG=REAL(PTOT/VTOT)

+      IF(IMPX.GT.0)WRITE(IOUT,1001)PTOT,PAVG

+*----

+*  PERFORM CALCULATION

+*----

+      PXYZ(:LX,:LY,:LZ)=0.0

+      IEL=0

+      PMAX=0.

+      DO 52 K=1,LZ

+      DO 51 J=1,LY

+      DO 50 I=1,LX

+      IEL=IEL+1

+      IF(MAT(IEL).EQ.0)GOTO 50

+      DO 40 JGR=1,NGRP

+      PXYZ(I,J,K)=PXYZ(I,J,K)+

+     1            HFAC(MAT(IEL),JGR)*FLUX(IEL,JGR)*VOL(IEL)*REAL(EVJ)

+   40 CONTINUE

+      IF(PXYZ(I,J,K).GT.PMAX)THEN

+        PMAX=PXYZ(I,J,K)

+        IMX=I

+        JMX=J

+        KMX=K

+      ENDIF

+   50 CONTINUE

+   51 CONTINUE

+   52 CONTINUE

+      IF(IMPX.GT.0)WRITE(IOUT,1000)PMAX,IMX,JMX,KMX

+      IF(.NOT.LPOW)GOTO 70

+*----

+*  PRINTING

+*----

+      TEXT='Pdistr.res'

+      OPEN(UNIT=INIT,FILE=TEXT,STATUS='UNKNOWN')

+      WRITE(INIT,1008)LX,LY,LZ

+      DO 65 K=1,LZ

+      DO 60 J=1,LY

+      WRITE(INIT,1007)J,K

+      WRITE(INIT,1002) (PXYZ(I,J,K),I=1,LX)

+   60 CONTINUE

+   65 CONTINUE

+      CLOSE(UNIT=INIT)

+      IF(IMPX.GT.0)WRITE(IOUT,1006)TEXT

+   70 RETURN

+*

+ 1000 FORMAT(/1X,'MAX POWER =',1P,E13.6,1X,'WATTS',4X,

+     1 'AT COORD :',1X,'I =',I3,2X,'J =',I3,2X,'K =',I3/)

+ 1001 FORMAT(1X,'COMPUTED TOTAL POWER :',1P,E15.8,1X,'WATTS'/

+     1 1X,'MEAN POWER DENSITY',3X,':',1P,E15.8,1X,'WATTS/CM3')

+ 1002 FORMAT(6(1P,E15.8))

+ 1005 FORMAT(/1X,'** COMPUTING POWER-DISTRIBUTION OVER',

+     1 1X,'THE REACTOR CORE **'/)

+ 1006 FORMAT(/1X,'PRINTING POWER-DISTRIBUTION ON FILE:',

+     1 1X,'<',A10,'>',3X,'=>',2X,'DONE.')

+ 1007 FORMAT(//3X,'PLANE-Y #',I2.2,5X,'PLANE-Z #',I2.2/)

+ 1008 FORMAT(/10X,5('*'),3X,'POWER-DISTRIBUTION OVER THE',

+     1 1X,'REACTOR CORE',3X,5('*')//25X,'NX=',I2,',',2X,

+     2 'NY=',I2,',',2X,'NZ=',I2)

+      END

diff --git a/Donjon/src/FLPRNT.f b/Donjon/src/FLPRNT.f
new file mode 100644
index 0000000..bdbdc22
--- /dev/null
+++ b/Donjon/src/FLPRNT.f
@@ -0,0 +1,272 @@
+*DECK FLPRNT

+      SUBROUTINE FLPRNT(IPMAP,NCH,NB,NX,NY,NZ,POWB,PBNM,ICHM,IBNM,POWC,

+     1 PCHM,IPCH,BAVG,BFACT,CAVG,CFACT,IMPX)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Print the bundle and channel powers over the fuel lattice.

+*

+*Copyright:

+* Copyright (C) 2007 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* D. Sekki

+*

+*Parameters: input/output

+* IPMAP  pointer to fuel-map information.

+* NCH    number of reactor channels.

+* NB     number of fuel bundles per channel.

+* NX     number of elements along x-axis.

+* NY     number of elements along y-axis.

+* NZ     number of elements along z-axis.

+* POWB   bundle powers in kW.

+* PBNM   maximum bundle power.

+* ICHM   maximum-power channel number.

+* IBNM   maximum-power bundle number.

+* POWC   channel powers in kW.

+* PCHM   maximum channel power.

+* IPCH   maximum-power channel number.

+* BAVG   average bundle power.

+* BFACT  bundle power-form factor.

+* CAVG   average channel power.

+* CFACT  channel power-form factor.

+* IMPX   printing index:  0 = no print

+*                         1 = minimal printing

+*                         2 = channel power only

+*                         3 = bundle power by plane only

+*                         10 = bundle power by channel

+*                         any added values of 2, 3 and 10: 5,12,13,15  

+*

+*-----------------------------------------------------------------------

+*

+      USE GANLIB

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      TYPE(C_PTR) IPMAP

+      INTEGER NCH,NB,NX,NY,NZ,ICHM,IBNM,IPCH,IMPX

+      REAL POWB(NCH,NB),POWC(NCH),PBNM,PCHM

+      DOUBLE PRECISION BAVG,CAVG,BFACT

+*----

+*  LOCAL VARIABLES

+*----

+      PARAMETER(IOUT=6)

+      REAL RADB(NX,NY,NB),RADC(NX,NY)

+      INTEGER MIX(NX*NY,NZ),NAMX(NX),NAMY(NY)

+      CHARACTER TEXT*12,CHANX*2,CHANY*2,TEXT1A*17,TEXT2A*17,TEXT3A*17,

+     1 TEXT1B*17,TEXT2B*17,TEXT3B*17

+*

+      MIX(:NX*NY,NZ)=0

+      NAMX(:NX)=0

+      NAMY(:NY)=0

+      CALL LCMGET(IPMAP,'BMIX',MIX)

+*     CHANNEL NAMES

+      CALL LCMGET(IPMAP,'XNAME',NAMX)

+      CALL LCMGET(IPMAP,'YNAME',NAMY)

+*----

+*  BUNDLE POWERS OVER EACH CHANNEL

+*----

+      IF(IMPX.GE.10) WRITE(IOUT,1009)

+      IEL=0

+      ICH=0

+      JCM=0

+      ICM=0

+      JBM=0

+      IBM=0

+      DO 11 J=1,NY

+      DO 10 I=1,NX

+      IEL=IEL+1

+      DO 5 K=1,NZ

+      IF(MIX(IEL,K).NE.0)GOTO 6

+    5 CONTINUE

+      GO TO 10

+    6 ICH=ICH+1

+      IF(ICH.EQ.IPCH)THEN

+        JCM=J

+        ICM=I

+      ENDIF

+      IF(ICH.EQ.ICHM)THEN

+        JBM=J

+        IBM=I

+      ENDIF

+      IF(IMPX.GE.10) THEN

+        WRITE(TEXT,'(A9,I3.3)')'CHANNEL #',ICH

+        WRITE(CHANX,'(A2)') (NAMX(I))

+        WRITE(CHANY,'(A2)') (NAMY(J))

+        WRITE(IOUT,1000)TEXT,CHANY,CHANX,POWC(ICH)

+        IF(PBNM.LT.1.)THEN

+          WRITE(IOUT,'(1X,1P,12E11.4)')(POWB(ICH,IB),IB=1,NB)

+        ELSE IF(PBNM.LT.1000.)THEN

+          WRITE(IOUT,'(1X,12F11.3)')(POWB(ICH,IB),IB=1,NB)

+        ELSE

+          WRITE(IOUT,'(1X,12F11.1)')(POWB(ICH,IB),IB=1,NB)

+        ENDIF

+      ENDIF

+   10 CONTINUE

+   11 CONTINUE

+*

+      WRITE(TEXT1A,'(A6,I2,A8)') '(A4,',(NX/2),'(A9,2X))'

+      WRITE(TEXT2A,'(A4,I2,A6)') '(A3,',(NX/2),'F11.3)'

+      WRITE(TEXT3A,'(A8,I2,A6)') '(A3,1P,',(NX/2),'E11.3)'

+      WRITE(TEXT1B,'(A4,I2,A8)') '(A4,',NX-(NX/2),'(A9,2X))'

+      WRITE(TEXT2B,'(A4,I2,A6)') '(A3,',NX-(NX/2),'F11.3)'

+      WRITE(TEXT3B,'(A8,I2,A6)') '(A3,1P,',NX-(NX/2),'E11.3)'

+      IF((IMPX.LT.3).OR.((IMPX.GE.10).AND.(IMPX.LT.13)))GOTO 50

+*----

+*  BUNDLE POWERS PER RADIAL PLANE

+*----

+      RADB(:NX,:NY,:NB)=0.0

+      WRITE(IOUT,1010)

+      DO IB=1,NB

+        IEL=0

+        ICH=0

+        DO 25 J=1,NY

+        DO 20 I=1,NX

+        IEL=IEL+1

+        DO 15 K=1,NZ

+        IF(MIX(IEL,K).NE.0)GOTO 16

+   15   CONTINUE

+        GO TO 20

+   16   ICH=ICH+1

+        RADB(I,J,IB)=POWB(ICH,IB)

+   20   CONTINUE

+   25   CONTINUE

+      ENDDO

+      DO IB=1,NB

+        WRITE(IOUT,1011)IB

+        WRITE(IOUT,TEXT1A)' ',(NAMX(I),I=1,(NX/2))

+        WRITE(IOUT,*)' '

+        DO 30 J=1,NY

+        WRITE(CHANY,'(A2)') (NAMY(J))

+        IF(INDEX(CHANY,'-').EQ.1)GOTO 30

+        IF(PBNM.GE.1.)THEN

+          WRITE(IOUT,TEXT2A)CHANY,(RADB(I,J,IB),I=1,(NX/2))

+        ELSE

+          WRITE(IOUT,TEXT3A)CHANY,(RADB(I,J,IB),I=1,(NX/2))

+        ENDIF

+   30   CONTINUE

+        WRITE(IOUT,*)' '

+        WRITE(IOUT,TEXT1B)' ',(NAMX(I),I=(NX/2+1),NX)

+        WRITE(IOUT,*)' '

+        DO 40 J=1,NY

+        WRITE(CHANY,'(A2)') (NAMY(J))

+        IF(INDEX(CHANY,'-').EQ.1)GOTO 40

+        IF(PBNM.GE.1.)THEN

+          WRITE(IOUT,TEXT2B)CHANY,(RADB(I,J,IB),I=(NX/2+1),NX)

+        ELSE

+          WRITE(IOUT,TEXT3B)CHANY,(RADB(I,J,IB),I=(NX/2+1),NX)

+        ENDIF

+   40   CONTINUE

+      ENDDO

+   50 IF((IMPX.EQ.0).OR.(IMPX.EQ.1).OR.(IMPX.EQ.3).OR.(IMPX.EQ.4)

+     1 .OR.(IMPX.EQ.10).OR.(IMPX.EQ.11).OR.(IMPX.EQ.13).OR.(IMPX.EQ.14))

+     2  GOTO 90

+*----

+*  CHANNEL POWERS IN RADIAL PLANE

+*----

+      RADC(:NX,:NY)=0.0

+      WRITE(IOUT,1013)

+      IEL=0

+      ICH=0

+      DO 65 J=1,NY

+      DO 60 I=1,NX

+      IEL=IEL+1

+      DO 55 K=1,NZ

+      IF(MIX(IEL,K).NE.0)GOTO 56

+   55 CONTINUE

+      GO TO 60

+   56 ICH=ICH+1

+      RADC(I,J)=POWC(ICH)

+   60 CONTINUE

+   65 CONTINUE

+      WRITE(IOUT,TEXT1A)' ',(NAMX(I),I=1,(NX/2))

+      WRITE(IOUT,*)' '

+      DO 70 J=1,NY

+      WRITE(CHANY,'(A2)') (NAMY(J))

+      IF(INDEX(CHANY,'-').EQ.1)GOTO 70

+      IF(PBNM.GE.1.)THEN

+        WRITE(IOUT,TEXT2A)CHANY,(RADC(I,J),I=1,(NX/2))

+      ELSE

+        WRITE(IOUT,TEXT3A)CHANY,(RADC(I,J),I=1,(NX/2))

+      ENDIF

+   70 CONTINUE

+      WRITE(IOUT,*)' '

+      WRITE(IOUT,TEXT1B)' ',(NAMX(I),I=(NX/2+1),NX)

+      WRITE(IOUT,*)' '

+      DO 80 J=1,NY

+      WRITE(CHANY,'(A2)') (NAMY(J))

+      IF(INDEX(CHANY,'-').EQ.1)GOTO 80

+      IF(PBNM.GE.1.)THEN

+        WRITE(IOUT,TEXT2B)CHANY,(RADC(I,J),I=(NX/2+1),NX)

+      ELSE

+        WRITE(IOUT,TEXT3B)CHANY,(RADC(I,J),I=(NX/2+1),NX)

+      ENDIF

+   80 CONTINUE

+*----

+*  FINAL INFORMATION

+*----

+   90 IF((IBM.EQ.0).OR.(JBM.EQ.0)) CALL XABORT('FLPRNT: INVALID POWERS')

+      WRITE(IOUT,1002)

+      WRITE(CHANX,'(A2)') (NAMX(IBM))

+      WRITE(CHANY,'(A2)') (NAMY(JBM))

+      IF(PBNM.LT.1000.)THEN

+        WRITE(IOUT,1003)PBNM,CHANY,CHANX,IBNM

+      ELSE

+        WRITE(IOUT,1016)PBNM,CHANY,CHANX,IBNM

+      ENDIF

+      IF(BAVG.LT.1000.)THEN

+        WRITE(IOUT,1005)BAVG

+      ELSE

+        WRITE(IOUT,1017)BAVG

+      ENDIF

+      FACT=1./REAL(BFACT)

+      IF((ICM.EQ.0).OR.(JCM.EQ.0)) CALL XABORT('FLPRNT: INVALID POWERS')

+      WRITE(IOUT,1006)BFACT,FACT

+      WRITE(CHANX,'(A2)') (NAMX(ICM))

+      WRITE(CHANY,'(A2)') (NAMY(JCM))

+      IF(PCHM.LT.10000.)THEN

+        WRITE(IOUT,1004)PCHM,CHANY,CHANX

+      ELSE

+        WRITE(IOUT,1018)PCHM,CHANY,CHANX

+      ENDIF

+      IF(CAVG.LT.10000.)THEN

+        WRITE(IOUT,1007)CAVG

+      ELSE

+        WRITE(IOUT,1019)CAVG

+      ENDIF

+      FACT=1./CFACT

+      WRITE(IOUT,1008)CFACT,FACT

+      RETURN

+*

+ 1000 FORMAT(/5X,A12,5X,'NAME:',1X,A2,A2,5X,'CHANNEL POWER =',1X,1P,

+     1 E11.4,'kW')

+ 1002 FORMAT(/5X,5('--o--',6X)/)

+ 1003 FORMAT(/1X,'MAXIMUM BUNDLE POWER  =',1X,F9.1,1X,'kW',

+     1 3X,'=>',3X,'CHANNEL:',1X,A2,A2,3X,'BUNDLE #',I2.2)

+ 1004 FORMAT(/1X,'MAXIMUM CHANNEL POWER =',1X,F9.1,1X,'kW',

+     1 3X,'=>',3X,'CHANNEL:',1X,A2,A2)

+ 1005 FORMAT(1X,'AVERAGE POWER OVER ALL BUNDLES',

+     1 1X,'=',1X,F9.1,1X,'kW')

+ 1006 FORMAT(1X,'BUNDLE-POWER FORM FACTOR',2X,'=>',2X,

+     1 'AVG/MAX =',1X,F8.4,3X,'(MAX/AVG = ',F8.4,')')

+ 1007 FORMAT(1X,'AVERAGE POWER OVER ALL CHANNELS',

+     1 1X,'=',1X,F9.1,1X,'kW')

+ 1008 FORMAT(1X,'CHANNEL-POWER FORM FACTOR',2X,'=>',2X,

+     1 'AVG/MAX =',1X,F8.4,2X,'(MAX/AVG = ',F8.4,')'/)

+ 1009 FORMAT(/20X,'** BUNDLE POWERS OVER EACH',

+     1 1X,'CHANNEL (kW) **'/)

+ 1010 FORMAT(//20X,'** BUNDLE POWERS PER RADIAL',

+     1 1X,'PLANE **'/)

+ 1011 FORMAT(//1X,'BUNDLE POWERS',1X,'(kW)',1X,

+     1 '=>',1X,'RADIAL PLANE',1X,'#',I2.2/)

+ 1013 FORMAT(//20X,'** CHANNEL POWERS IN RADIAL',1X,'PLANE (kW) **'/)

+ 1016 FORMAT(/1X,'MAXIMUM BUNDLE POWER  =',1X,F9.1,1X,'kW',

+     1 3X,'=>',3X,'CHANNEL:',1X,A2,A2,3X,'BUNDLE #',I2.2)

+ 1017 FORMAT(1X,'AVERAGE POWER OVER ALL BUNDLES',

+     1 1X,'=',1X,F9.1,1X,'kW')

+ 1018 FORMAT(/1X,'MAXIMUM CHANNEL POWER =',1X,F9.1,1X,'kW',

+     1 3X,'=>',3X,'CHANNEL:',1X,A2,A2)

+ 1019 FORMAT(1X,'AVERAGE POWER OVER ALL CHANNELS',

+     1 1X,'=',1X,F9.1,1X,'kW')

+      END

diff --git a/Donjon/src/FLPTOT.f b/Donjon/src/FLPTOT.f
new file mode 100644
index 0000000..9e53dfc
--- /dev/null
+++ b/Donjon/src/FLPTOT.f
@@ -0,0 +1,96 @@
+*DECK FLPTOT
+      SUBROUTINE FLPTOT(IPFLX,IPKIN,IPTRK,NMIX,NGRP,NEL,NUN,EVECT,FLUX,
+     1 MAT,VOL,IDL,HFAC,PTOT,ZNRM,IMPX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Normalize fluxes using a previous normalization factor; update the
+* total reactor power.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki
+*
+*Parameters: input
+* IPFLX  pointer to flux information.
+* IPKIN  pointer to kinetics information.
+* IPTRK  pointer to tracking information.
+* NMIX   maximum number of material mixtures.
+* NGRP   total number of energy groups.
+* NEL    total number of finite elements.
+* NUN    total number of unknowns per group.
+* HFAC   h-factors over the reactor core.
+* ZNRM   previous flux-normalization factor.
+* IMPX   printing index (=0 for no print).
+*
+*Parameters: output
+* FLUX   normalized fluxes associated with each volume.
+* MAT    index-number of mixture assigned to each volume.
+* VOL    element-ordered mesh-splitted volumes.
+* PTOT   new total reactor power in watts.
+*
+*Parameters: scratch
+* EVECT
+* IDL
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPFLX,IPKIN,IPTRK
+      INTEGER NUN,NEL,NGRP,NMIX,IMPX,IDL(NEL),MAT(NEL)
+      REAL FLUX(NEL,NGRP),EVECT(NUN,NGRP),HFAC(NMIX,NGRP),VOL(NEL)
+      DOUBLE PRECISION ZNRM,PTOT
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(IOUT=6)
+      TYPE(C_PTR) JPFLX
+      DOUBLE PRECISION XDRCST,EVJ
+*----
+*  RECOVER INFORMATION
+*----
+      EVECT(:NUN,:NGRP)=0.0
+      IF(C_ASSOCIATED(IPFLX)) THEN
+*       L_FLUX object
+        JPFLX=LCMGID(IPFLX,'FLUX')
+        DO 10 JGR=1,NGRP
+        CALL LCMGDL(JPFLX,JGR,EVECT(1,JGR))
+   10   CONTINUE
+      ELSE IF(C_ASSOCIATED(IPKIN)) THEN
+*       L_KINET object
+        CALL LCMGET(IPKIN,'E-VECTOR',EVECT)
+      ENDIF
+*
+      MAT(:NEL)=0
+      CALL LCMGET(IPTRK,'MATCOD',MAT)
+      IDL(:NEL)=0
+      CALL LCMGET(IPTRK,'KEYFLX',IDL)
+      VOL(:NEL)=0.0
+      CALL LCMGET(IPTRK,'VOLUME',VOL)
+*----
+*  PERFORM CALCULATION
+*----
+      EVJ=XDRCST('eV','J')
+      PTOT=0.0D0
+      IF(IMPX.GT.0)WRITE(IOUT,1001)
+      FLUX(:NEL,:NGRP)=0.0
+      DO 25 JGR=1,NGRP
+      DO 20 IEL=1,NEL
+      IF(MAT(IEL).EQ.0)GOTO 20
+      FLUX(IEL,JGR)=EVECT(IDL(IEL),JGR)
+      FLUX(IEL,JGR)=FLUX(IEL,JGR)*REAL(ZNRM)
+      PTOT=PTOT+HFAC(MAT(IEL),JGR)*FLUX(IEL,JGR)*VOL(IEL)*EVJ
+   20 CONTINUE
+   25 CONTINUE
+      IF(IMPX.GT.0)WRITE(IOUT,1000)PTOT
+      RETURN
+*
+ 1000 FORMAT(/1X,'TOTAL REACTOR POWER =>',1P,E15.8,1X,'WATTS'/)
+ 1001 FORMAT(/1X,'** COMPUTING OF A NEW TOTAL',1X,'REACTOR POWER **')
+      END
diff --git a/Donjon/src/FPSOUT.f b/Donjon/src/FPSOUT.f
new file mode 100644
index 0000000..5d78203
--- /dev/null
+++ b/Donjon/src/FPSOUT.f
@@ -0,0 +1,150 @@
+*DECK FPSOUT
+      SUBROUTINE FPSOUT(IPMAC,IPRINT,NG,NMIL,NFIS,ILEAKS,TEXT9,OUTG)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute the leakage rate in each energy group
+*
+*Copyright:
+* Copyright (C) 2019 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPMAC   pointer to the macrolib structure.
+* IPRINT  print parameter
+* NG      number of energy groups.
+* NMIL    number of material mixtures.
+* NFIS    number of fissile isotopes.
+* ILEAKS  type of leakage calculation =0: no leakage; =1: homogeneous
+*         leakage (Diffon).
+* TEXT9   type of calculation ('REFERENCE' or 'MACRO').
+*
+*Parameters: output
+* OUTG    leakage rates.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAC
+      INTEGER IPRINT,NG,NMIL,NFIS,ILEAKS
+      CHARACTER TEXT9*9
+      REAL OUTG(NG)
+*----
+*  LOCAL VARIABLES
+*----
+      TYPE(C_PTR) JPMAC,KPMAC
+      CHARACTER HSMG*131
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IJJ,NJJ,IPOS
+      REAL, ALLOCATABLE, DIMENSION(:) :: GAR,WORK,DIFHOM,DIFF
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: PHI,NUF
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: CHI,RHS,LHS
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(PHI(NMIL,NG),RHS(NMIL,NG,NG),LHS(NMIL,NG,NG))
+      ALLOCATE(IJJ(NMIL),NJJ(NMIL),IPOS(NMIL),GAR(NMIL),WORK(NMIL*NG),
+     > CHI(NMIL,NFIS,NG),NUF(NMIL,NFIS),DIFHOM(NG),DIFF(NMIL))
+*----
+*  COMPUTE THE ACTUAL AND REFERENCE REACTION RATE MATRICES
+*----
+      CALL LCMGET(IPMAC,'K-EFFECTIVE',ZKEFF)
+      IF(IPRINT.GT.1) WRITE(6,120) TEXT9,ZKEFF
+      CALL LCMLEN(IPMAC,'B2  B1HOM',ILCMLN,ITYLCM)
+      IF(ILCMLN.EQ.1) THEN
+        CALL LCMGET(IPMAC,'B2  B1HOM',B2)
+      ELSE
+        B2=0.0
+      ENDIF
+      IF((ILEAKS.EQ.1).AND.(IPRINT.GT.1)) THEN
+        WRITE(6,'(/9H FPSOUT: ,A,4H B2=,1P,E12.4)') TEXT9,B2
+      ENDIF
+      RHS(:NMIL,:NG,:NG)=0.0
+      LHS(:NMIL,:NG,:NG)=0.0
+      JPMAC=LCMGID(IPMAC,'GROUP')
+      DO IG=1,NG
+        KPMAC=LCMGIL(JPMAC,IG)
+        CALL LCMGET(KPMAC,'CHI',CHI(1,1,IG))
+        CALL LCMLEN(KPMAC,'FLUX-INTG',ILG,ITYLCM)
+        IF(ILG.NE.NMIL) CALL XABORT('FPSOUT: MISSING REFERENCE FLUX.')
+        CALL LCMGET(KPMAC,'FLUX-INTG',PHI(1,IG))
+      ENDDO
+      DO IG=1,NG
+        KPMAC=LCMGIL(JPMAC,IG)
+        IF(ILEAKS.EQ.1) THEN
+          CALL LCMLEN(KPMAC,'DIFF',ILCMLN,ITYLCM)
+          IF(ILCMLN.GT.0) THEN
+            CALL LCMGET(KPMAC,'DIFF',DIFF)
+          ELSE
+            CALL LCMGET(IPMAC,'DIFHOMB1HOM',DIFHOM)
+            DO IBM=1,NMIL
+              DIFF(IBM)=DIFHOM(IG)
+            ENDDO
+          ENDIF
+        ELSE
+          DIFF(:NMIL)=0.0
+        ENDIF
+        CALL LCMGET(KPMAC,'NTOT0',GAR)
+        CALL LCMGET(KPMAC,'SCAT00',WORK)
+        CALL LCMGET(KPMAC,'NJJS00',NJJ)
+        CALL LCMGET(KPMAC,'IJJS00',IJJ)
+        CALL LCMGET(KPMAC,'IPOS00',IPOS)
+        DO IBM=1,NMIL
+          IPOSDE=IPOS(IBM)
+          DO JG=IJJ(IBM),IJJ(IBM)-NJJ(IBM)+1,-1
+*           IG <-- JG
+            RHS(IBM,IG,JG)=RHS(IBM,IG,JG)-WORK(IPOSDE)*PHI(IBM,JG)
+            IPOSDE=IPOSDE+1
+          ENDDO
+          RHS(IBM,IG,IG)=RHS(IBM,IG,IG)+(GAR(IBM)+B2*DIFF(IBM))*
+     >    PHI(IBM,IG)
+        ENDDO
+        CALL LCMGET(KPMAC,'NUSIGF',NUF)
+        DO IBM=1,NMIL
+          DO IFIS=1,NFIS
+            DO JG=1,NG
+              LHS(IBM,JG,IG)=LHS(IBM,JG,IG)+CHI(IBM,IFIS,JG)*
+     >        NUF(IBM,IFIS)*PHI(IBM,IG)
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDDO
+*----
+*  COMPUTE THE ACTUAL AND REFERENCE ABSORPTION AND FISSION RATES
+*----
+      DO IG=1,NG
+        OUTG(IG)=0.0
+        DO IBM=1,NMIL
+          OUTG(IG)=OUTG(IG)+SUM(LHS(IBM,IG,:NG))/ZKEFF-
+     1    SUM(RHS(IBM,IG,:NG))
+        ENDDO
+        IF(OUTG(IG).LT.-1.0E-6) THEN
+          WRITE(HSMG,'(21HFPSOUT: INCONSISTENT ,A,17H LEAKAGE IN GROUP,
+     1    I4,7H. LEAK=,1P,E13.4)') TEXT9,IG,OUTG(IG)
+          CALL XABORT(HSMG)
+        ENDIF
+        IF(IPRINT.GT.1) WRITE(6,130) IG,TEXT9,OUTG(IG)
+      ENDDO
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(DIFF,DIFHOM,NUF,CHI,WORK,GAR,IPOS,NJJ,IJJ)
+      DEALLOCATE(LHS,RHS,PHI)
+      RETURN
+*
+  120 FORMAT(/9H FPSOUT: ,A,33H EFFECTIVE MULTIPLICATION FACTOR=,1P,
+     1 E12.4)
+  130 FORMAT(/8H FPSOUT:,5X,6HGROUP=,I4,1X,A,9H LEAKAGE=,1P,E12.4)
+      END
diff --git a/Donjon/src/FPSPH.f b/Donjon/src/FPSPH.f
new file mode 100644
index 0000000..96db43a
--- /dev/null
+++ b/Donjon/src/FPSPH.f
@@ -0,0 +1,472 @@
+*DECK FPSPH
+      SUBROUTINE FPSPH(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Perform a single SPH factor fixed point iteration
+*
+*Copyright:
+* Copyright (C) 2019 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The FPSPH: calling specifications are:
+* OPTIM := FPSPH: [ OPTIM ] MACROLIB MACROREF :: (fpsph\_data) ;
+* where
+*   OPTIM    : name of the \emph{optimize} object (L\_OPTIMIZE signature) 
+*     containing the SPH factors. At the first call, object OPTIM must appear on
+*     LHS to receive its initial values. On subsequent calls, object OPTIM must 
+*     appear on both LHS and RHS to be able to update the previous values.
+*   MACROLIB : name of the read-only extended \emph{macrolib} object 
+*     (L\_MACROLIB signature) containing the macroscopic cross sections used by
+*     the macro-calculation and fluxes produced by the macro-calculation.
+*   MACROREF : name of the read-only extended \emph{macrolib} object 
+*    (L\_MACROLIB signature) containing the reference macroscopic cross 
+*    sections and fluxes.
+*   (fpsph\_data) : structure containing the data to the module FPSPH:
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER (NSTATE=40)
+      TYPE(C_PTR) IPOPT,IPMAC1,IPMAC2,JPMAC1,JPMAC2,KPMAC1,KPMAC2
+      CHARACTER HSIGN*12,TEXT12*12
+      INTEGER ISTATE(NSTATE),DNVTST
+      DOUBLE PRECISION OPTPRR(NSTATE),DFLOTT,ZNORM1,ZNORM2,EPSPH,ERRT,
+     > ERR2,ERROR,SPHMIN,SPHMAX
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      REAL, ALLOCATABLE, DIMENSION(:) :: SPH,FLUX1,FLUX2,OUTG1,OUTG2
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: VARV,VAROLD,XMIN,
+     > XMAX,P,FF,UD
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: DFF,TDFF
+*----
+*  PARAMETER VALIDATION.
+*----
+      IF(NENTRY.NE.3) CALL XABORT('FPSPH: THREE PARAMETERS EXPECTED.')
+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('FPSPH: LCM'
+     >  //' OBJECT EXPECTED AT LHS.')
+      IF(JENTRY(1).EQ.0)THEN
+        HSIGN='L_OPTIMIZE'
+        CALL LCMPTC(KENTRY(1),'SIGNATURE',12,HSIGN)
+      ELSE IF(JENTRY(1).EQ.1)THEN
+        CALL LCMGTC(KENTRY(1),'SIGNATURE',12,HSIGN)
+        IF(HSIGN.NE.'L_OPTIMIZE')THEN
+          CALL XABORT('FPSPH: SIGNATURE OF '//HENTRY(2)//' IS '//HSIGN//
+     >    '. L_OPTIMIZE EXPECTED.')
+        ENDIF
+      ELSE IF(JENTRY(1).EQ.2)THEN
+        CALL XABORT('FPSPH: OPTIMIZE OBJECT IN CREATION OR MODIFICATIO'
+     >  //'N MODE EXPECTED.')
+      ENDIF
+      IPOPT=KENTRY(1)
+      IF(JENTRY(1).EQ.1) THEN
+        CALL LCMGET(IPOPT,'STATE-VECTOR',ISTATE)
+        NVAR=ISTATE(1)
+        NFUNC=ISTATE(2)+1
+        ITER=ISTATE(5)
+        IMETH=ISTATE(8)
+        CALL LCMGET(IPOPT,'OPT-PARAM-R',OPTPRR)
+        EPSPH=OPTPRR(3)
+        CALL LCMGET(IPOPT,'DEL-STATE',ISTATE)
+        NGRP=ISTATE(1)
+        NMIX=ISTATE(2)
+        ICONT=ISTATE(4)
+        NGR1=ISTATE(5)
+        NGR2=ISTATE(6)
+        NALBP=ISTATE(9)
+        IF((ICONT.NE.3).AND.(ICONT.NE.4)) CALL XABORT('FPSPH: SPH FACT'
+     >  //'ORS EXPECTED IN OPTIMIZE OBJECT.')
+        IF(NVAR.NE.(NGR2-NGR1+1)*(NMIX+NALBP)) CALL XABORT('FPSPH: INC'
+     >  //'OHERENT NUMBER OF DECISION VARIABLES.')
+      ELSE
+        ITER=0
+        IMETH=3
+        EPSPH=1.0D-4
+        NGRP=0
+        NMIX=0
+      ENDIF
+      DO I=2,3
+        IF((JENTRY(I).NE.2).OR.((IENTRY(I).NE.1).AND.(IENTRY(I).NE.2)))
+     1  CALL XABORT('FPSPH: LCM OBJECT IN READ-ONLY MODE EXPECTED AT R'
+     2  //'HS.')
+      ENDDO
+      ITER=ITER+1
+*----
+*  RECOVER THE ACTUAL MACROLIB.
+*----
+      CALL LCMGTC(KENTRY(2),'SIGNATURE',12,HSIGN)
+      IF(HSIGN.EQ.'L_MACROLIB') THEN
+        IPMAC1=KENTRY(2)
+      ELSE IF(HSIGN.EQ.'L_LIBRARY') THEN
+        IPMAC1=LCMGID(KENTRY(5),'MACROLIB')
+      ELSE
+        TEXT12=HENTRY(2)
+        CALL XABORT('FPSPH: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     >  '. ACTUAL L_MACROLIB OR L_LIBRARY EXPECTED.')
+      ENDIF
+      CALL LCMGET(IPMAC1,'STATE-VECTOR',ISTATE)
+      IF(JENTRY(1).EQ.0) THEN
+        NGRP=ISTATE(1)
+        NMIX=ISTATE(2)
+      ELSE IF(ISTATE(1).NE.NGRP) THEN
+        CALL XABORT('FPSPH: INVALID NUMBER OF GROUPS.')
+      ELSE IF(ISTATE(2).NE.NMIX) THEN
+        CALL XABORT('FPSPH: INVALID NUMBER OF MIXTURES.')
+      ENDIF
+      NFIS1=ISTATE(4)
+      ILEAKS=ISTATE(9)
+*----
+*  RECOVER THE REFERENCE MACROLIB.
+*----
+      CALL LCMGTC(KENTRY(3),'SIGNATURE',12,HSIGN)
+      IF(HSIGN.EQ.'L_MACROLIB') THEN
+        IPMAC2=KENTRY(3)
+      ELSE IF(HSIGN.EQ.'L_LIBRARY') THEN
+        IPMAC2=LCMGID(KENTRY(3),'MACROLIB')
+      ELSE
+        TEXT12=HENTRY(3)
+        CALL XABORT('FPSPH: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     1  '. REFERENCE L_MACROLIB OR L_LIBRARY EXPECTED.')
+      ENDIF
+      CALL LCMGET(IPMAC2,'STATE-VECTOR',ISTATE)
+      IF(ISTATE(1).NE.NGRP) THEN
+        CALL XABORT('FPSPH: INVALID NUMBER OF REFERENCE GROUPS.')
+      ELSE IF(ISTATE(2).NE.NMIX) THEN
+        CALL XABORT('FPSPH: INVALID NUMBER OF REFERENCE MIXTURES.')
+      ELSE IF(ISTATE(9).NE.ILEAKS) THEN
+        CALL XABORT('FPSPH: INVALID TYPE OF LEAKAGE.')
+      ENDIF
+      NFIS2=ISTATE(4)
+      NALBP=ISTATE(8)
+      IF(NALBP.GT.1) CALL XABORT('FPSPH: NALBP>1 NOT SUPPORTED.')
+*----
+*  READ INPUT PARAMETERS
+*----
+      IPICK=0
+      IPRINT=1
+      SPHMIN=0.0D0
+      SPHMAX=10.0D0
+      IF(JENTRY(1).EQ.0) THEN
+        IMC=2
+        NGR1=1
+        NGR2=NGRP
+      ENDIF
+   10 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+      IF(INDIC.EQ.10) GO TO 50
+      IF(INDIC.NE.3) CALL XABORT('FPSPH: CHARACTER DATA EXPECTED')
+      IF(TEXT12(1:4).EQ.'EDIT') THEN
+        CALL REDGET(INDIC,IPRINT,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1) CALL XABORT('FPSPH: INTEGER DATA EXPECTED FOR I'
+     1  //'PRINT')
+      ELSE IF(TEXT12.EQ.'SPH') THEN
+*       READ THE TYPE OF SPH CORRECTION.
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3) CALL XABORT('FPSPH: CHARACTER DATA EXPECTED(2).')
+        IF(TEXT12.EQ.'PN') THEN
+          IMC=1
+        ELSE IF(TEXT12.EQ.'SN') THEN
+          IMC=2
+        ELSE
+          CALL XABORT('FPSPH: INVALID TYPE OF SPH CORRECTION.')
+        ENDIF
+      ELSE IF(TEXT12.EQ.'GRPMIN') THEN
+*       READ THE MINIMUM GROUP INDEX.
+        CALL REDGET(INDIC,NGR1,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1) CALL XABORT('FPSPH: INTEGER DATA EXPECTED(4).')
+        IF((NGR1.LE.0).OR.(NGR1.GT.NGRP)) CALL XABORT('FPSPH: INVALID '
+     >  //'VALUE OF GRPMIN.')
+      ELSE IF(TEXT12.EQ.'GRPMAX') THEN
+*       READ THE MAXIMUM GROUP INDEX.
+        CALL REDGET(INDIC,NGR2,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1) CALL XABORT('FPSPH: INTEGER DATA EXPECTED(5).')
+        IF((NGR2.LT.NGR1).OR.(NGR2.GT.NGRP)) CALL XABORT('FPSPH: INVAL'
+     >  //'ID VALUE OF GRPMAX.')
+      ELSE IF(TEXT12.EQ.'OUT-STEP-EPS') THEN
+*       Set the tolerence used for SPH iterations.
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.EQ.2) THEN
+          EPSPH=FLOTT
+        ELSE IF(INDIC.EQ.4) THEN
+          EPSPH=DFLOTT
+        ELSE
+          CALL XABORT('FPSPH: REAL OR DOUBLE PRECISION VALUE EXPECTED.')
+        ENDIF
+      ELSE IF(TEXT12.EQ.'VAR-VAL-MIN') THEN
+*       Set the minimum value for SPH dactors.
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.EQ.2) THEN
+          SPHMIN=FLOTT
+        ELSE IF(INDIC.EQ.4) THEN
+          SPHMIN=DFLOTT
+        ELSE
+          CALL XABORT('FPSPH: REAL OR DOUBLE PRECISION VALUE EXPECTED.')
+        ENDIF
+      ELSE IF(TEXT12.EQ.'VAR-VAL-MAX') THEN
+*       Set the maximum value for SPH dactors.
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.EQ.2) THEN
+          SPHMAX=FLOTT
+        ELSE IF(INDIC.EQ.4) THEN
+          SPHMAX=DFLOTT
+        ELSE
+          CALL XABORT('FPSPH: REAL OR DOUBLE PRECISION VALUE EXPECTED.')
+        ENDIF
+      ELSE IF(TEXT12.EQ.'OUT-CONV-TST') THEN
+*       Convergence test
+        IPICK=1
+        GO TO 50
+      ELSE IF(TEXT12(1:1).EQ.';') THEN
+        GO TO 50
+      ELSE 
+        CALL XABORT('FPSPH: '//TEXT12//' IS AN INVALID KEYWORD')
+      ENDIF
+      GO TO 10
+*----
+*  RECOVER SPH FACTORS FROM PREVIOUS ITERATION
+*----
+   50 NPERT=(NGR2-NGR1+1)*(NMIX+NALBP)
+      ALLOCATE(VARV(NPERT),VAROLD(NPERT),XMIN(NPERT),XMAX(NPERT))
+      CALL LCMLEN(IPOPT,'VAR-VAL-MIN',ILONG,ITYLCM)
+      IF(ILONG.EQ.0) THEN
+        XMIN(:NPERT)=SPHMIN
+        CALL LCMPUT(IPOPT,'VAR-VAL-MIN',NPERT,4,XMIN)
+      ELSE
+        CALL LCMGET(IPOPT,'VAR-VAL-MIN',XMIN)
+      ENDIF
+      CALL LCMLEN(IPOPT,'VAR-VAL-MAX',ILONG,ITYLCM)
+      IF(ILONG.EQ.0) THEN
+        XMAX(:NPERT)=SPHMAX
+        CALL LCMPUT(IPOPT,'VAR-VAL-MAX',NPERT,4,XMAX)
+      ELSE
+        CALL LCMGET(IPOPT,'VAR-VAL-MAX',XMAX)
+      ENDIF
+      CALL LCMLEN(IPOPT,'VAR-VALUE',ILONG,ITYLCM)
+      IF(ILONG.EQ.0) THEN
+        VAROLD(:NPERT)=1.0D0
+      ELSE
+        CALL LCMGET(IPOPT,'VAR-VALUE',VAROLD)
+      ENDIF
+*----
+*  PERFORM A FIXED POINT SPH ITERATION
+*----
+      IF(IPRINT.GT.0) WRITE(6,'(/34H FPSPH: COMPUTE SPH FACTORS AT ITE,
+     > 6HRATION,I5,12H WITH METHOD,I2,1H.)') ITER,IMETH
+      IF(IMETH.EQ.3) THEN
+        IPERT=0
+        JPMAC1=LCMGID(IPMAC1,'GROUP')
+        JPMAC2=LCMGID(IPMAC2,'GROUP')
+        ALLOCATE(SPH(NMIX+NALBP),FLUX1(NMIX),FLUX2(NMIX),OUTG1(NGRP),
+     >  OUTG2(NGRP))
+        IF(IPRINT.GT.4) WRITE(6,'(/32H FPSPH: SPH FACTORS AT ITERATION,
+     >  I5)') ITER
+        IF(NALBP.GT.0) THEN
+          CALL FPSOUT(IPMAC1,IPRINT,NGRP,NMIX,NFIS1,ILEAKS,'    MACRO',
+     >    OUTG1)
+          CALL FPSOUT(IPMAC2,IPRINT,NGRP,NMIX,NFIS2,ILEAKS,'REFERENCE',
+     >    OUTG2)
+        ENDIF
+        DO 120 IGR=NGR1,NGR2
+        SPH(:NMIX+NALBP)=1.0
+        KPMAC1=LCMGIL(JPMAC1,IGR)
+        KPMAC2=LCMGIL(JPMAC2,IGR)
+        CALL LCMGET(KPMAC1,'FLUX-INTG',FLUX1)
+        CALL LCMGET(KPMAC2,'FLUX-INTG',FLUX2)
+        DO 60 IBM=1,NMIX
+        SPH(IBM)=FLUX2(IBM)/FLUX1(IBM)
+   60   CONTINUE
+        DO 70 IAL=1,NALBP
+        IF(OUTG1(IGR).NE.0.0) THEN
+          SPH(NMIX+IAL)=REAL(VAROLD(IPERT+NMIX+1))*OUTG2(IGR)/OUTG1(IGR)
+        ENDIF
+   70   CONTINUE
+        ZNORM1=0.0D0
+        ZNORM2=0.0D0
+        DO 80 IBM=1,NMIX
+        ZNORM1=ZNORM1+FLUX2(IBM)/SPH(IBM)
+        ZNORM2=ZNORM2+FLUX2(IBM)
+   80   CONTINUE
+        ZNORM1=ZNORM1/ZNORM2
+        IF(IPRINT.GT.1) THEN
+          WRITE(6,'(/14H FPSPH: GROUP=,I4,22H NORMALIZATION FACTOR=,1P,
+     >    E12.4)') IGR,ZNORM1
+        ENDIF
+        DO 90 IBM=1,NMIX+NALBP
+        SPH(IBM)=SPH(IBM)*REAL(ZNORM1)
+   90   CONTINUE
+        DO 100 IBM=1,NMIX
+        IPERT=IPERT+1
+        VARV(IPERT)=SPH(IBM)
+  100   CONTINUE
+        DO 110 IAL=1,NALBP
+        IPERT=IPERT+1
+        VARV(IPERT)=SPH(NMIX+IAL)
+  110   CONTINUE
+  120   CONTINUE
+        DEALLOCATE(OUTG2,OUTG1,FLUX2,FLUX1,SPH)
+*----
+*  PERFORM A NEWTONIAN SPH ITERATION
+*----
+      ELSE IF(IMETH.EQ.4) THEN
+        ALLOCATE(P(NPERT),FF(NFUNC),DFF(NPERT,NFUNC),TDFF(NFUNC,NPERT),
+     >  UD(NPERT))
+        CALL LCMGET(IPOPT,'FOBJ-CST-VAL',FF)
+        CALL LCMGET(IPOPT,'GRADIENT',DFF)
+        TDFF=TRANSPOSE(DFF)
+        CALL ALST2F(NFUNC,NFUNC,NPERT,TDFF,UD)
+        CALL ALST2S(NFUNC,NFUNC,NPERT,TDFF,UD,FF,P)
+        DO 130 IPERT=1,NPERT
+        VARV(IPERT)=VAROLD(IPERT)-P(IPERT)
+  130   CONTINUE
+        DEALLOCATE(UD,TDFF,DFF,FF,P)
+      ENDIF
+*----
+*  APPLY CONSTRAINTS ON SPH FACTORS
+*----
+       DO 135 IPERT=1,NPERT
+         VARV(IPERT)=MAX(VARV(IPERT),XMIN(IPERT))
+         VARV(IPERT)=MIN(VARV(IPERT),XMAX(IPERT))
+  135  ENDDO
+*----
+*  PRINT SPH FACTORS
+*----
+      IF(IPRINT.GT.4) THEN
+        ALLOCATE(SPH(NMIX+NALBP))
+        IPERT=0
+        DO 150 IGR=NGR1,NGR2
+        DO 140 IBM=1,NMIX+NALBP
+        IPERT=IPERT+1
+        SPH(IBM)=REAL(VARV(IPERT))
+  140   CONTINUE
+        WRITE(6,200) 'NSPH',IGR,(SPH(IBM),IBM=1,NMIX+NALBP)
+  150   CONTINUE
+        DEALLOCATE(SPH)
+      ENDIF
+*----
+*  TEST CONVERGENCE
+*----
+      ICONV=0
+      IF(JENTRY(1).EQ.1) THEN
+        ERROR=0.0
+        ERR2=0.0
+        DO 160 IPERT=1,NPERT
+          ERRT=ABS((VARV(IPERT)-VAROLD(IPERT))/VARV(IPERT))
+          ERR2=ERR2+ERRT*ERRT
+          ERROR=MAX(ERROR,ERRT)
+  160   CONTINUE
+        ERR2=SQRT(ERR2/REAL(NPERT))
+        IF(IPRINT.GT.0) WRITE(6,230) ITER,ERROR,ERR2
+        IF(ERR2.LT.EPSPH) THEN
+          ICONV=1
+          IF(IPRINT.GT.0) WRITE(6,220) ITER
+        ENDIF
+      ELSE
+        ERR2=1.0E10
+      ENDIF
+*----
+*  PUT OPTIMIZE OBJECT INFORMATION
+*----
+      CALL LCMPUT(IPOPT,'VAR-VALUE',NPERT,4,VARV)
+      DEALLOCATE(XMAX,XMIN,VAROLD,VARV)
+      IF(JENTRY(1).EQ.0)THEN
+        ISTATE(:NSTATE)=0
+        ISTATE(1)=NGRP
+        ISTATE(2)=NMIX
+        ISTATE(3)=1
+        ISTATE(4)=2+IMC
+        ISTATE(5)=NGR1
+        ISTATE(6)=NGR2
+        ISTATE(7)=1
+        ISTATE(8)=NMIX
+        ISTATE(9)=NALBP
+        IF(IPRINT.GT.0) WRITE(6,210) (ISTATE(I),I=1,6)
+        CALL LCMPUT(IPOPT,'DEL-STATE',NSTATE,1,ISTATE)
+        ISTATE(:NSTATE)=0
+        ISTATE(1)=NPERT
+        ISTATE(8)=IMETH ! set to fixed point or Newtonian method
+        CALL LCMPUT(IPOPT,'STATE-VECTOR',NSTATE,1,ISTATE)
+        OPTPRR(:NSTATE)=0.0D0
+        OPTPRR(1)=1.0D0
+        OPTPRR(2)=0.1D0
+        OPTPRR(3)=EPSPH
+        OPTPRR(4)=1.0D-4
+        OPTPRR(5)=1.0D-4
+        CALL LCMPUT(IPOPT,'OPT-PARAM-R',NSTATE,4,OPTPRR)
+      ELSE
+        CALL LCMGET(IPOPT,'STATE-VECTOR',ISTATE)
+        ISTATE(1)=NPERT
+        ISTATE(4)=ICONV ! convergence index
+        ISTATE(5)=ITER ! number of iterations
+        ISTATE(8)=IMETH ! set to fixed point or Newtonian method
+        CALL LCMPUT(IPOPT,'STATE-VECTOR',NSTATE,1,ISTATE)
+      ENDIF
+*----
+*  RECOVER THE CONVERGENCE FLAGS AND SAVE IT IN A CLE-2000 VARIABLE
+*----
+      IF(IPICK.EQ.1) THEN
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.-5) CALL XABORT('FPSPH: OUTPUT LOGICAL EXPECTED.')
+        INDIC=5
+        IF(ICONV.EQ.0) THEN
+          DNVTST=-1 ! not converged
+        ELSE IF(ICONV.EQ.1) THEN
+          DNVTST=1 ! converged
+        ENDIF
+        CALL REDPUT(INDIC,DNVTST,FLOTT,TEXT12,DFLOTT)
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.EQ.-4) THEN
+          INDIC=4
+          CALL REDPUT(INDIC,NITMA,FLOTT,TEXT12,ERR2)
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        ENDIF
+        IF((INDIC.NE.3).OR.(TEXT12.NE.';')) THEN
+          CALL XABORT('FPSPH: ; CHARACTER EXPECTED.')
+        ENDIF
+      ENDIF      
+      RETURN
+*
+  200 FORMAT(/25H FPSPH: VALUES OF VECTOR ,A,9H IN GROUP,I5,4H ARE/
+     > (1X,1P,10E13.5))
+  210 FORMAT(/18H DEL-STATE OPTIONS/18H -----------------/
+     1 7H NGRP  ,I8,28H   (NUMBER OF ENERGY GROUPS)/
+     2 7H NMIX  ,I8,32H   (NUMBER OF MATERIAL MIXTURES)/
+     3 7H ITYPE ,I8,13H   (NOT USED)/
+     4 7H IDELTA,I8,34H   (=3/4: USE PN-TYPE/USE SN-TYPE)/
+     5 7H NGR1  ,I8,24H   (MINIMUM GROUP INDEX)/
+     6 7H NGR2  ,I8,24H   (MAXIMUM GROUP INDEX))
+  220 FORMAT(/39H FPSPH: CONVERGENCE OF SPH ALGORITHM IN,I5,
+     > 12H ITERATIONS.)
+  230 FORMAT(/13H FPSPH: ITER=,I3,4X,6HERROR=,1P,E10.3,1X,5HERR2=,
+     > E10.3)
+      END
diff --git a/Donjon/src/GRA001.f b/Donjon/src/GRA001.f
new file mode 100644
index 0000000..90569f5
--- /dev/null
+++ b/Donjon/src/GRA001.f
@@ -0,0 +1,107 @@
+*DECK GRA001
+      SUBROUTINE GRA001(IPFLX,IPGPT,NVAR,NCST,DERIV)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute new gradients of system characteristics (part 2).
+*
+*Copyright:
+* Copyright (C) 2012 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPFLX   pointer of a LCM object containing a set solutions of
+*         fixed-source eigenvalue problems.
+* IPGPT   pointer of a LCM object containing a set of fixed sources.
+* NVAR    number of control variables.
+* NCST    number of constraints with indirect effects (can be zero).
+*
+*Parameters: output
+* DERIV   gradient matrix.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPFLX,IPGPT
+      INTEGER NVAR,NCST
+      DOUBLE PRECISION DERIV(NVAR,NCST+1)
+*----
+*  LOCAL VARIABLES
+*----
+      TYPE(C_PTR) JPFLX,KPFLX,JPGPT,KPGPT
+      PARAMETER (NSTATE=40)
+      INTEGER ISTATE(NSTATE)
+      DOUBLE PRECISION SUM
+      REAL, ALLOCATABLE, DIMENSION(:) :: DFLUX,SOUR
+*
+      CALL LCMGET(IPFLX,'STATE-VECTOR',ISTATE)
+      NGRP=ISTATE(1)
+      NUN=ISTATE(2)
+      ITYPE=ISTATE(3)
+      NGPT=ISTATE(5)
+      CALL LCMGET(IPGPT,'STATE-VECTOR',ISTATE)
+      IF(ISTATE(1).NE.NGRP) CALL XABORT('GRA001: INVALID NGRP')
+      IF(ISTATE(2).NE.NUN) CALL XABORT('GRA001: INVALID NUN')
+      ND=ISTATE(3)
+      NA=ISTATE(4)
+*
+      ALLOCATE(SOUR(NUN),DFLUX(NUN))
+      DERIV(:NVAR,:NCST+1)=0.0D0
+      IF(ITYPE.EQ.100) THEN
+*       EXPLICIT APPROACH
+        IF(NVAR.NE.NGPT) CALL XABORT('GRA001: INVALID NGPT(1)')
+        IF(NCST+1.NE.NA) CALL XABORT('GRA001: INVALID NA(1)')
+        JPFLX=LCMGID(IPFLX,'DFLUX')
+        JPGPT=LCMGID(IPGPT,'ASOUR')
+        DO 25 IVAR=1,NVAR
+        KPFLX=LCMGIL(JPFLX,IVAR)
+        DO 20 ICST=1,NCST+1
+        KPGPT=LCMGIL(JPGPT,ICST)
+        SUM=0.0D0
+        DO 15 IGR=1,NGRP
+        CALL LCMGDL(KPGPT,IGR,SOUR)
+        CALL LCMGDL(KPFLX,IGR,DFLUX)
+        DO 10 IUN=1,NUN
+        SUM=SUM+SOUR(IUN)*DFLUX(IUN)
+   10   CONTINUE
+   15   CONTINUE
+        DERIV(IVAR,ICST)=SUM
+   20   CONTINUE
+   25   CONTINUE
+      ELSE IF(ITYPE.EQ.1000) THEN
+*       IMPLICIT APPROACH
+        IF(NVAR.NE.ND) CALL XABORT('GRA001: INVALID ND(2)')
+        IF(NCST+1.NE.NGPT) CALL XABORT('GRA001: INVALID NGPT(2)')
+        JPFLX=LCMGID(IPFLX,'ADFLUX')
+        JPGPT=LCMGID(IPGPT,'DSOUR')
+        DO 45 ICST=1,NCST+1
+        KPFLX=LCMGIL(JPFLX,ICST)
+        DO 40 IVAR=1,NVAR
+        KPGPT=LCMGIL(JPGPT,IVAR)
+        SUM=0.0D0
+        DO 35 IGR=1,NGRP
+        CALL LCMGDL(KPGPT,IGR,SOUR)
+        CALL LCMGDL(KPFLX,IGR,DFLUX)
+        DO 30 IUN=1,NUN
+        SUM=SUM+SOUR(IUN)*DFLUX(IUN)
+   30   CONTINUE
+   35   CONTINUE
+        DERIV(IVAR,ICST)=SUM
+   40   CONTINUE
+   45   CONTINUE
+      ELSE
+        CALL XABORT('GRA001: INVALID FLUX OBJECT')
+      ENDIF
+      DEALLOCATE(DFLUX,SOUR)
+      RETURN
+      END
diff --git a/Donjon/src/GRAD.f b/Donjon/src/GRAD.f
new file mode 100644
index 0000000..26ca070
--- /dev/null
+++ b/Donjon/src/GRAD.f
@@ -0,0 +1,382 @@
+*DECK GRAD
+      SUBROUTINE GRAD(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute gradients of system characteristics.
+*
+*Copyright:
+* Copyright (C) 2012 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The calling specifications are:
+* OPTIM := GRAD: [ OPTIM ] DFLUX GPT :: (grad\_data) ;
+* where
+*   OPTIM : name of the \emph{optimize} object (L\_OPTIMIZE signature) 
+*     containing the optimization informations. Object OPTIM must appear on the 
+*     RHS to be able to updated the previous values.
+*   DFLUX : name of the \emph{flux} object (L\_FLUX signature) containing a set
+*     of solutions of fixed-source eigenvalue problems.
+*   GPT   : name of the \emph{gpt} object (L\_GPT signature) containing a set 
+*     of direct or adjoint sources.
+*   (grad\_data) : structure containing the data to the module GRAD:.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER (NSTATE=40)
+      TYPE(C_PTR) IPFLX,IPGPT,IPGRAD
+      CHARACTER HSIGN*12,TEXT4*4,TEXT12*12,TEXT16*16
+      INTEGER ISTATE(NSTATE)
+      REAL FLOTT
+      DOUBLE PRECISION DFLOTT,SR,EPS1,EPS2,EPS3,EPS4
+      DOUBLE PRECISION OPTPRR(NSTATE)
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IREL
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: VARV,CSTV,RHS,
+     1 DERIV,DERIV0
+*----
+*  PARAMETER VALIDATION.
+*----
+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('GRAD: LCM'
+     1 //' OBJECT EXPECTED AT LHS.')
+      IF(JENTRY(1).EQ.2) CALL XABORT('GRAD: OPTIMIZE ENTRY IN CREATE O'
+     1 //'R MODIFICATION MODE EXPECTED.')
+      DO I=2,NENTRY
+         TEXT12=HENTRY(I)
+         IF((JENTRY(I).NE.2).OR.((IENTRY(I).NE.1).AND.(IENTRY(I).NE.2)))
+     1   CALL XABORT('GRAD: LCM OBJECT IN READ-ONLY MODE EXPECTED AT R'
+     2   //'HS ('//TEXT12//').')
+      ENDDO
+      IPGRAD=KENTRY(1)
+      IPFLX=C_NULL_PTR
+      IPGPT=C_NULL_PTR
+*----
+*  RECOVER THE ACTUAL FLUX SOLUTION AND CORRESPONDING TRACKING.
+*----
+      NVAR0=0
+      NCST0=0
+      ITYPE=0
+      IF(NENTRY.EQ.3) THEN
+        CALL LCMGTC(KENTRY(2),'SIGNATURE',12,HSIGN)
+        IF(HSIGN.NE.'L_FLUX') THEN
+           TEXT12=HENTRY(2)
+           CALL XABORT('GRAD: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     1     '. L_FLUX EXPECTED.')
+        ENDIF
+        IPFLX=KENTRY(2)
+        CALL LCMGET(IPFLX,'STATE-VECTOR',ISTATE)
+        ITYPE=ISTATE(3)
+        NGPT=ISTATE(5)
+        IF(NGPT.EQ.0)  CALL XABORT('GRAD: MISSING FIXED-SOURCE EIGENVA'
+     1  //'LUE SOLUTION')
+        IPGPT=KENTRY(3)
+        CALL LCMGTC(IPGPT,'SIGNATURE',12,HSIGN)
+        IF(HSIGN.NE.'L_SOURCE') THEN
+           TEXT12=HENTRY(3)
+           CALL XABORT('GRAD: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     1     '. L_SOURCE EXPECTED.')
+        ENDIF
+        CALL LCMGET(IPGPT,'STATE-VECTOR',ISTATE)
+        ND=ISTATE(3)
+        NA=ISTATE(4)
+*----
+*  COMPUTE THE NUMBER OF CONSTRAINTS AND OF CONTROL VARIABLES
+*----
+        IF(ITYPE.EQ.100) THEN
+          NVAR0=NGPT
+          NCST0=NA-1
+        ELSE IF(ITYPE.EQ.1000) THEN
+          NVAR0=ND
+          NCST0=NGPT-1
+        ELSE
+          CALL XABORT('GRAD: INVALID FLUX OBJECT')
+        ENDIF
+      ENDIF
+*----
+*  READ INPUT PARAMETERS
+*----
+      IPRINT=1
+      IOPT=1
+      ICONV=0
+      IEXT=0
+      IEDSTP=2
+      IHESS=0
+      ISEARC=0
+      IMETH=2
+      ISTEP=0
+      JCONV=0
+      SR=1.0D0
+      EPS1=0.1D0
+      EPS2=1.0D-4
+      EPS3=1.0D-4
+      EPS4=1.0D-4
+      IF(JENTRY(1).EQ.0) THEN
+        HSIGN='L_OPTIMIZE'
+        CALL LCMPTC(IPGRAD,'SIGNATURE',12,HSIGN)
+      ELSE IF (JENTRY(1).EQ.1) THEN
+        CALL LCMGTC(IPGRAD,'SIGNATURE',12,HSIGN)
+        IF(HSIGN.NE.'L_OPTIMIZE') THEN
+           TEXT12=HENTRY(3)
+           CALL XABORT('GRAD: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     1     '. L_OPTIMIZE EXPECTED.')
+        ENDIF
+        CALL LCMGET(IPGRAD,'STATE-VECTOR',ISTATE)
+        NVAR=ISTATE(1)
+        NCST=ISTATE(2)
+        IOPT=ISTATE(3)
+        ICONV=ISTATE(4)
+        IEXT=ISTATE(5)
+        IEDSTP=ISTATE(6)
+        IHESS=ISTATE(7)
+        ISEARC=ISTATE(8)
+        IMETH=ISTATE(9)
+        MAXEXT=ISTATE(12)
+        NSTART=ISTATE(13)
+        CALL LCMGET(IPGRAD,'OPT-PARAM-R',OPTPRR)
+        SR=OPTPRR(1)
+        EPS1=OPTPRR(2)
+        EPS2=OPTPRR(3)
+        EPS3=OPTPRR(4)
+        EPS4=OPTPRR(5)
+      ENDIF
+   10 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+      IF(INDIC.EQ.10) GO TO 20
+      IF(INDIC.NE.3) CALL XABORT('GRAD: CHARACTER DATA EXPECTED.')
+      IF(TEXT12(:4).EQ.'EDIT') THEN
+        CALL REDGET(INDIC,IPRINT,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1) CALL XABORT('GRAD: INTEGER DATA EXPECTED FOR IP'
+     1  //'RINT.')
+      ELSE IF(TEXT12(:8).EQ.'MINIMIZE') THEN
+        IOPT=1
+      ELSE IF(TEXT12(:8).EQ.'MAXIMIZE') THEN
+        IOPT=-1
+      ELSE IF(TEXT12.EQ.'OUT-STEP-LIM') THEN
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.2) CALL XABORT('GRAD: REAL DATA EXPECTED(1)')
+        SR=FLOTT
+      ELSE IF((TEXT12(:9).EQ.'VAR-VALUE').OR.
+     1        (TEXT12(:10).EQ.'VAR-WEIGHT')) THEN
+        ALLOCATE(VARV(NVAR))
+        DO IVAR=1,NVAR
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
+          IF(INDIC.NE.2) CALL XABORT('GRAD: REAL DATA EXPECTED(2)')
+          VARV(IVAR)=FLOTT
+        ENDDO
+        CALL LCMPUT(IPGRAD,TEXT12,NVAR,4,VARV)
+        DEALLOCATE(VARV)
+      ELSE IF((TEXT12(:11).EQ.'VAR-VAL-MIN').OR.
+     1        (TEXT12(:11).EQ.'VAR-VAL-MAX')) THEN
+        ALLOCATE(VARV(NVAR))
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
+        IF(INDIC.EQ.2) THEN
+          VARV=FLOTT
+          DO IVAR=2,NVAR
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
+            IF(INDIC.NE.2) CALL XABORT('GRAD: REAL DATA EXPECTED(3)')
+            VARV(IVAR)=FLOTT
+          ENDDO
+        ELSE IF((INDIC.EQ.3).AND.(TEXT4.EQ.'ALL')) THEN
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
+          IF(INDIC.NE.2) CALL XABORT('GRAD: REAL DATA EXPECTED(4)')
+          DO IVAR=1,NVAR
+            VARV(IVAR)=FLOTT
+          ENDDO
+        ELSE
+          CALL XABORT('GRAD: REAL DATA OR ALL KEYWORD EXPECTED')
+        ENDIF
+        CALL LCMPUT(IPGRAD,TEXT12,NVAR,4,VARV)
+        DEALLOCATE(VARV)
+      ELSE IF(TEXT12.EQ.'FOBJ-CST-VAL') THEN
+        ALLOCATE(CSTV(NCST+1))
+        DO ICST=1,NCST+1
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
+          IF(INDIC.NE.2) CALL XABORT('GRAD: REAL DATA EXPECTED(5)')
+          CSTV(ICST)=FLOTT
+        ENDDO
+        CALL LCMPUT(IPGRAD,'FOBJ-CST-VAL',NCST+1,4,CSTV)
+        OBJNEW=CSTV(1)
+        DEALLOCATE(CSTV)
+      ELSE IF(TEXT12(:8).EQ.'CST-TYPE') THEN
+        IF(NCST.EQ.0) CALL XABORT('GRAD: CST-TYPE KEYWORD FORBIDDEN')
+        ALLOCATE(IREL(NCST))
+        DO ICST=1,NCST
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
+          IF(INDIC.NE.1) THEN
+            CALL XABORT('GRAD: INTEGER DATA EXPECTED')
+          ELSE IF((NITMA.LT.-1).OR.(NITMA.GT.1)) THEN
+            CALL XABORT('GRAD: -1, 0 or 1 EXPECTED')
+          ENDIF
+          IREL(ICST)=NITMA
+        ENDDO
+        CALL LCMPUT(IPGRAD,'CST-TYPE',NCST,1,IREL)
+        DEALLOCATE(IREL)
+      ELSE IF(TEXT12(:7).EQ.'CST-OBJ') THEN
+        IF(NCST.EQ.0) CALL XABORT('GRAD: CST-OBJ KEYWORD FORBIDDEN')
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
+        IF(INDIC.EQ.2) THEN
+          ALLOCATE(RHS(NCST))
+          RHS(1)=FLOTT
+          DO ICST=2,NCST
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
+            IF(INDIC.NE.2) CALL XABORT('GRAD: REAL DATA EXPECTED(6)')
+            RHS(ICST)=FLOTT
+          ENDDO
+          CALL LCMPUT(IPGRAD,'CST-OBJ',NCST,4,RHS)
+          DEALLOCATE(RHS)
+        ELSE
+          CALL XABORT('GRAD: REAL DATA OR KEEP KEYWORD EXPECTED')
+        ENDIF
+      ELSE IF(TEXT12(:10).EQ.'CST-WEIGHT') THEN
+        IF(NCST.EQ.0) CALL XABORT('GRAD: CST-WEIGHT KEYWORD FORBIDDEN')
+        ALLOCATE(RHS(NCST))
+        DO ICST=1,NCST
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
+          IF(INDIC.NE.2) CALL XABORT('GRAD: REAL DATA EXPECTED(7)')
+          RHS(ICST)=FLOTT
+        ENDDO
+        CALL LCMPUT(IPGRAD,'CST-WEIGHT',NCST,4,RHS)
+        DEALLOCATE(RHS)
+      ELSE IF(TEXT12(:1).EQ.';') THEN
+        GO TO 20
+      ELSE 
+        CALL XABORT('GRAD: '//TEXT12//' IS AN INVALID KEYWORD')
+      ENDIF
+      GO TO 10
+*----
+*  CALCULATION OF THE NEW GRADIENT
+*----
+   20 IF(IPRINT.GT.0) THEN
+        IF(ITYPE.EQ.100) THEN
+          WRITE(6,'(/25H GRAD: EXPLICIT APPROACH.)')
+        ELSE IF(ITYPE.EQ.1000) THEN
+          WRITE(6,'(/25H GRAD: IMPLICIT APPROACH.)')
+        ENDIF
+      ENDIF
+      ALLOCATE(DERIV(NVAR*(NCST+1)))
+      DERIV(:NVAR*(NCST+1))=0.0D0
+      IF(C_ASSOCIATED(IPFLX).AND.C_ASSOCIATED(IPGPT)) THEN
+        IF(NVAR0.NE.NVAR) CALL XABORT('GRAD: INCONSISTENT NVAR.')
+        IF(NCST0.GT.NCST) CALL XABORT('GRAD: INCONSISTENT NCST.')
+*       ------------------------------------------
+        CALL GRA001(IPFLX,IPGPT,NVAR0,NCST0,DERIV)
+*       ------------------------------------------
+      ENDIF
+      CALL LCMLEN(IPGRAD,'GRADIENT-DIR',LENGTH,ITYLCM)
+      IF(LENGTH.EQ.NVAR*(NCST+1)) THEN
+        ALLOCATE(DERIV0(NVAR*(NCST+1)))
+        CALL LCMGET(IPGRAD,'GRADIENT-DIR',DERIV0)
+        DO I=1,NVAR*(NCST+1)
+          DERIV(I)=DERIV(I)+DERIV0(I)
+        ENDDO
+        DEALLOCATE(DERIV0)
+      ENDIF
+      CALL LCMPUT(IPGRAD,'GRADIENT',NVAR*(NCST+1),4,DERIV)
+      DEALLOCATE(DERIV)
+*----
+*  PRINT INFORMATION
+*----
+      IF(IPRINT.GT.0) THEN
+        WRITE(6,'(/31H GRAD: INFORMATION AT ITERATION,I5)') IEXT+1
+        CALL LCMLEN(IPGRAD,'VAR-VALUE',ILONG,ITYLCM)
+        IF(ILONG.GT.0) THEN 
+          ALLOCATE(VARV(NVAR))
+          CALL LCMGET(IPGRAD,'VAR-VALUE',VARV)
+          WRITE(6,100) 'CONTROL VARIABLES:',(VARV(IVAR),IVAR=1,NVAR)
+          DEALLOCATE(VARV)
+        ENDIF
+        IF(IPRINT.GT.1) THEN
+          ALLOCATE(DERIV(NVAR*(NCST+1)))
+          CALL LCMGET(IPGRAD,'GRADIENT',DERIV)
+          WRITE(6,'(/29H GRADIENTS-------------------)')
+          WRITE(6,100) 'OBJECTIVE FUNCTION:',(DERIV(IVAR),IVAR=1,NVAR)
+          IF(IPRINT.GT.2) THEN
+            DO 60 ICST=1,NCST
+            WRITE(TEXT16,'(10HCONSTRAINT,I4,1H:)') ICST
+            WRITE(6,100) TEXT16,(DERIV(ICST*NVAR+IVAR),IVAR=1,NVAR)
+   60       CONTINUE
+          ENDIF
+          DEALLOCATE(DERIV)
+        ENDIF
+      ENDIF
+*----
+*  SAVE THE STATE VECTORS
+*----
+      ISTATE(1)=NVAR
+      ISTATE(2)=NCST
+      ISTATE(3)=IOPT
+      ISTATE(4)=ICONV
+      ISTATE(5)=IEXT
+      ISTATE(6)=IEDSTP
+      ISTATE(7)=IHESS
+      ISTATE(8)=ISEARC
+      ISTATE(9)=IMETH
+      ISTATE(10)=ISTEP
+      ISTATE(11)=JCONV
+      ISTATE(14)=0
+      IF(IPRINT.GT.0) WRITE(6,110) (ISTATE(I),I=1,9)
+      CALL LCMPUT(IPGRAD,'STATE-VECTOR',NSTATE,1,ISTATE)
+      OPTPRR(:NSTATE)=0.0D0
+      OPTPRR(1)=SR
+      OPTPRR(2)=EPS1
+      OPTPRR(3)=EPS2
+      OPTPRR(4)=EPS3
+      OPTPRR(5)=EPS4
+      IF(IPRINT.GT.0) WRITE(6,120) (OPTPRR(I),I=1,5)
+      CALL LCMPUT(IPGRAD,'OPT-PARAM-R',NSTATE,4,OPTPRR)
+      IF(IPRINT.GT.2) CALL LCMLIB(IPGRAD)
+      RETURN
+*
+  100 FORMAT(1X,A28,1P,8E12.4/(29X,8E12.4))
+  110 FORMAT(/8H OPTIONS/8H -------/
+     1 7H NVAR  ,I8,32H   (NUMBER OF CONTROL VARIABLES)/
+     2 7H NCST  ,I8,26H   (NUMBER OF CONSTRAINTS)/
+     3 7H IOPT  ,I8,37H   (=1/-1: MINIMIZATION/MAXIMIZATION)/
+     4 7H ICONV ,I8,43H   (=0/1: EXTERNAL NOT CONVERGED/CONVERGED)/
+     5 7H IEXT  ,I8,32H   (INDEX OF EXTERNAL ITERATION)/
+     6 7H IEDSTP,I8,43H   (=1/2: HALF REDUCTION/PARABOLIC FORMULA)/
+     7 7H IHESS ,I8,29H   (=0/1/2: STEEPEST/CG/BFGS)/
+     8 7H ISEARC,I8,35H   (=0/1/2: NO SEARCH/OPTEX/NEWTON)/
+     9 7H IMETH ,I8,42H   (=1/2/3: SIMPLEX-LEMKE/LEMKE-LEMKE/MAP))
+  120 FORMAT(/
+     1 12H REAL PARAM:,1P/12H -----------/
+     2 7H SR    ,D12.4,39H   (RADIUS OF THE QUADRATIC CONSTRAINT)/
+     3 7H EPS1  ,D12.4,13H   (NOT USED)/
+     4 7H EPS2  ,D12.4,31H   (EXTERNAL CONVERGENCE LIMIT)/
+     5 7H EPS3  ,D12.4,31H   (INTERNAL CONVERGENCE LIMIT)/
+     6 7H EPS4  ,D12.4,43H   (QUADRATIC CONSTRAINT CONVERGENCE LIMIT))
+      END
diff --git a/Donjon/src/HST.f b/Donjon/src/HST.f
new file mode 100644
index 0000000..16ba333
--- /dev/null
+++ b/Donjon/src/HST.f
@@ -0,0 +1,622 @@
+*DECK HST
+      SUBROUTINE HST(NENTRY, HENTRY, IENTRY, JENTRY, KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* To extract from or save to a \dds{history} data structure 
+* the information related to various cells in a reactor.
+*
+*Copyright:
+* Copyright (C) 2003 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* G. Marleau, E. Varin
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* For HST:, the possible calling specifications  are:
+* Option 1: Updating an \emph{history} structure using a \emph{map} structure
+* history := HST: [ history ]  map [ :: [ (hstdim) ]  [ GET (hstpar) ] ] ;
+* Option 2: Updating an \emph{history} structure using a \emph{burnup} structure
+* history := HST: [ history ]  [ burnup ] [ :: [ (hstdim) ]
+*   [ GET (hstpar) ] [ CELLID icha ibun [ idfuel ] [ GET (hstpar) ] ] ] ; 
+* Option 3: Updating a \emph{burnup} structure using an \emph{history} structure
+* burnup := HST: history [ :: [ (hstdim ] 
+*    [ PUT (hstpar) ]
+*    CELLID icha ibun
+*    [ PUT { BREFL  (hstbrn) (hstpar) AREFL (hstbrn) (hstpar) 
+*            | [ AREFL ] (hstbrn) (hstpar) } ] ] ;
+* Option 4: Updating a \emph{map} data structure from the information available 
+*   on an \emph{history} data structure:
+* map := HST:  map  history ;
+* where
+*   history : name of an \emph{history} data structure. 
+*   burnup  : name of a \emph{burnup} data structure. 
+*   map     : name of a \emph{map} data structure. 
+*   (hstdim) : structure containing the dimensions for the \emph{history} 
+*     data structure.
+*   CELLID  : keyword to identify the cell for which history information is 
+*     to be processed.
+*   icha    : channel number for which history information is to be processed. 
+*   ibun    : bundle number for which history information is to be processed. 
+*   idfuel  : fuel type number associated with this cell. One can associate to 
+*     each fuel cell a different fuel type. By default a single fuel type is
+*     defined and it fills every fuel cell. Only the initial properties of each
+*     fuel type are saved. These properties are used for refueling. 
+*   GET     : keyword to specify that the values of the parameters selected in 
+*     (brnpar will be read from the input stream or CLE-2000 local variables
+*     and stored on the \emph{history data structure.
+*   PUT     : keyword to specify that the values of the parameters selected in
+*     (brnpar will be read from the \emph{history data structure and
+*      transferred to local CLE-2000 variables.
+*   BREFL   : to specify that the information to extract from the \emph{history}
+*     data structure is related to the properties of the cell before refueling 
+*     takes place.
+*   AREFL   : to specify that the information to extract from the \emph{history}
+*     data base is related to the properties of the cell after refueling took
+*     place.
+*   (hstbrn) : structure containing the burnup options.
+*   (hstpar) : structure containing the local parameters options.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL PARAMETERS
+*----
+      INTEGER          IOUT,ILCMUP,ILCMDN,NSTATE,NTC,MAXENT
+      CHARACTER        NAMSBR*6,TEXT12*12
+      PARAMETER       (IOUT=6,ILCMUP=1,ILCMDN=2,NSTATE=40,
+     >                 NTC=3,MAXENT=2,NAMSBR='HST   ')
+      INTEGER          NSTOLD
+      PARAMETER       (NSTOLD=20)
+*----
+*  Debug print flag
+*  IDEB = 0  -> no print debug
+*       > 0  -> print debug
+*----
+      INTEGER          IDEB 
+      PARAMETER       (IDEB=0) 
+*----
+*  LOCAL VARIABLES
+*----
+      CHARACTER        CBLANK*4,SIGENT(MAXENT)*12
+      INTEGER          IBLANK,NAMTMP(NTC)
+      INTEGER          ISTATB(NSTATE),ISTATH(NSTATE),ISTATM(NSTATE)
+      INTEGER          ILCMLN,ILCMTY 
+      INTEGER          IEN,ITC,ITYPRO
+      INTEGER          IKHST,IKEVO,IKMAP
+      INTEGER          NCELL,IUPDC,IUPDB
+      TYPE(C_PTR)      IPHST,IPEVO,IPMAP
+*----
+*  HISTORY Parameters
+*----
+      INTEGER          MAXG,MAXL,NBUNH,NCHAH,
+     >                 ITSOLH,ITBURH,MAXIH,NREGH
+      REAL             BUNLEN 
+*----
+*  BURNUP Parameters
+*----
+      INTEGER          ITSOLB,ITBURB,NBBTS,MAXIB
+      REAL             REVOL(5)
+*----
+*  MAP Parameters
+*----
+      INTEGER          NBUNM,NCHAM,NBFUEL 
+*----
+*  Variables from HSTGDM
+*----
+      INTEGER          IPRINT,NGLO,NLOC,NBUN,NCHA,ITYRED
+      CHARACTER*12     CARRED
+      INTEGER          II
+*----
+*  MEMORY ALLOCATION
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: NAMG,NAML,IDCELL,IDFUEL,
+     > IREFUS
+      REAL, ALLOCATABLE, DIMENSION(:) :: PARAG,PARAL,REFUT,DENI,POWR,
+     > BURN
+*----
+*  initialize blank signatures
+*----
+      DO 100 IEN=1,MAXENT
+        SIGENT(IEN)='            '
+ 100  CONTINUE
+      CBLANK='    '
+      READ(CBLANK,'(A4)') IBLANK
+      ISTATB(:NSTATE)=0
+      ISTATH(:NSTATE)=0
+      ISTATM(:NSTATE)=0
+*----
+*  PARAMETER VALIDATION.
+*  1 or 2 data structures permitted
+*  If one data structure it must be an 
+*  HISTORY structure, 
+*  If two data structure, one of them must be and history
+*  while the second one can be a BURNUP or MAP structure
+*  Options:
+*  2)   [History] := HST: [History] [Burnup] :: ... ;
+*  3)    History  := HST: [History] Map      :: ... ;
+*  3)    Burnup   := HST: History            :: ... ;
+*---- 
+      IF(NENTRY .EQ. 0) THEN
+        CALL XABORT(NAMSBR//
+     >': At least one data structure expected.')
+      ELSE IF(NENTRY .GT. MAXENT) THEN
+        CALL XABORT(NAMSBR//
+     >': Maximum number of structures exceeded.')
+      ENDIF
+      DO 110 IEN=1,NENTRY
+        TEXT12=HENTRY(IEN)
+        IF(IENTRY(IEN) .NE. 1 .AND. IENTRY(IEN) .NE. 2)
+     >  CALL XABORT(NAMSBR//
+     >': Data structure '//TEXT12//' must be of type LCM or XSM.')
+ 110  CONTINUE
+      IEN = 1 
+      IF(JENTRY(IEN) .EQ. 2 ) THEN
+        IF(NENTRY .EQ. 2) CALL XABORT(NAMSBR//
+     >    ': First data structure must be in create or update mode.')
+        CALL LCMLEN(KENTRY(IEN),'SIGNATURE',ILCMLN,ILCMTY)
+        IF(ILCMLN .GT. 0) THEN
+          CALL LCMGET(KENTRY(IEN),'SIGNATURE',NAMTMP)
+          WRITE(SIGENT(IEN),'(3A4)') (NAMTMP(ITC),ITC=1,NTC)
+        ENDIF
+      ELSE IF(JENTRY(IEN) .EQ. 1 ) THEN
+        CALL LCMLEN(KENTRY(IEN),'SIGNATURE',ILCMLN,ILCMTY)
+        IF(ILCMLN .GT. 0) THEN
+          CALL LCMGET(KENTRY(IEN),'SIGNATURE',NAMTMP)
+          WRITE(SIGENT(IEN),'(3A4)') (NAMTMP(ITC),ITC=1,NTC)
+        ENDIF
+      ENDIF
+      IF(NENTRY .EQ. 2) THEN 
+        IEN = 2 
+        IF(JENTRY(IEN) .NE. 2 ) CALL XABORT(NAMSBR//
+     >    ': Second data structure must be in read-only mode.')
+        CALL LCMLEN(KENTRY(IEN),'SIGNATURE',ILCMLN,ILCMTY)
+        IF(ILCMLN .LE. 0) CALL XABORT(NAMSBR//
+     >': No signature found on second data structure')
+        CALL LCMGET(KENTRY(IEN),'SIGNATURE',NAMTMP) 
+        WRITE(SIGENT(IEN),'(3A4)') (NAMTMP(ITC),ITC=1,NTC)
+      ENDIF
+      IKHST=0
+      IKEVO=0
+      IKMAP=0
+      DO 111 IEN=1,NENTRY
+        IF     (SIGENT(IEN) .EQ. 'L_HISTORY   ') THEN
+          IF(IKHST .NE. 0) CALL XABORT(NAMSBR//
+     >      ': Two history structure forbidden.')
+          IKHST=IEN
+        ELSE IF(SIGENT(IEN) .EQ. 'L_BURNUP    ') THEN 
+          IF(IKEVO .NE. 0) CALL XABORT(NAMSBR//
+     >      ': Two burnup structure forbidden.')
+          IKEVO=IEN
+        ELSE IF(SIGENT(IEN) .EQ. 'L_MAP       ') THEN 
+          IF(IKMAP .NE. 0) CALL XABORT(NAMSBR//
+     >      ': Two map structure forbidden.')
+          IKMAP=IEN
+        ELSE IF(SIGENT(IEN) .NE. '            ') THEN
+          CALL XABORT(NAMSBR//
+     >    ': At least on structure type is invalid.')
+        ENDIF
+ 111  CONTINUE
+      BUNLEN=1.0
+*----
+*  For structures with SIGNATURE read STATE-VECTOR
+*----
+      IF(IKHST .GT. 0) THEN
+        CALL LCMGET(KENTRY(IKHST),'STATE-VECTOR',ISTATH)
+        CALL LCMGET(KENTRY(IKHST),'BUNDLELENGTH',BUNLEN)
+      ENDIF 
+      IF(IKEVO .GT. 0) THEN
+        CALL LCMGET(KENTRY(IKEVO),'STATE-VECTOR',ISTATB)
+        CALL LCMGET(KENTRY(IKEVO),'EVOLUTION-R ',REVOL)
+      ENDIF 
+      IF(IKMAP .GT. 0) THEN
+        CALL LCMGET(KENTRY(IKMAP),'STATE-VECTOR',ISTATM)
+      ENDIF 
+*----
+*  Select type of processing depending
+*  on order of structures
+*  ITYPRO =  1 : History := HST:                  ::
+*  ITYPRO =  2 : History := HST: History          ::
+*  ITYPRO =  3 : History := HST: Burnup           ::
+*  ITYPRO =  4 : History := HST: History Burnup   ::
+*  ITYPRO =  5 : History := HST: Map              ::
+*  ITYPRO =  6 : History := HST: History Map      ::
+*  ITYPRO = -1 :         := HST: History          ::
+*  ITYPRO = -3 : Burnup  := HST: History          ::
+*  ITYPRO = -4 : Burnup  := HST: Burnup History   ::
+*  ITYPRO = -5 : Map     := HST: Map  History     ::
+*----
+      IF(NENTRY .EQ. 1) THEN
+        IF(IKEVO .NE. 0 .OR. IKMAP .NE. 0) CALL XABORT(NAMSBR//
+     >  ': A single burnup or map structure forbidden.')
+        IF(IKHST .EQ. 1) THEN
+          ITYPRO=2
+          IF(JENTRY(1) .EQ. 2) THEN
+            ITYPRO=-1
+          ENDIF
+        ELSE
+          IKHST=1
+          ITYPRO=1
+          SIGENT(IKHST)='L_HISTORY   '
+          READ(SIGENT(IKHST),'(3A4)') (NAMTMP(ITC),ITC=1,NTC)
+          CALL LCMPUT(KENTRY(IKHST),'SIGNATURE',NTC,3,NAMTMP)
+        ENDIF
+      ELSE
+        IF(IKHST .EQ. 2) THEN
+          IF(IKMAP .EQ. 1) THEN
+            ITYPRO = -5
+          ELSE IF(IKEVO .EQ. 1) THEN
+            ITYPRO=-4
+          ELSE 
+            ITYPRO=-3
+            IKEVO=1 
+            SIGENT(IKEVO)='L_BURNUP    '
+            READ(SIGENT(IKEVO),'(3A4)') (NAMTMP(ITC),ITC=1,NTC)
+            CALL LCMPUT(KENTRY(IKEVO),'SIGNATURE',NTC,3,NAMTMP)
+          ENDIF
+        ELSE IF(IKEVO.EQ.2) THEN
+          IF(IKHST .EQ. 1) THEN
+            ITYPRO=4
+          ELSE
+            ITYPRO=3
+            IKHST=1 
+            SIGENT(IKHST)='L_HISTORY   '
+            READ(SIGENT(IKHST),'(3A4)') (NAMTMP(ITC),ITC=1,NTC)
+            CALL LCMPUT(KENTRY(IKHST),'SIGNATURE',NTC,3,NAMTMP)
+          ENDIF
+        ELSE IF(IKMAP.EQ.2) THEN
+          IF(IKHST .EQ. 1) THEN
+            ITYPRO=6
+          ELSE
+            ITYPRO=5
+            IKHST=1 
+            SIGENT(IKHST)='L_HISTORY   '
+            READ(SIGENT(IKHST),'(3A4)') (NAMTMP(ITC),ITC=1,NTC)
+            CALL LCMPUT(KENTRY(IKHST),'SIGNATURE',NTC,3,NAMTMP)
+          ENDIF
+        ELSE
+          CALL XABORT(NAMSBR//
+     >    ': A read-only burnup or map structure required.')
+        ENDIF
+      ENDIF
+      IF(IKHST .NE. 0) IPHST=KENTRY(IKHST)
+      IF(IKEVO .NE. 0) IPEVO=KENTRY(IKEVO)
+      IF(IKMAP .NE. 0) IPMAP=KENTRY(IKMAP)
+*----
+*  Get elements of HISTORY STATE-VECTOR
+*----
+      MAXG  =ISTATH( 1)
+      MAXL  =ISTATH( 2)
+      NBUNH =ISTATH( 3)
+      NCHAH =ISTATH( 4)
+      ITSOLH=ISTATH( 6)
+      ITBURH=ISTATH( 7)
+      MAXIH =ISTATH( 8)
+      NREGH =ISTATH(10)
+      IF(IDEB .EQ. 1) THEN
+        WRITE(IOUT,7000) (ISTATH(II),II=1,8),ISTATH(10)
+      ENDIF
+*----
+*  Get elements of BURNUP STATE-VECTOR
+*----
+      ITSOLB=ISTATB(1)
+      ITBURB=ISTATB(2)
+      NBBTS =ISTATB(3)
+      MAXIB =ISTATB(4)
+      IF(IDEB .EQ. 1) THEN
+        WRITE(IOUT,7001) (ISTATB(II),II=1,6)
+      ENDIF
+      IF(ITYPRO .EQ. 3 .OR. ITYPRO .EQ. 4) THEN
+        ITSOLH=ITSOLB
+        ITBURH=ITBURB
+        IF(MAXIH .NE. 0 .AND. MAXIH .NE. MAXIB) CALL XABORT(NAMSBR//
+     >  ': Different number of isotopes in history and burnup')
+        MAXIH=MAXIB
+      ELSE IF(ITYPRO .EQ. -3 .OR. ITYPRO .EQ. -4) THEN
+        ITSOLB=ITSOLH
+        ITBURB=ITBURH
+        IF(MAXIB .NE. 0 .AND. MAXIB .NE. MAXIH) CALL XABORT(NAMSBR//
+     >  ': Different number of isotopes in history and burnup')
+        MAXIB=MAXIH
+      ENDIF 
+*----
+*  Get elements of MAP STATE-VECTOR
+*  and verify consistency with history information
+*----
+      NBUNM =ISTATM(1)
+      NCHAM =ISTATM(2)
+      IF(NBUNM .NE. 0) THEN
+        IF(NBUNH .EQ. 0) THEN
+          NBUNH=NBUNM
+        ELSE IF(NBUNH .NE. NBUNM) THEN 
+          CALL XABORT(NAMSBR//': Different number of bundles in'//
+     >                        ' MAP and HISTORY structures')
+        ENDIF
+      ENDIF
+      IF(NCHAM .NE. 0) THEN
+        IF(NCHAH .EQ. 0) THEN
+          NCHAH=NCHAM
+        ELSE IF(NCHAH .NE. NCHAM) THEN 
+          CALL XABORT(NAMSBR//': Different number of channels in'//
+     >                        ' MAP and HISTORY structures')
+        ENDIF
+      ENDIF
+*----
+*  Test compatibility of HISTORY, BURNUP and MAP data structures.
+*---- 
+      IF(ITYPRO .EQ.  4 .OR. ITYPRO .EQ. -4) THEN
+        IF(ITSOLB .NE. ITSOLH .OR. 
+     >     ITBURB .NE. ITBURH .OR.
+     >     MAXIB  .NE. MAXIH  ) CALL XABORT(NAMSBR//
+     >    ': HISTORY and BURNUP parameters incompatible')
+      ELSE IF(ITYPRO .EQ.  6) THEN
+        IF(NBUNM  .NE. NBUNH .OR. 
+     >     NCHAM  .NE. NCHAH      ) CALL XABORT(NAMSBR//
+     >    ': HISTORY and MAP parameters incompatible')
+      ENDIF
+*----
+*  Get EDIT level and dimensioning parameters for history structure
+*  and test their validity
+*----
+      IPRINT=1
+      NGLO  =MAXG
+      NLOC  =MAXL
+      NBUN  =NBUNH
+      NCHA  =NCHAH
+      CALL HSTGDM(IPRINT,NGLO  ,NLOC  ,NCHA  ,NBUN  ,
+     >            BUNLEN,ITYRED,CARRED)
+*----
+*  Test dimensioning parameters for coherence
+*  with already defined parameters
+*----
+      MAXG=MAX(MAXG,NGLO)
+      MAXL=MAX(MAXL,NLOC)
+      IF(NBUN .LE. 0 ) CALL XABORT(NAMSBR// 
+     >': Number of bundles must be larger than 0')
+      IF(NCHA .LE. 0 ) CALL XABORT(NAMSBR// 
+     >': Number of channels must be larger than 0')
+      IF(NBUNH .GT. 0 .AND. NBUN .NE. NBUNH) CALL XABORT(NAMSBR// 
+     >': Number of bundles on input'//
+     >' different from HISTORY, MAP or BURNUP structures')
+      NBUNH=MAX(NBUN,NBUNH)
+      IF(NCHAH .GT. 0 .AND. NCHA .NE. NCHAH) CALL XABORT(NAMSBR// 
+     >': Number of channels on input'//
+     >' different from HISTORY, MAP or BURNUP structures')
+      NCHAH=MAX(NCHA,NCHAH)
+      IF(IPRINT .GE. 10) THEN
+        WRITE(IOUT,6010) NGLO,NLOC,NCHA,NBUN
+      ENDIF
+*----
+* Allocate memory for global and local parameters
+*---- 
+      ALLOCATE(NAMG(3*(MAXG+1)),PARAG(MAXG+1),NAML(3*(MAXL+1)),
+     > PARAL((MAXL+1)*2))
+      NAMG(:3*(MAXG+1))=IBLANK
+      PARAG(:MAXG+1)=0.0
+      NAML(:3*(MAXL+1))=IBLANK
+      IF(ISTATH(1) .GT. 0) THEN
+        CALL LCMGET(IPHST,'NAMEGLOBAL  ',NAMG(4))
+        CALL LCMGET(IPHST,'PARAMGLOBAL ',PARAG(2))
+        IF(IDEB .GE. 1) THEN 
+          WRITE(IOUT,'(A18,2I10)') 'Initial NAMEGLOBAL',MAXG,ISTATH(1) 
+          WRITE(IOUT,'(6(3A4,2X))') (NAMG(3+II),II=1,3*MAXG) 
+        ENDIF
+      ENDIF
+      IF(ISTATH(2) .GT. 0) THEN
+        CALL LCMGET(IPHST,'NAMELOCAL   ',NAML(4))
+        IF(IDEB .GE. 1) THEN 
+          WRITE(IOUT,'(A18,2I10)') 'Initial NAMELOCAL ',MAXL,ISTATH(2) 
+          WRITE(IOUT,'(6(3A4,2X))') (NAML(3+II),II=1,3*MAXL) 
+        ENDIF
+      ENDIF
+      IF(NCHAH .LT. 1 .OR. NBUNH .LT. 1 ) CALL XABORT(NAMSBR//
+     >': Both the number of channels and bundles must be > 0')
+*----
+*  Allocate memory for core description
+*----
+      NCELL=NCHAH*NBUNH
+      IF(IPRINT .GE. 10) THEN
+        WRITE(IOUT,6011) NCELL,NCHAH,MAXIH
+      ENDIF
+      ALLOCATE(IDCELL(NCELL),IDFUEL(NCELL),IREFUS(NCHAH),REFUT(NCHAH))
+      IDCELL(:NCELL)=0
+      IDFUEL(:NCELL)=0
+      IF(ISTATH( 3)*ISTATH( 4) .GT. 0) THEN
+        CALL LCMGET(IPHST,'CELLID      ',IDCELL)
+        CALL LCMGET(IPHST,'FUELID      ',IDFUEL)
+      ENDIF
+      IREFUS(:NCHAH)=0
+      REFUT(:NCHAH)=0.0
+      ALLOCATE(DENI(MAXIH+1))
+      NBFUEL=0
+*----
+*  Allocate memory for MAP power
+*----
+      ALLOCATE(POWR(NCELL),BURN(NCELL))
+      POWR(:NCELL)=0.0
+      BURN(:NCELL)=0.0
+      IF(ITYPRO .EQ. 5 .OR. ITYPRO .EQ. 6) THEN
+*----
+*  Read information from MAP data structure
+*  and update history using this information
+*---- 
+        CALL HSTUHM(IPHST, IPMAP, IPRINT, MAXL, NCHAH ,NBUNH, MAXIH,
+     >              POWR,BURN,IREFUS,
+     >              REFUT,BUNLEN,IDCELL,IDFUEL,PARAL,DENI)        
+*----
+* Update Map with History
+*---- 
+      ELSE IF(ITYPRO .EQ. -5) THEN
+        CALL HSTUMH(IPMAP, IPHST, IPRINT,NCHAH ,NBUNH, IDCELL, BURN)
+      ENDIF
+*----
+*  Release memory for MAP power
+*----
+      DEALLOCATE(BURN,POWR)
+*----
+*  Read or write remaining information on input
+*  Also extract information from history if required
+*----
+      CALL HSTGET(IPHST ,IPRINT,MAXG  ,MAXL  ,NCHAH ,NBUNH ,
+     >            ITYPRO,ITYRED,CARRED,IUPDC ,IUPDB ,
+     >            NAMG ,PARAG,NAML ,
+     >            PARAL,IDCELL,IDFUEL)
+      IF(ITYPRO .GT. 0) THEN
+        IF(MAXG .GT. 0) THEN
+          CALL LCMPUT(IPHST,'NAMEGLOBAL  ',3*MAXG,3,NAMG(4))
+          CALL LCMPUT(IPHST,'PARAMGLOBAL ',  MAXG,2,PARAG(2))
+          IF(IDEB .GE. 1) THEN 
+            WRITE(IOUT,'(A18,2I10)') 'Final NAMEGLOBAL  ',MAXG,ISTATH(1)
+            WRITE(IOUT,'(6(3A4,2X))') (NAMG(3+II),II=1,3*MAXG) 
+          ENDIF
+        ENDIF
+        IF(MAXL .GT. 0) THEN
+          CALL LCMPUT(IPHST,'NAMELOCAL   ',3*MAXL,3,NAML(4))
+          IF(IDEB .GE. 1) THEN 
+            WRITE(IOUT,'(A18,2I10)') 'Final NAMELOCAL   ',MAXL,ISTATH(2)
+            WRITE(IOUT,'(6(3A4,2X))') (NAML(3+II),II=1,3*MAXL) 
+          ENDIF
+        ENDIF
+        IF(NCELL .GT. 0) THEN
+          CALL LCMPUT(IPHST,'CELLID      ',NCELL,1,IDCELL)
+          CALL LCMPUT(IPHST,'FUELID      ',NCELL,1,IDFUEL)
+        ENDIF
+      ENDIF
+*----
+*  If channel and bundle specified
+*  Update information on HISTORY or BURNUP structures
+*----
+      IF(IUPDC .GT. 0 .AND. IUPDB .GT. 0) THEN
+*----
+*  Allocate memory for isotopes and burnup
+*----
+        IF(IPRINT .GE. 10) THEN
+          WRITE(IOUT,6000) NAMSBR,IUPDC,IUPDB 
+        ENDIF
+        IF(ITYPRO .EQ. 3 .OR. ITYPRO .EQ. 4) THEN
+*----
+*  Update HISTORY information from BURNUP data for 
+*  channel IUPDC, bundle IUPDB.
+*---- 
+          IF(IPRINT .GE. 10) THEN
+            WRITE(IOUT,6001) 
+          ENDIF
+          CALL HSTUHB(IPHST ,IPEVO ,IPRINT,MAXIH ,NBBTS ,
+     >                NCHAH ,NBUNH ,IUPDC ,IUPDB ,
+     >                IDCELL,IDFUEL,
+     >                DENI ,MAXL, PARAL) 
+        ELSE IF(ITYPRO .EQ. -3 .OR. ITYPRO .EQ. -4) THEN
+*----
+*  Update BURNUP information from HISTORY data for 
+*  channel IUPDC, bundle IUPDB.
+*---- 
+          IF(IPRINT .GE. 10) THEN
+            WRITE(IOUT,6002) 
+          ENDIF
+          CALL HSTUBH(IPEVO ,IPHST ,IPRINT,MAXIH ,NBBTS ,
+     >                NCHAH ,NBUNH ,IUPDC ,IUPDB ,
+     >                IDCELL,IDFUEL,DENI)
+        ENDIF 
+      ENDIF
+      DEALLOCATE(DENI,REFUT,IREFUS,IDFUEL,IDCELL,PARAL,NAML,PARAG,NAMG)
+      IF(ITYPRO .GT. 0) THEN
+*----
+*  Saving updated HISTORY state vector
+*----
+        CALL LCMPUT(IPHST,'BUNDLELENGTH',1,2,BUNLEN)
+        ISTATH(:NSTATE)=0
+        ISTATH( 1) = MAXG  
+        ISTATH( 2) = MAXL  
+        ISTATH( 3) = NBUNH 
+        ISTATH( 4) = NCHAH 
+        ISTATH( 5) = 0 
+        ISTATH( 6) = ITSOLH
+        ISTATH( 7) = ITBURH
+        ISTATH( 8) = MAXIH 
+        ISTATH(10) = NREGH
+        IF(IPRINT .EQ. 10) THEN
+          WRITE(IOUT,7010) (ISTATH(II),II=1,8),ISTATH(10)
+        ENDIF
+        CALL LCMPUT(IPHST,'STATE-VECTOR',NSTATE,1,ISTATH)
+      ELSE IF(ITYPRO .EQ. -3 .OR. ITYPRO .EQ. -4 )  THEN
+*----
+*  Set burnup parameters to default values
+*  See subroutine EVO.f
+*----
+        REVOL(1)=1.0E-5 
+        REVOL(2)=1.0E-4 
+        REVOL(3)=80.0   
+        REVOL(4)=1.0E-4 
+        REVOL(5)=0.0 
+        CALL LCMPUT(IPEVO,'EVOLUTION-R ',5,2,REVOL)
+*----
+*  Saving updated BURNUP state vector
+*----
+        ISTATB(:NSTATE)=0
+        ISTATB( 1) = ITSOLB 
+        ISTATB( 2) = ITBURB 
+        IF(ISTATB( 1) .EQ. 0) ISTATB( 1) = 2
+        IF(ISTATB( 2) .EQ. 0) ISTATB( 2) = 2
+        ISTATB( 3) = 1 
+        ISTATB( 4) = MAXIH 
+        ISTATB( 8) = NCHA*NBUN
+        IF(IPRINT .GT. 1) THEN
+          WRITE(IOUT,7011) (ISTATB(II),II=1,8)
+        ENDIF
+        CALL LCMPUT(IPEVO,'STATE-VECTOR',NSTOLD,1,ISTATB)
+      ENDIF
+*----
+*  Module execution completed
+*----
+      RETURN
+*----
+*  FORMATS
+*----
+ 6000 FORMAT(' ***** OUTPUT FROM ',A6/
+     >' Processing: Channel ',I10,5X,'Bundle ',I10) 
+ 6001 FORMAT(' Updating HISTORY from BURNUP')
+ 6002 FORMAT(' Updating BURNUP from HISTORY')
+ 6010 FORMAT(' ***** General dimensioning '/
+     >       10X,'NGLO  =',I10,5X,'NLOC   =',I5/
+     >       10X,'NCHA  =',I10,5X,'NBUN   =',I5)
+ 6011 FORMAT(10X,'NCELL =',I10,5X,'NCHAH  =',I5/
+     >       10X,'MAXIH =',I10)
+ 7000 FORMAT(' Initial contents of HISTORY state vector'/
+     >5X,'MAXG  = ',I5,5X,'MAXL  = ',I5,5X,'NBUNH = ',I5,/
+     >5X,'NCHAH = ',I5,5X,'      = ',I5,5X,'ITSOLH= ',I5,/
+     >5X,'ITBURH= ',I5,5X,'MAXIH = ',I5,5X,'NREGH = ',I5) 
+ 7001 FORMAT(' Initial contents of BURNUP state vector'/
+     >5X,'ITSOL = ',I5,5X,'ITBUR = ',I5,5X,'NBBTS = ',I5,/
+     >5X,'MAXI  = ',I5,5X,'NGRP  = ',I5,5X,'NREG  = ',I5)
+ 7010 FORMAT(' Final contents of HISTORY state vector'/
+     >5X,'MAXG  = ',I5,5X,'MAXL  = ',I5,5X,'NBUNH = ',I5,/
+     >5X,'NCHAH = ',I5,5X,'      = ',I5,5X,'ITSOLH= ',I5,/
+     >5X,'ITBURH= ',I5,5X,'MAXIH = ',I5,5X,'NREGH = ',I5) 
+ 7011 FORMAT(' Final contents of BURNUP state vector'/
+     >5X,'ITSOL = ',I5,5X,'ITBUR = ',I5,5X,'NBBTS = ',I5,/
+     >5X,'MAXI  = ',I5,5X,'      = ',I5,5X,'      = ',I5,/
+     >5X,'      = ',I5,5X,'NBMIX = ',I5) 
+      END  
diff --git a/Donjon/src/HSTGDM.f b/Donjon/src/HSTGDM.f
new file mode 100644
index 0000000..d87011b
--- /dev/null
+++ b/Donjon/src/HSTGDM.f
@@ -0,0 +1,143 @@
+*DECK HSTGDM
+      SUBROUTINE HSTGDM(IPRINT, NGLO,   NLOC,   NCHA,   NBUN  ,
+     >                  BUNLEN, ITYRED, CARRED)
+*
+*----------
+*
+*Purpose:
+* To read the editing level and general dimensioning parameters
+* for the \dds{history} data structure.
+*
+*Copyright:
+* Copyright (C) 2003 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* G. Marleau
+*
+*Parameters: input/output
+* IPRINT  print level.
+* NGLO    number of global parameters.               
+* NLOC    number of local parameters.                
+* NCHA    number of fuel channels.                   
+* NBUN    number of bundles per channel.            
+* BUNLEN  length (cm) of a bundle.            
+* ITYRED  type of the last variable read.                
+* CARRED  last character string read.
+*                                                   
+*----------                                         
+*                                                   
+      USE GANLIB
+      IMPLICIT         NONE                         
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER          IPRINT,NGLO,NLOC,NCHA,NBUN
+      REAL             BUNLEN
+      INTEGER          ITYRED
+      CHARACTER*12     CARRED
+*----
+*  LOCAL PARAMETERS
+*----
+      INTEGER          IOUT
+      CHARACTER        NAMSBR*6
+      PARAMETER       (IOUT=6,NAMSBR='HSTGDM')
+*----
+*  INPUT VARIABLES 
+*  Input data is of the form
+*  [ EDIT iprint ]
+*  [ DIMENSIONS 
+*    [ GLOBAL  nglo  ]
+*    [ LOCAL   nloc   ]
+*    [ BUNDL   nbun  bunl ]
+*    [ CHANNEL ncha ]
+*----
+      INTEGER          ITYPLU,INTLIR
+      CHARACTER        CARLIR*12
+      REAL             REALIR
+      DOUBLE PRECISION DBLLIR
+*----
+*  Initialize output variables  variables
+*----
+      ITYPLU= 0
+      CARLIR='            '
+ 100  CONTINUE
+      CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+ 101  CONTINUE
+      IF(ITYPLU .EQ. 10) GO TO 105
+      IF(ITYPLU .NE. 3) CALL XABORT(NAMSBR//
+     >': Read error -- Character variable expected')
+      IF(CARLIR .EQ. ';') THEN
+        GO TO 105
+      ELSE IF(CARLIR(1:4) .EQ. 'EDIT') THEN
+        CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+        IF(ITYPLU .NE. 1) THEN
+          IPRINT=1
+          GO TO 101
+        ENDIF
+        IPRINT=INTLIR
+        GO TO 100
+      ELSE IF(CARLIR(1:4) .EQ. 'DIME') THEN
+ 110    CONTINUE
+        CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+        IF(ITYPLU .NE. 3) CALL XABORT(NAMSBR//
+     >  ': Read error -- Dimension type expected')
+        IF(CARLIR(1:4) .EQ. 'GLOB') THEN
+          CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+          IF(ITYPLU .NE. 1) CALL XABORT(NAMSBR//
+     >    ': Number of global parameters expected')
+          NGLO=INTLIR
+          GO TO 110
+        ELSE IF(CARLIR(1:4) .EQ. 'LOCA') THEN
+          CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+          IF(ITYPLU .NE. 1) CALL XABORT(NAMSBR//
+     >    ': Number of local parameters expected')
+          NLOC=INTLIR
+          GO TO 110
+        ELSE IF(CARLIR(1:4) .EQ. 'BUND') THEN
+          CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+          IF(ITYPLU .NE. 1) CALL XABORT(NAMSBR//
+     >    ': Number of bundles expected')
+          NBUN=INTLIR
+          CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+          IF(ITYPLU .NE. 2) CALL XABORT(NAMSBR//
+     >    ': Bundles length (cm) expected')
+          IF(REALIR .GT. 0.0) BUNLEN=REALIR
+          GO TO 110
+        ELSE IF(CARLIR(1:4) .EQ. 'CHAN') THEN
+          CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+          IF(ITYPLU .NE. 1) CALL XABORT(NAMSBR//
+     >    ': Number of channels expected')
+          NCHA=INTLIR
+          GO TO 110
+        ELSE
+          GO TO 105
+        ENDIF
+      ENDIF
+ 105  CONTINUE
+      IF(NGLO .LT. 0) THEN
+        NGLO=0
+        WRITE(IOUT,8000) NAMSBR,'nglo'
+      ENDIF
+      IF(NLOC .LT. 0) THEN
+        NLOC=0
+        WRITE(IOUT,8000) NAMSBR,'nloc'
+      ENDIF
+      IF(NBUN .LT. 0) THEN
+        NBUN=0
+        WRITE(IOUT,8000) NAMSBR,'nbun'
+      ENDIF
+      IF(NCHA .LT. 0) THEN
+        NCHA=0
+        WRITE(IOUT,8000) NAMSBR,'ncha'
+      ENDIF
+      ITYRED=ITYPLU
+      CARRED=CARLIR
+*----
+*  Format
+*----
+ 8000 FORMAT(' ****** WARNING in ',A6,' ****** '/
+     >       ' Problem  : ',A4,1X,' < 0'/
+     >       ' Solution : assume this parameter is not read'/
+     >       ' ******************************')
+      RETURN
+      END 
diff --git a/Donjon/src/HSTGET.f b/Donjon/src/HSTGET.f
new file mode 100644
index 0000000..6a1238a
--- /dev/null
+++ b/Donjon/src/HSTGET.f
@@ -0,0 +1,398 @@
+*DECK HSTGET
+      SUBROUTINE HSTGET(IPHST,  IPRINT, MAXG,   MAXL,   NCHA,   NBUN,
+     >                  ITYPRO, ITYRED, CARRED, IUPDC,  IUPDB,
+     >                  NAMG,   PARAMG, NAML,   PARAML, IDCELL, IDFUEL)
+*
+*----------
+*
+*Purpose:
+* To read from the input file or send to CLE-2000 variables the 
+* local and burnup parameters associated with a fuel cell.
+*
+*Copyright:
+* Copyright (C) 2003 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* G. Marleau
+*
+*Parameters: input
+* IPHST   address of the \dds{history} data structure.
+* IPRINT  print level.
+* MAXG    maximum number of global parameters.                   
+* MAXL    maximum number of local parameters.                   
+* NCHA    number of fuel channels.                   
+* NBUN    number of bundles per channel.
+* ITYPRO  type of processing where:
+*         ITYPRO > 0 if history is in creation or update mode; 
+*         ITYPRO < 0 if history is in read-only mode. 
+* ITYRED  type of the last variable read.                
+* CARRED  last character string read.
+*
+*Parameters: input/output
+* NMAG    global parameter names.
+* PARAMG  values of the global parameters.
+* NMAL    local parameter names.
+* PARAML  values of the local parameters.
+* IDCELL  cell identifier for each fuel bundle in each channel.
+* IDFUEL  fuel type identifier for each fuel bundle in each channel.
+*
+*Parameters: output
+* IUPDC   number of the channel to analyze.                   
+* IUPDB   number of the bundle to analyze.
+*
+*----------
+*
+      USE GANLIB
+      IMPLICIT         NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR)      IPHST
+      INTEGER          IPRINT,MAXG,MAXL,NCHA,NBUN,ITYPRO
+      INTEGER          ITYRED,IUPDC,IUPDB
+      CHARACTER        CARRED*12
+      INTEGER          NAMG(3,0:MAXG),NAML(3,0:MAXL)
+      REAL             PARAMG(0:MAXG),PARAML(0:MAXL,2)
+      INTEGER          IDCELL(NBUN,NCHA),IDFUEL(NBUN,NCHA)
+*----
+*  LOCAL PARAMETERS
+*----
+      INTEGER          IOUT,NTC,ILCMUP,ILCMDN
+      CHARACTER        NAMSBR*6
+      PARAMETER       (IOUT=6,NTC=3,ILCMUP=1,ILCMDN=2,
+     >                 NAMSBR='HSTGET')
+*----
+*  INPUT/OUTPUT VARIABLES 
+*  Input data is of the form
+*  [ GET (hstpar) ] [ PUT (hstpar) ]
+*  [ CELLID icha ibun  [ idfuel ] 
+*      [ GET (hstpar) ] 
+*      [ PUT { BREFL  (hsrbrn) (hstpar) 
+*              AREFL   (hsrbrn) (hstpar)   |
+*            [ AREFL ] (hsrbrn) (hstpar)   } ] ]
+*
+*  HERE:
+*  (hstpar)           = NAMPAR valpar
+*                       where NAMPAR is the name of a local or global
+*                       parameter and valpar its value.
+*  (hstbrn)           = BURN period power
+*                       where period is the burnup time step 
+*                       and power the burnup power density in kW/kg.
+*  For global parameter:
+*  GET                = implies that (hstpar) is transfered to the 
+*                       HISTORY file, 
+*  PUT                = implies that (hstpar) is transfered to
+*                       CLE-2000 variables. 
+*  For local parameters:
+*  GET                = implies that (hstpar) is transfered to the 
+*                       HISTORY file for the case before and
+*                       after refueling.
+*  PUT                = implies that (hstbrn) and (hstpar)  
+*                       are transfered to CLE-2000 variables. 
+*  BREFL              = Indicates that the information before
+*                       refueling is considered.
+*  AREFL              = Indicates that the information after
+*                       refueling is considered.
+*                       This is the default option is neither
+*                       BREFL nor AREFL is defined.
+*----
+      INTEGER          ITYPLU,INTLIR
+      CHARACTER        CARLIR*12
+      REAL             REALIR
+      DOUBLE PRECISION DBLLIR
+      INTEGER          ITYPUT,INTPUT
+      CHARACTER        CARPUT*12
+      REAL             REAPUT
+      DOUBLE PRECISION DBLPUT
+*----
+*  LOCAL VARIABLES
+*----                  
+      INTEGER          ICONTR,IGP,IFTN,ISREF,IUPDL,IUPDG,IUPDF
+      INTEGER          ITC,INEXT,IB,IC,IPL,IP
+      INTEGER          ICT,IOK
+      CHARACTER        NAMP*12
+      REAL             TIMPOW(2,2)
+*----
+*  Initialize input vectors
+*----
+      PARAML(0:MAXL,:2)=0.0
+      TIMPOW(:2,:2)=0.0
+*----
+*  Initialize variables
+*  IUPDC  -> channel number to process or update.
+*  IUPDB  -> bundle number to process or update.
+*  ICONTR -> indicates processing of ITYRED and CARRED
+*            = 0 processing required.
+*            = 1 processing has been performed.
+*  IGP    -> indicate if a GET or PUT command is in effect.
+*            =-1 PUT command in effect
+*            = 0 no GET or PUT command in effect
+*            = 1 GET command in effect 
+*  IFTN      = new fuel type 
+*  ISREF  -> indicate the REFUEL state
+*            is to be processed
+*            = 0 no processing
+*            = 1 processing before refuel
+*            = 2 processing after refuel 
+*  IUPDL  -> indicates local parameters update 
+*            = 0 no update
+*            > 0 updated
+*  IUPDG  -> indicates global parameters update 
+*            = 0 no update
+*            > 0 updated 
+*  IUPDF  -> Fuel type update
+*            = 0 no update
+*            > 0 updated
+*----  
+      IUPDC=0
+      IUPDB=0
+      ICONTR=0
+      IGP   =0
+      IFTN  =0
+      ISREF =0
+      IUPDL =0 
+      IUPDG =0
+      IUPDF =0 
+ 100  CONTINUE
+      IF(ICONTR .EQ. 0) THEN
+        ITYPLU=ITYRED
+        CARLIR=CARRED
+        ICONTR=1
+      ELSE
+        CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+      ENDIF
+ 101  CONTINUE
+      IF(ITYPLU .EQ. 10) GO TO 105
+      IF(ITYPLU .NE. 3) CALL XABORT(NAMSBR//
+     >': Read error -- Character variable expected')
+      IF(CARLIR .EQ. ';') THEN
+        GO TO 105 
+      ELSE IF(CARLIR .EQ. 'CELLID') THEN
+        IGP=0
+*----
+*  Channel number
+*----
+        CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+        IF(ITYPLU .NE. 1) CALL XABORT(NAMSBR//
+     >  ': Read error -- integer value for channel number expected.')
+        IF(INTLIR .LT. 0 ) CALL XABORT(NAMSBR//
+     >  ': Read error -- value for channel number must be > 0.')
+        IF(IUPDC .NE. 0) CALL XABORT(NAMSBR//
+     >  ': Only one channel can be updated for each call to HST.')
+        IUPDC=INTLIR
+*----
+*  Bundle number
+*----
+        CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+        IF(ITYPLU .NE. 1) CALL XABORT(NAMSBR//
+     >  ': Read error -- integer value for bundle number expected.')
+        IF(INTLIR .LT. 0 ) CALL XABORT(NAMSBR//
+     >  ': Read error -- value for bundle number must be > 0')
+        IF(IUPDB .NE. 0) CALL XABORT(NAMSBR//
+     >  ': Only one bundle can be updated for each call to HST.')
+        IUPDB=INTLIR 
+*----
+*  Fuel type (optional)
+*----
+        CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR) 
+        IFTN=-1
+        IF(ITYPLU .EQ. 1) THEN
+          IFTN=INTLIR
+          CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+        ENDIF
+*----
+*  IF CELL IS NOT IDENTIFIED ASSOCIATE TO CELL NEXT 
+*  CELL NUMBER AVAILABLE AND TO FUEL TYPE
+*  VALUE PROVIDED IN IFTN
+*----   
+        IF(IDCELL(IUPDB,IUPDC) .LE. 0) THEN
+          DO 110 INEXT=1,NBUN*NCHA
+            DO 111 IB=1,NBUN
+              DO 112 IC=1,NCHA
+                IF(IDCELL(IB,IC) .EQ. INEXT) GO TO 115
+ 112          CONTINUE
+ 111        CONTINUE
+            IDCELL(IUPDB,IUPDC)=INEXT
+            GO TO 116
+ 115        CONTINUE
+ 110      CONTINUE
+          CALL XABORT(NAMSBR//': No cell id available')
+ 116      CONTINUE
+          IDFUEL(IUPDB,IUPDC)=ABS(IFTN) 
+        ELSE
+*----
+*  CELL EXIST, READ IF POSSIBLE EXISTING LOCAL 
+*  PARAMETERS VALUES
+*----     
+          ICT=IDCELL(IUPDB,IUPDC)
+          WRITE(NAMP,'(A4,I8.8)') 'CELL',ICT
+          CALL LCMSIX(IPHST,NAMP,ILCMUP)
+*----
+*  Get local parameters from cell before refueling
+*----
+          IOK=-1              
+          CALL HSTGSL(IPHST ,MAXL  ,IOK   ,
+     >                TIMPOW(1,1)  ,PARAML(0,1)) 
+          IF((IPRINT.GT.0).AND.(IOK.NE.0)) THEN
+            WRITE(IOUT,7000) NAMSBR
+            WRITE(IOUT,7010) IUPDC,IUPDB,'BEFORE'
+          ENDIF
+*----
+*  Get local parameters from cell after refueling
+*----
+          IOK=-2              
+          CALL HSTGSL(IPHST ,MAXL  ,IOK   ,
+     >                TIMPOW(1,2)  ,PARAML(0,2)) 
+          IF((IPRINT.GT.0).AND.(IOK.NE.0)) THEN
+            WRITE(IOUT,7000) NAMSBR
+            WRITE(IOUT,7010) IUPDC,IUPDB,'AFTER '
+          ENDIF
+          CALL LCMSIX(IPHST,NAMP,ILCMDN)
+        ENDIF
+        GO TO 101   
+      ELSE IF(CARLIR .EQ. 'GET') THEN
+        IF(ITYPRO .LT. 0) CALL XABORT(NAMSBR//
+     >': Option GET not permitted for history in read only mode')
+        IGP=1
+        ISREF=2
+      ELSE IF(CARLIR .EQ. 'PUT') THEN
+        IGP=-1
+        ISREF=2
+      ELSE IF(CARLIR .EQ. 'BREFL') THEN
+        IF(IGP .NE. -1) CALL XABORT(NAMSBR//
+     >': Option BREFL permitted for PUT only')
+        ISREF=1
+      ELSE IF(CARLIR .EQ. 'AREFL') THEN
+        IF(IGP .NE. -1) CALL XABORT(NAMSBR//
+     >': Option AREFL permitted for PUT only')
+        ISREF=2
+      ELSE
+        IF(IGP .EQ. 0) CALL XABORT(NAMSBR//
+     >  ': GET or PUT must be specified ')
+        IF(IUPDC*IUPDB .GT. 0) THEN
+*----
+*  CARLIR contains a local parameter
+*----
+          IF(CARLIR .EQ. 'BURN') THEN 
+            IF(IGP .EQ. 1) CALL XABORT(NAMSBR//
+     >': Option GET not permitted for BURN keyword')
+            IF(ITYPRO .GT. 0) CALL XABORT(NAMSBR//
+     >': Option BURN permitted only for history in read only mode')
+            REAPUT=TIMPOW(1,ISREF)
+            ITYPUT=2
+            CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+            IF(ITYPLU .NE. -ITYPUT) CALL XABORT(NAMSBR//
+     >': Real output variable for burnup period expected')
+            CALL REDPUT(ITYPUT,INTPUT,REAPUT,CARPUT,DBLPUT)
+*----
+*  The power density expected is in kW/kg.
+*----
+            REAPUT=TIMPOW(2,ISREF)
+            ITYPUT=2
+            CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+            IF(ITYPLU .NE. -ITYPUT) CALL XABORT(NAMSBR//
+     >': Real output variable for burnup power expected')
+            CALL REDPUT(ITYPUT,INTPUT,REAPUT,CARPUT,DBLPUT)
+          ELSE
+*----
+*  Scan local parameters to see is CARLIR is one of them
+*----       
+            IP=0
+            DO 120 IPL=1,MAXL
+              WRITE(NAMP,'(3A4)') (NAML(ITC,IPL),ITC=1,NTC)
+              IF(NAMP .EQ. CARLIR) THEN
+                IP=IPL
+                GO TO 125
+              ELSE IF(NAMP .EQ. '            ') THEN 
+                IP=IPL
+                READ(CARLIR,'(3A4)') (NAML(ITC,IP),ITC=1,NTC)
+                GO TO 125
+              ENDIF
+ 120        CONTINUE
+            CALL XABORT(NAMSBR//': Number of local parameters '//
+     >      'provided larger than number permitted.') 
+ 125        CONTINUE
+            IF(IGP .EQ. -1) THEN
+              REAPUT=PARAML(IP,ISREF)
+              ITYPUT=2
+              CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+              IF(ITYPLU .NE. -ITYPUT) CALL XABORT(NAMSBR//
+     >':  Real output variable for local parameter expected')
+              CALL REDPUT(ITYPUT,INTPUT,REAPUT,CARPUT,DBLPUT)
+            ELSE IF(IGP .EQ. 1) THEN
+              IUPDL=IUPDL+1
+              CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+              IF(ITYPLU .NE. 2) CALL XABORT(NAMSBR//
+     >        ': Real value for local parameter missing.')
+              PARAML(IP,ISREF)=REALIR 
+            ENDIF
+          ENDIF
+        ELSE
+*----
+*  CARLIR contains a global parameter
+*----
+          IF(CARLIR .EQ. 'POWER') THEN
+            CALL XABORT(NAMSBR//
+     >      ': POWER is a local not global parameter') 
+          ELSE 
+            IP=0
+            DO 130 IPL=1,MAXG
+              WRITE(NAMP,'(3A4)') (NAMG(ITC,IPL),ITC=1,NTC)
+              IF(NAMP .EQ. CARLIR) THEN
+                IP=IPL
+                GO TO 135
+              ELSE IF(NAMP .EQ. '            ') THEN 
+                IP=IPL
+                READ(CARLIR,'(3A4)') (NAMG(ITC,IP),ITC=1,NTC)
+                GO TO 135
+              ENDIF
+ 130        CONTINUE
+            CALL XABORT(NAMSBR//': Number of global parameters '//
+     >      'provided larger than number permitted.') 
+ 135        CONTINUE
+            IF(IGP .EQ. -1) THEN
+              REAPUT=PARAMG(IP)
+              ITYPUT=2
+              CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+              IF(ITYPLU .NE. -ITYPUT) CALL XABORT(NAMSBR//
+     >':  Real output variable for global parameter expected')
+              CALL REDPUT(ITYPUT,INTPUT,REAPUT,CARPUT,DBLPUT)
+            ELSE IF(IGP .EQ. 1) THEN
+              IUPDG=IUPDG+1
+              CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
+              IF(ITYPLU .NE. 2) CALL XABORT(NAMSBR//
+     >        ': Real value for global parameter missing.')
+              PARAMG(IP)=REALIR 
+            ENDIF
+          ENDIF
+        ENDIF
+      ENDIF
+      GO TO 100
+ 105  CONTINUE
+*----
+*  Save global parameters if some are updated
+*----
+      IF(IUPDG .GT. 0) THEN 
+        CALL LCMPUT(IPHST,'NAMEGLOBAL  ',3*MAXG,3,NAMG(1,1))
+        CALL LCMPUT(IPHST,'PARAMGLOBAL ',MAXG,2,PARAMG(1))
+      ENDIF       
+      IF(IUPDL .GT. 0) THEN 
+        CALL LCMPUT(IPHST,'NAMELOCAL   ',3*MAXL,3,NAML(1,1))
+        ICT=IDCELL(IUPDB,IUPDC)
+        WRITE(NAMP,'(A4,I8.8)') 'CELL',ICT
+        CALL LCMSIX(IPHST,NAMP,ILCMUP)
+        IOK=2              
+        CALL HSTGSL(IPHST ,MAXL  ,IOK   ,
+     >              TIMPOW(1,2)  ,PARAML(0,2)) 
+        CALL LCMSIX(IPHST,NAMP,ILCMDN)
+      ENDIF       
+      RETURN 
+*----
+*  Formats
+*  WARNING
+*----
+ 7000 FORMAT(' ***** WARNING IN ',A6,' *****')
+ 7010 FORMAT(' Local parameters for channel ',I5,' bundle ',I5,
+     >       ' not available for ',A6,' state'/
+     >       ' Initialize to 0.0')
+      END 
diff --git a/Donjon/src/HSTGMA.f b/Donjon/src/HSTGMA.f
new file mode 100644
index 0000000..c0c8488
--- /dev/null
+++ b/Donjon/src/HSTGMA.f
@@ -0,0 +1,126 @@
+*DECK HSTGMA
+      SUBROUTINE HSTGMA(IPMAP,  NCHA,   NBUN,  DELTAT,   POWER,
+     >                  BURNP,  IREFUS, REFUT, NBFUEL)
+*
+*----------
+*
+*Purpose:
+* To read from the MAP data structure the power and 
+* burnup distribution for each cell as well as the refueling 
+* option for each channel.
+*
+*Copyright:
+* Copyright (C) 2003 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* G. Marleau, E. Varin
+*
+*Parameters: input
+* IPMAP   address of the \dds{map} data structure.
+* NCHA    number of fuel channels.                   
+* NBUN    number of bundles per channel.            
+* IPMAP   pointer to the MAP data structure
+* NCHA    number of fuel channels.
+* NBUN    number of bundles per channels.
+*
+*Parameters: input/output
+* DELTAT  last character string read.
+* POWER   power for each fuel bundle in each channel.
+* BURNP   burnup for each fuel bundle in each channel.
+* IREFUS  refueling strategy for each channel.
+* REFUT   refueling time for each channel.
+* NBFUEL  number of fueled channels.            
+* DELTAT  next time steps for burnup.
+* POWER   values of local powers.
+* IREFUS  fuels shift for each channel. 
+*         A channel is refueled using a NBS bundle 
+*         shift procedure if IREFUS(I)=NBS. 
+*         In the case where NBS $>$ 0,
+*         bundles 1 to NBUN-NBS are displaced to position NBS+1 to
+*         NBUN while locations 1 to NBS are filled with new fuel. 
+*         In the case where NBS $<$ 0,
+*         bundles -NBS+1 to NBUN are displaced to position 1 to
+*         NBUN+NBS while locations NBUN+NBS+1 to NBUN are filled 
+*         with new fuel.
+* REFUT   channel refueling time.
+* NBFUEL  number of fueled channels 
+*
+*----------
+*
+      USE GANLIB
+      IMPLICIT         NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR)      IPMAP
+      INTEGER          NCHA,NBUN
+      REAL             DELTAT
+      REAL             POWER(NCHA,NBUN),BURNP(NCHA,NBUN)
+      INTEGER          IREFUS(NCHA)
+      REAL             REFUT(NCHA)
+      INTEGER          NBFUEL
+*----
+*  LOCAL PARAMETERS
+*----
+      INTEGER          IOUT,NTC,ILCMUP,ILCMDN
+      CHARACTER        NAMSBR*6
+      PARAMETER       (IOUT=6,NTC=3,ILCMUP=1,ILCMDN=2,
+     >                 NAMSBR='HSTGMA')
+*----
+*  LOCAL VARIABLES
+*----                  
+      INTEGER          ILCMLN,ILCMTY
+      INTEGER          IC 
+*----
+*  Read DEPL-TIME
+*----
+      CALL LCMLEN(IPMAP,'DEPL-TIME   ',ILCMLN,ILCMTY)
+      IF(ILCMLN .GT. 0) THEN 
+        IF(ILCMLN .GT. 1) CALL XABORT(NAMSBR//
+     >  ': Space to store next time step is too small')
+        CALL LCMGET(IPMAP,'DEPL-TIME   ',DELTAT)
+      ENDIF
+*----
+*  Read bundle powers
+*----
+      CALL LCMLEN(IPMAP,'BUND-PW',ILCMLN,ILCMTY)
+      IF(ILCMLN .GT. 0) THEN 
+        IF(ILCMLN .GT. NCHA*NBUN) CALL XABORT(NAMSBR//
+     >  ': Space to store power is too small')
+        CALL LCMGET(IPMAP,'BUND-PW',POWER)
+      ENDIF
+*----
+*  Read BURNUP IF DELTAT=0.0
+*----
+      BURNP(:NCHA,:NBUN)=0.0
+      IF(DELTAT.EQ.0.0) THEN
+        CALL LCMLEN(IPMAP,'BURN-INST',ILCMLN,ILCMTY)
+        IF(ILCMLN .GT. 0) THEN 
+          IF(ILCMLN .GT. NCHA*NBUN) CALL XABORT(NAMSBR//
+     >    ': Space to store burnup is too small')
+          CALL LCMGET(IPMAP,'BURN-INST',BURNP)
+        ENDIF
+      ENDIF
+*----
+*  Read refueling scheme
+*----
+      CALL LCMLEN(IPMAP,'REF-SCHEME',ILCMLN,ILCMTY)
+      IF(ILCMLN .GT. 0) THEN 
+        IF(ILCMLN .GT. NCHA) CALL XABORT(NAMSBR//
+     >  ': Space to store REF-SCHEME is too small')
+        CALL LCMGET(IPMAP,'REF-SCHEME',IREFUS)
+      ENDIF
+      CALL LCMLEN(IPMAP,'REF-CHAN',ILCMLN,ILCMTY)
+      IF(ILCMLN .GT. 0) THEN 
+        IF(ILCMLN .GT. NCHA) CALL XABORT(NAMSBR//
+     >  ': Space to store REF-CHAN is too small')
+        CALL LCMGET(IPMAP,'REF-CHAN',REFUT)
+      ENDIF
+*----
+*  Compute number of channels refueled
+*----
+      DO 100 IC=1,NCHA
+        IF(REFUT(IC) .GT. 0.0) NBFUEL=NBFUEL+1
+ 100  CONTINUE        
+      RETURN
+      END 
diff --git a/Donjon/src/HSTGSD.f b/Donjon/src/HSTGSD.f
new file mode 100644
index 0000000..1008d58
--- /dev/null
+++ b/Donjon/src/HSTGSD.f
@@ -0,0 +1,100 @@
+*DECK HSTGSD
+      SUBROUTINE HSTGSD(IPHST,  MAXI,   IOK,    DENI,   FDEN  )
+*
+*----------
+*
+*Purpose:
+* To read from or write to to history file
+* isotopic and fuel densities. 
+*Copyright:
+* Copyright (C) 2003 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* G. Marleau
+*
+*Parameters: input
+* IPHST   address of the \dds{history} data structure.
+* MAXI    maximum number of isotopes.            
+*
+*Parameters: input/output
+* IOK     processing option where:
+*         --> on input, a negative value indicates 
+*         that the information is to be extracted 
+*         from the \dds{history} data structure and a 
+*         positive value indicates that the information is to be
+*         stored on the \dds{history} data structure;              
+*         --> on output, a value of 0 indicates that 
+*         the required processing took place
+*         successfully while a negative value indicates 
+*         a failure of the processing.
+* DENI    isotopic concentration.
+* FDEN    average fuel density and weight.
+* IOK     status of read. 
+*         On input ->  IOK< 0 means get densities
+*                             densities
+*         On input ->  IOK> 0 means save densities
+*         On output -> IOK= 0 success
+*                      IOK=-1 error: density missing 
+*                      IOK=-2 error: involid processing option
+* DENI    initial and final isotopic concentration.
+* FDEN    initial fuel density and heavy element mass.
+*
+*----------
+*
+      USE GANLIB
+      IMPLICIT         NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR)      IPHST
+      INTEGER          MAXI,IOK
+      REAL             DENI(0:MAXI)
+      REAL             FDEN(2)
+*----
+*  LOCAL PARAMETERS
+*----
+      INTEGER          IOUT
+      CHARACTER        NAMSBR*6
+      PARAMETER       (IOUT=6,NAMSBR='HSTGSD')
+*----
+*  LOCAL VARIABLES
+*----                  
+      INTEGER          ILCMLN,ILCMTY 
+*----
+*  Local parameters after refuel
+*---- 
+      IF(IOK .LT. 0) THEN
+        IOK=0
+*----
+*  Get isotopes concentration
+*----
+        CALL LCMLEN(IPHST,'ISOTOPESDENS',ILCMLN,ILCMTY)
+        IF(ILCMLN .LE. 0 .OR. ILCMLN .GT. MAXI) THEN
+          IOK=-1
+        ELSE
+          CALL LCMGET(IPHST,'ISOTOPESDENS',DENI(1))
+        ENDIF
+*----
+*  Get fuel density
+*----
+        CALL LCMLEN(IPHST,'FUELDEN-INIT',ILCMLN,ILCMTY)
+        IF(ILCMLN .LE. 0 .OR. ILCMLN .GT. 2) THEN
+          IOK=-1
+        ELSE
+          CALL LCMGET(IPHST,'FUELDEN-INIT',FDEN)
+        ENDIF
+      ELSE IF(IOK .GT. 0) THEN
+        IOK=0
+*----
+*  Put isotopes concentration
+*----
+        CALL LCMPUT(IPHST,'ISOTOPESDENS',MAXI,2,DENI(1))
+*----
+*  Put fuel density
+*----
+        CALL LCMPUT(IPHST,'FUELDEN-INIT',2,2,FDEN)
+      ELSE
+        IOK=-2
+      ENDIF
+      RETURN
+      END 
diff --git a/Donjon/src/HSTGSL.f b/Donjon/src/HSTGSL.f
new file mode 100644
index 0000000..be685b8
--- /dev/null
+++ b/Donjon/src/HSTGSL.f
@@ -0,0 +1,111 @@
+*DECK HSTGSL
+      SUBROUTINE HSTGSL(IPHST, MAXL,   IOK,    TIMPOW, PARAML)
+*
+*----------
+*
+*Purpose:
+* To read from or save to history file the local parameters 
+*
+*Copyright:
+* Copyright (C) 2003 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* G. Marleau
+*
+*Parameters: input
+* IPHST   address of the \dds{history} data structure.
+* MAXL    maximum number of local parameters.                   
+*
+*Parameters: input/output
+* IOK     processing option where:
+*         --> on input, a negative value indicates that the 
+*         information is to be extracted from the \dds{history} data
+*         structure and a positive value indicates that the information
+*         is to be stored on the \dds{history} data structure 
+*         (-1 and 1 for before refueling and -2, 2 for after refueling);             
+*         --> on output, a value of 0 indicates that the required
+*         processing took place successfully while a negative 
+*         value indicates a failure of the processing. 
+* TIMPOW  burnup time and power density.
+* PARAML  local parameters.
+*
+*----------
+*
+      USE GANLIB
+      IMPLICIT         NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR)      IPHST
+      INTEGER          MAXL,IOK
+      REAL             PARAML(0:MAXL)
+      REAL             TIMPOW(2)
+*----
+*  LOCAL PARAMETERS
+*----
+      INTEGER          IOUT
+      CHARACTER        NAMSBR*6
+      PARAMETER       (IOUT=6,NAMSBR='HSTGSL')
+*----
+*  LOCAL VARIABLES
+*----                  
+      INTEGER          ILCMLN,ILCMTY 
+*----
+*  Local parameters after refuel
+*---- 
+      IF(IOK .EQ. -2) THEN
+*----
+*  Get local parameters after refuel
+*---- 
+        CALL LCMLEN(IPHST,'PARAMLOCALAR',ILCMLN,ILCMTY)
+        IF(ILCMLN .LE. 0 .OR. ILCMLN .GT. MAXL) THEN
+          IOK=-1
+        ELSE 
+          CALL LCMGET(IPHST,'PARAMLOCALAR',PARAML(1))
+          IOK=0
+        ENDIF
+        CALL LCMLEN(IPHST,'PARAMBURNTAR',ILCMLN,ILCMTY)
+        IF(ILCMLN .LE. 0 .OR. ILCMLN .GT. 2) THEN
+          IOK=-1
+        ELSE 
+          CALL LCMGET(IPHST,'PARAMBURNTAR',TIMPOW)
+          IOK=0
+        ENDIF
+      ELSE IF(IOK .EQ. -1) THEN
+*----
+*  Get local parameters before refuel
+*---- 
+        PARAML(0)=0
+        CALL LCMLEN(IPHST,'PARAMLOCALBR',ILCMLN,ILCMTY)
+        IF(ILCMLN .LE. 0 .OR. ILCMLN .GT. MAXL) THEN
+          IOK=-1
+        ELSE 
+          CALL LCMGET(IPHST,'PARAMLOCALBR',PARAML(1))
+          IOK=0
+        ENDIF
+        CALL LCMLEN(IPHST,'PARAMBURNTBR',ILCMLN,ILCMTY)
+        IF(ILCMLN .LE. 0 .OR. ILCMLN .GT. 2) THEN
+          IOK=-1
+        ELSE 
+          CALL LCMGET(IPHST,'PARAMBURNTBR',TIMPOW)
+          IOK=0
+        ENDIF
+      ELSE IF(IOK .EQ. 1) THEN
+*----
+*  Save local parameters before refuel
+*---- 
+        CALL LCMPUT(IPHST,'PARAMLOCALBR',MAXL,2,PARAML(1))
+        CALL LCMPUT(IPHST,'PARAMBURNTBR',2,2,TIMPOW)
+        IOK=0
+      ELSE IF(IOK .EQ. 2) THEN
+*----
+*  Save local parameters after refuel
+*---- 
+        CALL LCMPUT(IPHST,'PARAMLOCALAR',MAXL,2,PARAML(1))
+        CALL LCMPUT(IPHST,'PARAMBURNTAR',2,2,TIMPOW)
+        IOK=0 
+      ELSE
+        IOK=-2
+      ENDIF
+      RETURN
+      END 
diff --git a/Donjon/src/HSTREF.f b/Donjon/src/HSTREF.f
new file mode 100644
index 0000000..50c9b4f
--- /dev/null
+++ b/Donjon/src/HSTREF.f
@@ -0,0 +1,283 @@
+*DECK HSTREF
+      SUBROUTINE HSTREF(IPHST,  IPRINT, MAXL,   NCHA,   NBUN,   MAXI,
+     >                  DELTAT, POWER,  IREFUS, REFUT,  IDCELL, IDFUEL,
+     >                  PARAML, DENI,   ISHUFF)
+*
+*----------
+*
+*Purpose:
+* Refuel channel by performing fuel shuffling. 
+*
+*Copyright:
+* Copyright (C) 2003 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* G. Marleau, E. Varin
+*
+*Parameters: input
+* IPHST   address of the \dds{history} data structure.
+* IPRINT  print level.
+* MAXL    maximum number of local parameters.                   
+* NCHA    number of fuel channels.                   
+* NBUN    number of bundles per channel.            
+* MAXI    maximum number of isotopes.            
+* DELTAT  last character string read.
+* POWER   burnup power for each fuel bundle in each channel.
+* IREFUS  refueling strategy for each channel.
+*         refueling strategy for each channel.
+*         A channel is refueled using a NBS bundle 
+*         shift procedure if IREFUS(I)=NBS. 
+*         In the case where NBS $>$ 0,
+*         bundles 1 to NBUN-NBS are displaced to position NBS+1 to
+*         NBUN while locations 1 to NBS are filled with new fuel. 
+*         In the case where NBS $<$ 0,
+*         bundles -NBS+1 to NBUN are displaced to position 1 to
+*         NBUN+NBS while locations NBUN+NBS+1 to NBUN are filled 
+*         with new fuel.
+* REFUT   refueling time for each channel.
+*
+*Parameters: input/output
+* IDCELL  cell identifier for each fuel bundle in each channel.
+* IDFUEL  fuel type identifier for each fuel bundle in each channel.
+*
+*Parameters: work
+* PARAML  local parameters.
+* DENI    isotopic concentrations.
+* ISHUFF  fuel shuffling index for a channel.
+*
+*----------
+*
+      USE GANLIB
+      IMPLICIT         NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR)      IPHST
+      INTEGER          IPRINT,MAXL,NCHA,NBUN,MAXI
+      REAL             DELTAT
+      REAL             POWER(NCHA,NBUN)
+      INTEGER          IREFUS(NCHA)
+      REAL             REFUT(NCHA)
+      INTEGER          IDCELL(NBUN,NCHA),IDFUEL(NBUN,NCHA)
+      REAL             PARAML(0:MAXL,2)
+      REAL             DENI(0:MAXI)
+      INTEGER          ISHUFF(NBUN)
+*----
+*  LOCAL PARAMETERS
+*----
+      INTEGER          IOUT,NTC,ILCMUP,ILCMDN
+      CHARACTER        NAMSBR*6
+      PARAMETER       (IOUT=6,NTC=3,ILCMUP=1,ILCMDN=2,
+     >                 NAMSBR='HSTREF')
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER          IC,IB,IBS,IBO,ICT,IFT,IOK
+      REAL             FDEN(2)
+      REAL             TIMREF,TIMPOW(2)
+      CHARACTER        NAMP*12 
+*----
+*  Take local paremeters after fueling
+*  and store in local parameters before fueling
+*  for all fuel cells
+*----
+      IF(IPRINT .GE. 10) THEN
+        WRITE(IOUT,7000) NAMSBR
+      ENDIF
+      DO 100 IC=1,NCHA
+        TIMREF=REFUT(IC)
+        IBS=IREFUS(IC) 
+        DO 110 IB=1,NBUN
+          ICT=IDCELL(IB,IC)
+          WRITE(NAMP,'(A4,I8.8)') 'CELL',ICT
+          CALL LCMSIX(IPHST,NAMP,ILCMUP)
+*----
+*  Get local parameters from cell IB after refueling
+*----
+          IOK=-2              
+          CALL HSTGSL(IPHST ,MAXL  ,IOK   ,TIMPOW,PARAML) 
+          IF(IOK .NE. 0) PARAML(0:MAXL,1)=0.0
+*----
+*  Save local parameters from cell IB before refueling
+*----         
+          IOK=1
+          TIMPOW(1)=TIMREF
+          TIMPOW(2)=POWER(IC,IB)
+          CALL HSTGSL(IPHST ,MAXL  ,IOK   ,TIMPOW,PARAML)
+          IOK=2
+          TIMPOW(1)=DELTAT-TIMREF
+          TIMPOW(2)=POWER(IC,IB)
+          CALL HSTGSL(IPHST ,MAXL  ,IOK   ,TIMPOW,PARAML)
+          CALL LCMSIX(IPHST,NAMP,ILCMDN)
+ 110    CONTINUE
+*----
+*  Look for channel to refuel  
+*  -> REFUT(IC) > 0.0
+*  Refuel channel according to IREFUS(IC) bundle shift
+*  IREFUS(IC) < 0  -> push bundles starting at I=NBUN side
+*  IREFUS(IC) > 0  -> push bundles starting at I=1    side
+*  For displaced fuel channels:
+*     Change IDCELL to new cell identifier after displacement
+*  For refuel channels 
+*     Use IDCELL for channels removed from core and allocate
+*     then to new fuel. 
+*----
+        IF(TIMREF .GT. 0.0) THEN
+          IF(IPRINT .GE. 10) THEN
+            WRITE(IOUT,7001) IC,IBS
+          ENDIF
+*----
+*  Find ISHUFF(IB)=IBO
+*  IBO > 0 is the position of the bundle IB before refueling
+*  IBO < 0 is the free position availables for refueling
+*----
+          ISHUFF(:NBUN)=0
+          IF(IBS .GT. 0) THEN 
+*----
+*  push bundles starting at I=1 side
+*  with +IBS > 0 bundle shifts
+*  1) Displaced bundles :  position  1     -- NBUN-IBS 
+*                       :  position  IBS+1 -- NBUN
+*----
+            IBO=0
+            DO 120 IB=IBS+1,NBUN
+              IBO=IBO+1
+              ISHUFF(IB)=IBO
+ 120        CONTINUE 
+*----
+*  2) Inserted bundles  :  positions 1     -- IBS
+*----
+            IBO=NBUN-IBS
+            DO 121 IB=1,IBS
+              IBO=IBO+1
+              ISHUFF(IB)=-IBO
+ 121        CONTINUE
+          ELSE IF(IBS .LT. 0) THEN 
+*----
+*  push bundles starting at I=NBUN  side
+*  with -IBS > 0 bundle shifts
+*  1) Displaced bundles :  position  -IBS +1     -- NBUN
+*                       :  position  1          -- NBUN+IBS
+*----
+            IBO=-IBS
+            DO 130 IB=1,NBUN+IBS
+              IBO=IBO+1
+              ISHUFF(IB)=IBO
+ 130        CONTINUE
+*----
+*  2) Inserted bundles  :  positions NBUN+IBS+1 -- NBUN 
+*----
+            IBO=0
+            DO 131 IB=NBUN+IBS+1,NBUN
+              IBO=IBO+1
+              ISHUFF(IB)=-IBO
+ 131        CONTINUE
+          ENDIF
+*----
+*  treat refueling
+*----
+          DO 140 IB=1,NBUN
+*----
+*  Get local parameters from cell IB before refueling
+*----
+            ICT=IDCELL(IB,IC)
+            WRITE(NAMP,'(A4,I8.8)') 'CELL',ICT
+            CALL LCMSIX(IPHST,NAMP,ILCMUP)
+            IOK=-1              
+            CALL HSTGSL(IPHST ,MAXL  ,IOK   ,TIMPOW,PARAML) 
+            CALL LCMSIX(IPHST,NAMP,ILCMDN)
+*
+            IBO=ISHUFF(IB)
+            IF(IBO .GT. 0) THEN 
+*----
+*  Scan Displaced bundles
+*  and save properties at old cell location
+*----
+              IF(IPRINT .GE. 10) THEN
+                WRITE(IOUT,7010) IBO,IB
+              ENDIF
+*----
+*  Save local parameters to cell IBO after refueling
+*----         
+              ICT=IDCELL(IBO,IC)
+              WRITE(NAMP,'(A4,I8.8)') 'CELL',ICT
+              CALL LCMSIX(IPHST,NAMP,ILCMUP)
+              IOK=2
+              TIMPOW(1)=DELTAT-TIMREF
+              TIMPOW(2)=POWER(IC,IB)
+              CALL HSTGSL(IPHST ,MAXL  ,IOK   ,TIMPOW,PARAML) 
+              CALL LCMSIX(IPHST,NAMP,ILCMDN)
+*----
+*  Save in ISHUFF IDCELL for IBO
+*----         
+           ELSEIF(IBO .LT. 0) THEN
+*----
+*  Scan inserted fuel
+*  and save properties at reused cell location
+*----
+              IF(IPRINT .GE. 10) THEN
+                WRITE(IOUT,7011) IB
+              ENDIF
+              IBO=-IBO
+*----
+*  Get initial density for fuel type
+*----         
+              IFT=IDFUEL(IB,IC)
+              WRITE(NAMP,'(A4,I8.8)') 'FUEL',IFT
+              CALL LCMSIX(IPHST,NAMP,ILCMUP)
+              IOK=-1              
+              CALL HSTGSD(IPHST ,MAXI  ,IOK   ,DENI  ,FDEN   )
+              CALL LCMSIX(IPHST,NAMP,ILCMDN)
+*----
+*  Save local parameters before and after refueling
+*  from cell IBO before refueling
+*  Save fuel density for fuel type
+*----         
+              ICT=IDCELL(IBO,IC)
+              WRITE(NAMP,'(A4,I8.8)') 'CELL',ICT
+              CALL LCMSIX(IPHST,NAMP,ILCMUP)
+              IOK=1
+              TIMPOW(1)=0.0
+              TIMPOW(2)=POWER(IC,IB)
+              CALL HSTGSL(IPHST ,MAXL  ,IOK   ,TIMPOW,PARAML) 
+              IOK=2
+              TIMPOW(1)=DELTAT-TIMREF
+              TIMPOW(2)=POWER(IC,IB)
+              CALL HSTGSL(IPHST ,MAXL  ,IOK   ,TIMPOW,PARAML) 
+              IOK=2
+              CALL HSTGSD(IPHST ,MAXI  ,IOK   ,DENI  ,FDEN  )
+              CALL LCMSIX(IPHST,NAMP,ILCMDN)
+*----
+*  Save in ISHUFF IDCELL for IBO
+*----         
+            ENDIF
+              ISHUFF(IB)=ICT
+ 140      CONTINUE
+*----
+*  Redefine IDCELL for new spatial location
+*  of cells after refueling
+*  Here assume that bundles are replaced
+*  with fuels of the same type
+*----
+          DO 160 IB=1,NBUN
+            IDCELL(IB,IC)=ISHUFF(IB)
+ 160      CONTINUE
+        ENDIF
+ 100  CONTINUE 
+*----
+*  Save IDCELL and IDFUEL since they were updated
+*----
+      CALL LCMPUT(IPHST,'CELLID      ',NBUN*NCHA,1,IDCELL)
+      CALL LCMPUT(IPHST,'FUELID      ',NBUN*NCHA,1,IDFUEL)
+*----
+*  Return
+*----
+      RETURN
+*----
+* Format
+*----
+ 7000 FORMAT(' ***** OUTPUT FROM ',A6,' *****')
+ 7001 FORMAT(' Refueling channel ',I8, ' with ',I8,' bundle shifts')
+ 7010 FORMAT(10X,' Fuel bundle ',I8,' displaced to position ',I8)
+ 7011 FORMAT(10X,' Fresh fuel inserted at position ',I8)
+      END 
diff --git a/Donjon/src/HSTUBH.f b/Donjon/src/HSTUBH.f
new file mode 100644
index 0000000..a7b7bad
--- /dev/null
+++ b/Donjon/src/HSTUBH.f
@@ -0,0 +1,178 @@
+*DECK HSTUBH                                 
+      SUBROUTINE HSTUBH(IPEVO,  IPHST,  IPRINT, MAXI,   NBBTS,   NCHA,
+     >                  NBUN,   IUPDC,  IUPDB,  IDCELL, IDFUEL,  DENI)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* To update the BURNUP data structure using the information
+* provided on the HISTORY data structure.
+*
+*Copyright:
+* Copyright (C) 2003 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* G. Marleau
+*
+*Parameters: input
+* IPEVO   address of the \dds{burnup} data structure.
+* IPHST   address of the \dds{history} data structure.
+* IPRINT  print level.
+* MAXI    maximum number of isotopes.            
+* NBBTS   number of depletion steps.
+* NCHA    number of fuel channels.                   
+* NBUN    number of bundles per channel.
+* IUPDC   number of the channel to analyze.                   
+* IUPDB   number of the bundle to analyze.
+* IDCELL  cell identifier for each fuel bundle in each channel.
+* IDFUEL  fuel type identifier for each fuel bundle in each channel.
+*
+*Parameters: output
+* NAMIH   name of isotopes on the \dds{history} 
+*         or \dds{burnup} structure.
+* MIXIH   mixture number associated with the isotopes 
+*         on the \dds{history} or \dds{burnup} structure.
+* DENI    isotopic concentrations of the isotopes 
+*         on the \dds{history} or \dds{burnup} structure.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT         NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR)      IPHST,IPEVO
+      INTEGER          IPRINT,MAXI,NBBTS
+      INTEGER          NCHA,NBUN,IUPDC,IUPDB
+      INTEGER          IDCELL(NBUN,NCHA),IDFUEL(NBUN,NCHA)
+      REAL             DENI(0:MAXI) 
+*----
+*  LOCAL PARAMETERS
+*  CDAY = conversion of days in 10^{8} seconds
+*----
+      INTEGER          IOUT
+      INTEGER          ILCMUP,ILCMDN
+      CHARACTER        NAMSBR*6
+      PARAMETER       (IOUT=6,ILCMUP=1,ILCMDN=2,NAMSBR='HSTUBH')
+      REAL             CDAY
+      PARAMETER       (CDAY=8.64E-4)
+*----
+*  LOCAL VARIABLES
+*---- 
+      INTEGER          ILCMLN,ILCMTY 
+      CHARACTER        NAMTIM*12,NAMP*12 
+      INTEGER          IFT,ICT
+      INTEGER          ITS,ISO,IOK
+      REAL             BITH(3)
+      REAL             FDENC(2)
+      REAL             FLXNOR,DELTA(2)
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: MIXIH
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NAMIH
+      REAL, ALLOCATABLE, DIMENSION(:) :: DEPLT
+*----
+*  SCRATCH STORAGE ALLOCATION
+*   NAMIH   name of isotopes on the \dds{history} structure.
+*   MIXIH   mixture number associated with the isotopes 
+*           on the \dds{history} structure.
+*   DEPLT   time associated with each depletion step 
+*           on the \dds{burnup} structure.
+*----
+      ALLOCATE(NAMIH(3,0:MAXI),MIXIH(0:MAXI),DEPLT(0:NBBTS))
+*----
+*  Read HISTORY information for cell specified
+*  1) Read fuel type information
+*----
+      IF(IPRINT .GE. 100) THEN
+        WRITE(IOUT,6000) NAMSBR
+      ENDIF
+      IFT=IDFUEL(IUPDB,IUPDC)
+      WRITE(NAMP,'(A4,I8.8)') 'FUEL',IFT 
+      CALL LCMLEN(IPHST,NAMP,ILCMLN,ILCMTY)
+      IF(ILCMLN .EQ. 0) CALL XABORT(NAMSBR//
+     >':/ Fuel type absent -- BURNUP creation impossible')
+      CALL LCMSIX(IPHST,NAMP,ILCMUP)
+      CALL LCMLEN(IPHST,'ISOTOPESUSED',ILCMLN,ILCMTY)
+      IF(ILCMLN .GT. 0 .AND. ILCMLN .LT. 3*MAXI*4) THEN
+        CALL LCMGET(IPHST,'ISOTOPESUSED',NAMIH(1,1)) 
+        CALL LCMGET(IPHST,'ISOTOPESMIX',MIXIH(1))
+      ELSE
+        CALL XABORT(NAMSBR//
+     >  ':/ Isotopes are absent -- BURNUP creation impossible')
+      ENDIF
+      CALL LCMSIX(IPHST,NAMP,ILCMDN)
+      IF(IPRINT .GE. 100) THEN
+        WRITE(IOUT,6001) 'FUEL TYPE',IFT
+        IF(IPRINT .GE. 100) THEN
+          WRITE(IOUT,6010) 
+          WRITE(IOUT,6011) 
+     >    (NAMIH(1,ISO),NAMIH(2,ISO),NAMIH(3,ISO),ISO=1,MAXI)
+          WRITE(IOUT,6020) 
+          WRITE(IOUT,6021) 
+     >    (MIXIH(ISO),ISO=1,MAXI)
+        ENDIF
+      ENDIF 
+*----
+*  2) Real cell type information
+*----
+      ICT=IDCELL(IUPDB,IUPDC)
+      WRITE(NAMP,'(A4,I8.8)') 'CELL',ICT
+      CALL LCMLEN(IPHST,NAMP,ILCMLN,ILCMTY)
+      IF(ILCMLN .EQ. 0) CALL XABORT(NAMSBR//
+     >':/ Cell type absent -- BURNUP creation impossible')
+      CALL LCMSIX(IPHST,NAMP,ILCMUP)
+      IOK=-1
+      CALL HSTGSD(IPHST ,MAXI  ,IOK   ,DENI  ,FDENC )
+      IF(IOK .NE. 0) CALL XABORT(NAMSBR//
+     >':/ Densities are absent -- BURNUP creation impossible')
+      CALL LCMGET(IPHST,'DEPL-PARAM  ',BITH)
+      CALL LCMSIX(IPHST,NAMP,ILCMDN)
+      IF(IPRINT .GE. 100) THEN
+        WRITE(IOUT,6001) 'CELL TYPE',ICT
+        IF(IPRINT .GE. 100) THEN
+          WRITE(IOUT,6100)  
+          WRITE(IOUT,6110) (DENI(ISO),ISO=1,MAXI)
+        ENDIF
+      ENDIF
+*----
+*  Save isotopes names and mixtures on BURNUP
+*----
+      CALL LCMPUT(IPEVO,'ISOTOPESUSED',3*MAXI,3,NAMIH(1,1))
+      CALL LCMPUT(IPEVO,'ISOTOPESMIX ',MAXI  ,1,MIXIH(1))
+      CALL LCMPUT(IPEVO,'FUELDEN-INIT',2     ,2,FDENC)
+*----
+*  Save current burnup information as initial time step
+*----
+      FLXNOR=0.0
+      DELTA(1)=0.0
+      DELTA(2)=0.0
+      ITS=0 
+      DEPLT(ITS)=BITH(1)*CDAY
+      CALL LCMPUT(IPEVO,'DEPL-TIMES  ',1     ,2,DEPLT(ITS))
+      WRITE(NAMTIM,'(A8,I4.4)') 'DEPL-DAT',ITS+1
+      CALL LCMSIX(IPEVO,NAMTIM,ILCMUP)
+      CALL LCMPUT(IPEVO,'ISOTOPESDENS',MAXI,2,DENI(1))
+      CALL LCMPUT(IPEVO,'FLUX-NORM   ',   1,2,FLXNOR)
+      CALL LCMPUT(IPEVO,'DELTA       ',   2,2,DELTA)
+      CALL LCMPUT(IPEVO,'BURNUP-IRRAD',   2,2,BITH(2))
+      CALL LCMSIX(IPEVO,NAMTIM,ILCMDN)
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(DEPLT,MIXIH,NAMIH)
+*----
+*  Return
+*----
+      RETURN
+*----
+*  FORMAT
+*----
+ 6000 FORMAT(' ****** OUTPUT FROM ',A6)
+ 6001 FORMAT(' Contents of ',A9,1X,I8) 
+ 6010 FORMAT(' NAME OF ISOTOPES ')
+ 6011 FORMAT(10(3A4,2X))
+ 6020 FORMAT(' MIXTURE OF ISOTOPES ')
+ 6021 FORMAT(10(I12,2X))
+ 6100 FORMAT(' INITIAL DENSITIES')
+ 6110 FORMAT(1P,10E14.7)
+      END 
diff --git a/Donjon/src/HSTUHB.f b/Donjon/src/HSTUHB.f
new file mode 100644
index 0000000..8eb1a62
--- /dev/null
+++ b/Donjon/src/HSTUHB.f
@@ -0,0 +1,327 @@
+*DECK HSTUHB
+      SUBROUTINE HSTUHB(IPHST,  IPEVO,  IPRINT, MAXI,   NBBTS,  NCHA,
+     >                  NBUN,   IUPDC,  IUPDB,  IDCELL, IDFUEL, DENI,
+     >                  MAXL,   PARAML)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* To update the HISTORY data structure using the information
+* provided on the BURNUP data structure.
+*
+*Copyright:
+* Copyright (C) 2003 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* G. Marleau, E. Varin
+*
+*Parameters: input
+* IPHST   address of the \dds{history} data structure.
+* IPEVO   address of the \dds{burnup} data structure.
+* IPRINT  print level.
+* MAXI    maximum number of isotopes.            
+* NBBTS   number of depletion steps.
+* NCHA    number of fuel channels.                   
+* NBUN    number of bundles per channel.
+* IUPDC   number of the channel to analyze.                   
+* IUPDB   number of the bundle to analyze.
+* IDCELL  cell identifier for each fuel bundle in each channel.
+* IDFUEL  fuel type identifier for each fuel bundle in each channel.
+* IPHST   pointer to the HISTORY data structure
+* IPEVO   pointer to the BURNUP data structure.
+* IPRINT  print level. 
+* MAXI    maximum number of isotopes.
+* NBBTS   number of depletion steps.
+* NCHA    number of fuel channels.
+* NBUN    number of bundles per channels.
+* IUPDC   channel number to process or update.
+* IUPDB   bundle number to process or update.
+* IDCELL  list of cell identifiers. 
+* IDFUEL  list of fuel type identifiers. 
+* MAXL    maximum number of local parameters.                   
+*
+*Parameters: work
+* PARAML  local parameters.
+* DENI    isotopic concentrations of the isotopes 
+*         on the \dds{burnup} or \dds{history} structure.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT         NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR)      IPHST,IPEVO
+      INTEGER          IPRINT,MAXI,NBBTS,MAXL
+      INTEGER          NCHA,NBUN,IUPDC,IUPDB
+      INTEGER          IDCELL(NBUN,NCHA),IDFUEL(NBUN,NCHA)
+      REAL             DENI(0:MAXI) 
+      REAL             PARAML(0:MAXL,2)
+*----
+*  LOCAL PARAMETERS
+*  CDAY = conversion of days in 10^{8} seconds
+*----
+      INTEGER          IOUT
+      INTEGER          ILCMUP,ILCMDN
+      CHARACTER        NAMSBR*6
+      PARAMETER       (IOUT=6,ILCMUP=1,ILCMDN=2,NAMSBR='HSTUHB')
+      REAL             CDAY,TIMPOW(2)
+      PARAMETER       (CDAY=8.64E-4)
+*----
+*  LOCAL VARIABLES
+*---- 
+      INTEGER          ILCMLN,ILCMTY 
+      CHARACTER        NAMTIM*12,NAMP*12 
+      INTEGER          IFT,ICT,INEWF,INEWC
+      INTEGER          ITS,ISO,IOK
+      REAL             BITH(3),BITB(3)
+      REAL             FDENC(2),FDENF(2),FDENB(2)
+      REAL             REVOL(5)
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: MIXIH,MIXIB
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NAMIH,NAMIB
+      REAL, ALLOCATABLE, DIMENSION(:) :: DEPLT
+*----
+*  SCRATCH STORAGE ALLOCATION
+*   NAMIH   name of isotopes on the \dds{history} structure.
+*   MIXIH   mixture number associated with the isotopes 
+*           on the \dds{history} structure.
+*   NAMIB   name of isotopes on the \dds{burnup} structure.
+*   MIXIB   mixture number associated with the isotopes 
+*           on the \dds{burnup} structure.
+*   DEPLT   time associated with each depletion step 
+*           on the \dds{burnup} structure.
+*----
+      ALLOCATE(NAMIH(3,0:MAXI),MIXIH(0:MAXI),NAMIB(3,0:MAXI),
+     > MIXIB(0:MAXI),DEPLT(0:NBBTS))
+*----
+*  Initialize test flags
+*  INEWF -> new fuel type flag
+*           = 0 fuel type does not exists/create it
+*           = 1 fuel exists but does not contain isotopes
+*           = 2 fuel type exists and contains isotopes 
+*  INEWC -> new cell type flag
+*           = 0 cell type does not exists/create it
+*           = 1 cell type exists but isotopes densities missing
+*           = 2 cell type exists and contains isotope densities
+*----
+      IF(IPRINT .GE. 100) THEN
+        WRITE(IOUT,6000) NAMSBR
+      ENDIF
+      INEWF=2
+      INEWC=2
+      DENI(0:MAXI)=0.0
+      PARAML(0:MAXL,:2)=0.0
+      BITH(:3)=0.0
+      BITB(:3)=0.0
+      FDENC(:2)=0.0
+      FDENF(:2)=0.0
+      FDENB(:2)=0.0
+*----
+*  Read HISTORY information for cell specified
+*----
+      IF(IUPDC .GT. 0 .AND. IUPDB .GT. 0) THEN
+*----
+*  Read isotope names and mixtures on FUEL TYPE
+*  if available
+*----
+        IFT=IDFUEL(IUPDB,IUPDC)
+        WRITE(NAMP,'(A4,I8.8)') 'FUEL',IFT 
+        CALL LCMLEN(IPHST,NAMP,ILCMLN,ILCMTY)
+        IF(ILCMLN .EQ. 0) THEN
+          INEWF=0
+        ELSE
+          CALL LCMSIX(IPHST,NAMP,ILCMUP)
+          CALL LCMLEN(IPHST,'ISOTOPESUSED',ILCMLN,ILCMTY)
+          IF(ILCMLN .GT. 0 .AND. ILCMLN .LT. 3*MAXI*4) THEN
+            CALL LCMGET(IPHST,'ISOTOPESUSED',NAMIH(1,1)) 
+            CALL LCMGET(IPHST,'ISOTOPESMIX',MIXIH(1))
+            CALL LCMGET(IPHST,'FUELDEN-INIT',FDENF)
+          ELSE
+            INEWF=1
+          ENDIF
+          CALL LCMSIX(IPHST,NAMP,ILCMDN)
+        ENDIF
+        IF(IPRINT .GE. 100) THEN
+          WRITE(IOUT,6001) 'FUEL TYPE',IFT
+          IF(INEWF .EQ. 2) THEN
+            IF(IPRINT .GE. 100) THEN
+              WRITE(IOUT,6010) 
+              WRITE(IOUT,6011) 
+     >        (NAMIH(1,ISO),NAMIH(2,ISO),NAMIH(3,ISO),ISO=1,MAXI)
+              WRITE(IOUT,6020) 
+              WRITE(IOUT,6021) 
+     >        (MIXIH(ISO),ISO=1,MAXI)
+            ENDIF
+          ENDIF
+        ENDIF 
+*----
+*  Read isotope densities on CELL TYPE
+*  if available
+*----
+        ICT=IDCELL(IUPDB,IUPDC)
+        WRITE(NAMP,'(A4,I8.8)') 'CELL',ICT
+        CALL LCMLEN(IPHST,NAMP,ILCMLN,ILCMTY)
+        IF(ILCMLN .EQ. 0) THEN
+          INEWC=0
+        ELSE
+          CALL LCMSIX(IPHST,NAMP,ILCMUP)
+          IOK=-1
+          CALL HSTGSD(IPHST ,MAXI  ,IOK   ,DENI  ,FDENC )
+          INEWC=1
+          IF(IOK .EQ. 0) THEN
+            INEWC=2
+            CALL LCMGET(IPHST,'DEPL-PARAM  ',BITH)
+          ENDIF
+          CALL LCMSIX(IPHST,NAMP,ILCMDN)
+        ENDIF
+        IF(IPRINT .GE. 100) THEN
+          WRITE(IOUT,6001) 'CELL TYPE',ICT
+          IF(INEWF .EQ. 2) THEN
+            IF(IPRINT .GE. 100) THEN
+              WRITE(IOUT,6100)  
+              WRITE(IOUT,6110) (DENI(ISO),ISO=1,MAXI)
+            ENDIF
+          ENDIF
+        ENDIF 
+*----
+*  Read isotopes names and mixtures on BURNUP
+*----
+        CALL LCMGET(IPEVO,'ISOTOPESUSED',NAMIB(1,1))
+        CALL LCMGET(IPEVO,'ISOTOPESMIX ',MIXIB(1))
+        CALL LCMGET(IPEVO,'FUELDEN-INIT',FDENB)
+*----
+*  Test for coherence of isotopes names and mixture
+*  between HISTORY and BURNUP if fuel type contains
+*  isotopes description
+*----
+        IF(INEWF .EQ. 2) THEN
+          DO 100 ISO=1,MAXI
+            IF(NAMIH(ISO,1) .NE. NAMIB(ISO,1) .OR. 
+     >         NAMIH(ISO,2) .NE. NAMIB(ISO,2) .OR. 
+     >         NAMIH(ISO,3) .NE. NAMIB(ISO,3) .OR. 
+     >         MIXIH(ISO)   .NE. MIXIB(ISO)   ) THEN
+              CALL XABORT(NAMSBR//
+     >        ': Isotopes on HISTORY and BURNUP not coherent')
+            ENDIF 
+ 100      CONTINUE
+          IF(FDENF(1) .NE. FDENB(1) .OR.
+     >       FDENF(2) .NE. FDENB(2) ) THEN
+            CALL XABORT(NAMSBR//
+     >      ': Fuel DENSITY on HISTORY and BURNUP not coherent')
+          ENDIF
+        ENDIF
+*----
+*  Read calculation types on BURNUP
+*----     
+        CALL LCMGET(IPEVO,'EVOLUTION-R ',REVOL)
+        DEPLT(0:NBBTS)=0.0
+        CALL LCMGET(IPEVO,'DEPL-TIMES  ',DEPLT(1)) 
+*----
+*  Read initial burnup information (FOR FUEL TYPE)
+*  and save
+*----
+        ITS=1 
+        IF(INEWF .NE. 2 ) THEN
+          BITB(1)=DEPLT(ITS)/CDAY
+          IF(BITB(1) .EQ. 0.0) THEN
+            WRITE(NAMTIM,'(A8,I4.4)') 'DEPL-DAT',ITS
+            CALL LCMSIX(IPEVO,NAMTIM,ILCMUP)
+            CALL LCMGET(IPEVO,'ISOTOPESDENS',DENI(1))
+            CALL LCMGET(IPEVO,'BURNUP-IRRAD',BITB(2))
+            CALL LCMSIX(IPEVO,NAMTIM,ILCMDN)
+          ELSE
+            CALL XABORT(NAMSBR//
+     >      ': Initial DENSITY on BURNUP required') 
+          ENDIF
+*----
+*  Save isotopes names and mixtures for FUEL type
+*----
+          WRITE(NAMP,'(A4,I8.8)') 'FUEL',IFT 
+          CALL LCMSIX(IPHST,NAMP,ILCMUP)
+          CALL LCMPUT(IPHST,'ISOTOPESUSED',3*MAXI,3,NAMIB(1,1)) 
+          CALL LCMPUT(IPHST,'ISOTOPESMIX',MAXI  ,1,MIXIB(1))
+          CALL LCMPUT(IPHST,'FUELDEN-INIT',2     ,2,FDENB)
+          CALL LCMPUT(IPHST,'ISOTOPESDENS',MAXI  ,2,DENI(1))
+          CALL LCMSIX(IPHST,NAMP,ILCMDN)
+          IF(IPRINT .GE. 100) THEN
+            WRITE(IOUT,6010) 
+            WRITE(IOUT,6011) 
+     >        (NAMIB(1,ISO),NAMIB(2,ISO),NAMIB(3,ISO),ISO=1,MAXI)
+            WRITE(IOUT,6020) 
+            WRITE(IOUT,6021) 
+     >        (MIXIB(ISO),ISO=1,MAXI)
+          ENDIF
+        ELSE
+          BITB(1)=DEPLT(ITS)/CDAY
+          WRITE(NAMTIM,'(A8,I4.4)') 'DEPL-DAT',ITS
+          CALL LCMSIX(IPEVO,NAMTIM,ILCMUP)
+          CALL LCMGET(IPEVO,'BURNUP-IRRAD',BITB(2))
+          CALL LCMSIX(IPEVO,NAMTIM,ILCMDN)
+*----
+*  Test if initial BURNUP coherent with old history
+*----
+          IF(INEWC .EQ. 2 ) THEN
+            IF(BITB(1) .NE. BITH(1) .OR.
+     >         BITB(2) .NE. BITH(2) .OR.
+     >         BITB(3) .NE. BITH(3) ) THEN
+              WRITE(IOUT,6200) BITH(1)
+            ENDIF
+          ENDIF
+        ENDIF
+        ITS=NBBTS 
+        BITB(1)=DEPLT(ITS)/CDAY
+        WRITE(NAMTIM,'(A8,I4.4)') 'DEPL-DAT',ITS
+        CALL LCMSIX(IPEVO,NAMTIM,ILCMUP)
+        CALL LCMGET(IPEVO,'ISOTOPESDENS',DENI(1))
+        CALL LCMGET(IPEVO,'BURNUP-IRRAD',BITB(2))
+        CALL LCMSIX(IPEVO,NAMTIM,ILCMDN) 
+*----
+*  Save power desnity and depletion time in History
+*   Modif EV 04/11/09
+*----
+        WRITE(NAMP,'(A4,I8.8)') 'CELL',ICT
+        CALL LCMSIX(IPHST,NAMP,ILCMUP)
+        IOK=-2
+        CALL HSTGSL(IPHST ,MAXL  ,IOK   ,TIMPOW,PARAML(0,1)) 
+        IF(IOK .NE. 0) PARAML(0:MAXL,1)=0.0
+        IOK=2
+        TIMPOW(1)= DEPLT(NBBTS)/CDAY
+        TIMPOW(2)= REVOL(5)
+        CALL HSTGSL(IPHST ,MAXL  ,IOK   ,TIMPOW,PARAML(0,1)) 
+*----
+*  Save last densities on BURNUP
+*----
+        IOK=2
+        CALL HSTGSD(IPHST ,MAXI  ,IOK   ,DENI  ,FDENB )
+        CALL LCMPUT(IPHST,'DEPL-PARAM  ',3,2,BITB)
+        CALL LCMSIX(IPHST,NAMP,ILCMDN)
+        IF(IPRINT .GE. 100) THEN
+          WRITE(IOUT,6101)  
+          WRITE(IOUT,6110) (DENI(ISO),ISO=1,MAXI)
+        ENDIF
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(DEPLT,MIXIB,NAMIB,MIXIH,NAMIH)
+*----
+*  Return
+*----
+      RETURN
+*----
+*  FORMAT
+*----
+ 6000 FORMAT(' ****** OUTPUT FROM ',A6)
+ 6001 FORMAT(' Contents of ',A9,1X,I8) 
+ 6010 FORMAT(' NAME OF ISOTOPES ')
+ 6011 FORMAT(10(3A4,2X))
+ 6020 FORMAT(' MIXTURE OF ISOTOPES ')
+ 6021 FORMAT(10(I12,2X))
+ 6100 FORMAT(' INITIAL DENSITIES')
+ 6101 FORMAT(' FINAL DENSITIES')
+ 6110 FORMAT(1P,10E14.7)
+ 6200 FORMAT(' Update cell densities with no chronological burnup'/
+     +       ' Old time ',F6.2,' days  should be zero.'/
+     +       ' Possible errors or restart case')
+      END 
diff --git a/Donjon/src/HSTUHM.f b/Donjon/src/HSTUHM.f
new file mode 100644
index 0000000..bf131bf
--- /dev/null
+++ b/Donjon/src/HSTUHM.f
@@ -0,0 +1,191 @@
+*DECK HSTUHM
+      SUBROUTINE HSTUHM(IPHST, IPMAP, IPRINT, MAXL,   NCHA,   NBUN,   
+     >                  MAXI, POWER,  BURNP, IREFUS, REFUT, BUNLEN,
+     >                  IDCELL, IDFUEL, PARAML, DENI)
+*
+*----------
+*
+*Purpose:
+* Store bundle power and depletion time in History 
+* Refuel channel by performing fuel shuffling. 
+*
+*Copyright:
+* Copyright (C) 2004 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* G. Marleau, E. Varin
+*
+*Parameters:
+* IPHST   address of the \dds{history} data structure.
+* IPMAP   address of the \dds{map} data structure.
+* IPRINT  print level.
+* MAXL    maximum number of local parameters.                   
+* NCHA    number of fuel channels.                   
+* NBUN    number of bundles per channel.            
+* MAXI    maximum number of isotopes.            
+* NBFUEL  number of fueled channels.            
+* DELTAT  last character string read.
+* POWER   power for each fuel bundle in each channel.
+* BURNP   burnup for each fuel bundle in each channel.
+* IREFUS  refueling strategy for each channel.
+*         refueling strategy for each channel.
+*         A channel is refueled using a NBS bundle 
+*         shift procedure if IREFUS(I)=NBS. 
+*         In the case where NBS $>$ 0,
+*         bundles 1 to NBUN-NBS are displaced to position NBS+1 to
+*         NBUN while locations 1 to NBS are filled with new fuel. 
+*         In the case where NBS $<$ 0,
+*         bundles -NBS+1 to NBUN are displaced to position 1 to
+*         NBUN+NBS while locations NBUN+NBS+1 to NBUN are filled 
+*         with new fuel.
+* REFUT   refueling time for each channel.
+* BUNLEN  length (cm) of a bundle.            
+*
+*Parameters: input/output
+* IDCELL  cell identifier for each fuel bundle in each channel.
+* IDFUEL  fuel type identifier for each fuel bundle in each channel.
+*
+*Parameters: work
+* PARAML  local parameters.
+* DENI    isotopic concentrations.
+*
+*----------
+*
+      USE GANLIB
+      IMPLICIT         NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR)      IPHST,IPMAP
+      INTEGER          IPRINT,MAXL,NCHA,NBUN,MAXI
+      INTEGER          NBFUEL
+      REAL             DELTAT, BUNLEN
+      REAL             POWER(NCHA,NBUN),BURNP(NCHA,NBUN)
+      INTEGER          IREFUS(NCHA)
+      REAL             REFUT(NCHA)
+      INTEGER          IDCELL(NBUN,NCHA),IDFUEL(NBUN,NCHA)
+      REAL             PARAML(0:MAXL,2)
+      REAL             DENI(0:MAXI)
+*----
+*  LOCAL PARAMETERS
+*----
+      TYPE(C_PTR)      JPMAP,KPMAP
+      INTEGER          IOUT,NTC,ILCMUP,ILCMDN
+      CHARACTER        NAMSBR*6
+      PARAMETER       (IOUT=6,NTC=3,ILCMUP=1,ILCMDN=2,
+     >                 NAMSBR='HSTUHM')
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER          ILONG,ITYP
+      INTEGER          IUPDC,IUPDB
+      INTEGER          IOK,ICT,IFT
+      REAL             FDEN(2),RWEIGHT,WEIGHT,TIME
+      REAL             TIMPOW(2)
+      CHARACTER        NAMP*12
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: ISHUFF
+*----
+*  SCRATCH STORAGE ALLOCATION
+*   ISHUFF  fuel shuffling index for a channel.
+*----
+      ALLOCATE(ISHUFF(NBUN))
+*
+      NBFUEL=0
+      PARAML(0:MAXL,:2)=0.0
+      DELTAT = 0.0
+      TIME=0.0
+*----
+*  Get information in IPMAP
+*----   
+      IF(IPRINT .GE. 10) THEN
+        WRITE(IOUT,7000) NAMSBR
+      ENDIF
+*----   
+      CALL HSTGMA(IPMAP ,NCHA ,NBUN   ,DELTAT,
+     >            POWER ,BURNP,IREFUS ,REFUT ,NBFUEL)
+*----
+      DO 10 IUPDC=1,NCHA
+        DO 11 IUPDB=1,NBUN
+*
+        IF(IDCELL(IUPDB,IUPDC) .LE. 0) THEN
+          IDCELL(IUPDB,IUPDC)= IUPDC + (IUPDB - 1)*NCHA
+          IDFUEL(IUPDB,IUPDC)=1 
+        ENDIF
+        IFT=IDFUEL(IUPDB,IUPDC)
+        WRITE(NAMP,'(A4,I8.8)') 'FUEL',IFT
+        CALL LCMSIX(IPHST,NAMP,ILCMUP)
+        CALL LCMSIX(IPHST,NAMP,ILCMDN)
+*----
+*   store power and time after refueling
+*   for all fuel cells
+*----
+        ICT=IDCELL(IUPDB,IUPDC)
+        WRITE(NAMP,'(A4,I8.8)') 'CELL',ICT
+        CALL LCMSIX(IPHST,NAMP,ILCMUP)
+*----
+*  Get fuel density or weight
+*----         
+        IOK=-1              
+        RWEIGHT= 1.
+        CALL HSTGSD(IPHST ,MAXI  ,IOK   ,DENI  ,FDEN   )
+        IF(IOK.LT.0) THEN
+          JPMAP=LCMGID(IPMAP,'FUEL')
+          KPMAP=LCMGIL(JPMAP,1)
+          CALL LCMLEN(KPMAP,'WEIGHT',ILONG,ITYP)
+          IF (ILONG .EQ.0) 
+     +     CALL XABORT(NAMSBR//' FUEL WEIGHT MUST BE SPECIFIED IN MAP')
+          CALL LCMGET(KPMAP,'WEIGHT',WEIGHT)
+          RWEIGHT= 1./WEIGHT
+        ELSEIF(IOK.EQ.0) THEN
+          RWEIGHT=1000.0/(FDEN(2)*BUNLEN)
+        ENDIF
+        IF(IPRINT .GE. 10) THEN
+           WRITE(IOUT,7003) NAMP,POWER(IUPDC,IUPDB),BURNP(IUPDC,IUPDB),
+     +     WEIGHT
+        ENDIF
+        POWER(IUPDC,IUPDB)=POWER(IUPDC,IUPDB)*RWEIGHT
+        IF(DELTAT.EQ.0.0) THEN
+          TIME = BURNP(IUPDC,IUPDB)/POWER(IUPDC,IUPDB)
+        ELSE
+          TIME = DELTAT
+        ENDIF
+*----
+*  Save local parameters from cell IB after refueling
+*----         
+        IOK=-2
+        CALL HSTGSL(IPHST ,MAXL  ,IOK   ,TIMPOW,PARAML)
+        IF(IOK .NE. 0) PARAML(0:MAXL,1)=0.0
+*-----
+        IOK=2
+        TIMPOW(1)=TIME
+        TIMPOW(2)=POWER(IUPDC,IUPDB)
+        CALL HSTGSL(IPHST ,MAXL  ,IOK   ,TIMPOW,PARAML)
+        CALL LCMSIX(IPHST,NAMP,ILCMDN)
+        IF(IPRINT .GE. 10) THEN
+           WRITE(IOUT,7002) NAMP, POWER(IUPDC,IUPDB), TIME
+        ENDIF
+ 11     CONTINUE
+ 10   CONTINUE 
+**
+      IF(NBFUEL .GT. 0) THEN
+        CALL HSTREF(IPHST ,IPRINT,MAXL  ,NCHA ,NBUN ,MAXI ,
+     >              DELTAT, POWER ,IREFUS,REFUT,
+     >              IDCELL,IDFUEL,PARAML, DENI ,ISHUFF)
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(ISHUFF)
+*----
+*  Return
+*----
+      RETURN
+*----
+* Format
+*----
+ 7000 FORMAT(' ***** OUTPUT FROM ',A6,' *****')
+ 7002 FORMAT(' Fuel cell  ',A12, ' with ',F12.4,' kW/kg ',
+     >       F10.2,' days ')
+ 7003 FORMAT(' Fuel cell  ',A12, ' with ',F12.4,' kW/kg ',F12.3,
+     >       ' kWd/kg  ',F12.3,' kg ')
+      END 
diff --git a/Donjon/src/HSTUMH.f b/Donjon/src/HSTUMH.f
new file mode 100644
index 0000000..e290034
--- /dev/null
+++ b/Donjon/src/HSTUMH.f
@@ -0,0 +1,95 @@
+*DECK HSTUMH                                 
+      SUBROUTINE HSTUMH(IPMAP, IPHST,  IPRINT, NCHA,   NBUN,   IDCELL,
+     >                  BURNUP )
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* To update the MAP data structure using the information
+* provided on the HISTORY data structure.
+*
+*Copyright:
+* Copyright (C) 2004 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* E. Varin
+*
+*Parameters: input
+* IPMAP   address of the \dds{map} data structure.
+* IPHST   address of the \dds{history} data structure.
+* IPRINT  print level.
+* NCHA    number of fuel channels.                   
+* NBUN    number of bundles per channel.
+* IDCELL  cell identifier for each fuel bundle in each channel.
+*
+*Parameters: work        
+* BURNUP   burnup for each fuel bundle in each channel.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT         NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR)      IPHST,IPMAP
+      INTEGER          IPRINT
+      INTEGER          NCHA,NBUN
+      INTEGER          IDCELL(NBUN,NCHA)
+      REAL             BURNUP(NCHA,NBUN)
+*----
+*  LOCAL PARAMETERS
+*----
+      INTEGER          IOUT
+      INTEGER          ILCMUP,ILCMDN
+      CHARACTER        NAMSBR*6
+      PARAMETER       (IOUT=6,ILCMUP=1,ILCMDN=2,NAMSBR='HSTUMH')
+*----
+*  LOCAL VARIABLES
+*---- 
+      CHARACTER        NAMP*12 
+      INTEGER          ILCMLN,ILCMTY 
+      INTEGER          IBT,ICT,ICCT
+      REAL             BITH(3)
+*----
+*  Read isotope densities on CELL TYPE
+*  if available
+*----
+      IF(IPRINT .GE. 100) THEN
+        WRITE(IOUT,6000) NAMSBR
+      ENDIF
+      CALL LCMGET(IPMAP,'BURN-DEB',BURNUP)
+      DO 10 ICT=1,NCHA
+       DO 20 IBT=1,NBUN
+        ICCT=IDCELL(IBT,ICT)
+        WRITE(NAMP,'(A4,I8.8)') 'CELL',ICCT
+        CALL LCMLEN(IPHST,NAMP,ILCMLN,ILCMTY)
+        IF(ILCMLN .EQ. 0) THEN
+          CALL XABORT(' HSTUMH: BAD CELL TYPE')
+        ELSE
+          CALL LCMSIX(IPHST,NAMP,ILCMUP)
+          CALL LCMGET(IPHST,'DEPL-PARAM  ',BITH)
+          CALL LCMSIX(IPHST,NAMP,ILCMDN)
+        ENDIF
+        IF(IPRINT .GE. 100) THEN
+          WRITE(IOUT,6001) 'CELL TYPE',ICCT
+          WRITE(IOUT,'(A6,1X,F8.3,2X,F8.3)') 'BURNUP',
+     >       BITH(2),BURNUP(ICT,IBT)
+        ENDIF 
+        BURNUP(ICT,IBT) = BITH(2)
+ 20   CONTINUE
+ 10   CONTINUE
+*----
+* Store burnup record in MAP data structure
+*----
+      CALL LCMPUT(IPMAP,'BURN-DEB',NBUN*NCHA,2,BURNUP)
+*----
+*  Return
+*----
+      RETURN
+*----
+*  FORMAT
+*----
+ 6000 FORMAT(' ****** OUTPUT FROM ',A6)
+ 6001 FORMAT(' Contents of ',A9,1X,I8) 
+      END 
diff --git a/Donjon/src/IDET.f b/Donjon/src/IDET.f
new file mode 100644
index 0000000..b84679d
--- /dev/null
+++ b/Donjon/src/IDET.f
@@ -0,0 +1,305 @@
+*DECK IDET
+      SUBROUTINE IDET(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Detector integrated response evaluation
+*
+*Copyright:
+* Copyright (C) 2019 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The IDET: module specification is:
+* IDETEC := IDET: [ IDETEC ] TRKNAM FLUNAM LIBNAM [ FMAP ] :: (descidet) ;
+* where
+*   IDETEC : name of a \emph{idetect} data structure, (L\_INTDETEC signature) 
+*     that will be created or updated by the IDET: module.
+*   TRKNAM : name of the read-only \emph{tracking} data structure 
+*     (L\_TRACK signature) containing the finite-element tracking.
+*   FLUNAM : name of the read-only \emph{fluxunk data structure 
+*     (L\_FLUX signature) containing the finite-element solution.
+*   LIBNAM : name of the read-only \emph{macrolib} data structure 
+*     (L\_LIBRARY signature) that contains the interpolated microscopic
+*     cross sections.
+*   FMAP   : name of the read-only  \emph{fmap} data structure
+*     (L\_MAP signature) containing renumbered mixture indices. This object 
+*     is optionnal.
+*   (descidet) : structure describing the input data to the IDET: module.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER MAXCO
+      PARAMETER (MAXNI=10,NSTATE=40)
+      INTEGER INDIC,NITMA,ISTATE(NSTATE)
+      DOUBLE PRECISION DFLOT
+      CHARACTER CMODUL*12,HSIGN*12,TEXT12*12,DETNAM*12,REANAM*12
+      REAL FLOT
+      TYPE(C_PTR) IPIDET,IPTRK,IPFLU,IPLIB,IPMAP
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, DIMENSION(:), POINTER :: NINX,NINY,NINZ
+      INTEGER, DIMENSION(:), POINTER :: NINX_2,NINY_2,NINZ_2
+      REAL, DIMENSION(:), ALLOCATABLE :: DETECT
+      REAL, DIMENSION(:,:), POINTER :: COORD1,COORD2,COORD3
+      REAL, DIMENSION(:,:), POINTER :: COORD1_2,COORD2_2,
+     > COORD3_2
+*----
+*  PARAMETER VALIDATION
+*----
+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('IDET: LCM'
+     > //' object expected at LHS.')
+      IF(JENTRY(1).EQ.2) CALL XABORT('IDET: L_INTDETEC entry in create'
+     > //' or modification mode expected.')
+      IPIDET=KENTRY(1)
+      MAXCO=100 ! maximum number of detectors
+      IF(JENTRY(1).EQ.0) THEN
+        HSIGN='L_INTDETEC'
+        CALL LCMPTC(IPIDET,'SIGNATURE',12,HSIGN)
+        DETNAM='U235'
+        REANAM='NFTOT'
+        ALLOCATE(COORD1(MAXNI,MAXCO),COORD2(MAXNI,MAXCO),
+     >  COORD3(MAXNI,MAXCO),NINX(MAXCO),NINY(MAXCO),NINZ(MAXCO))
+        NDETC=0
+      ELSE
+        CALL LCMGTC(IPIDET,'SIGNATURE',12,HSIGN)
+        IF(HSIGN.NE.'L_INTDETEC') THEN
+          TEXT12=HENTRY(3)
+          CALL XABORT('IDET: signature of '//TEXT12//' IS '//HSIGN//
+     >    '. L_INTDETEC expected.')
+        ENDIF
+        CALL LCMGET(IPIDET,'STATE-VECTOR',ISTATE)
+        IF(ISTATE(1).NE.MAXNI) CALL XABORT('IDET: invalid MAXNI.')
+        NDETC=ISTATE(2)
+        MAXCO=MAX(MAXCO,NDETC)
+        ALLOCATE(COORD1(MAXNI,MAXCO),COORD2(MAXNI,MAXCO),
+     >  COORD3(MAXNI,MAXCO),NINX(MAXCO),NINY(MAXCO),NINZ(MAXCO))
+        CALL LCMGET(IPIDET,'NINX',NINX)
+        CALL LCMGET(IPIDET,'NINY',NINY)
+        CALL LCMGET(IPIDET,'NINZ',NINZ)
+        CALL LCMGET(IPIDET,'COORD1',COORD1)
+        CALL LCMGET(IPIDET,'COORD2',COORD2)
+        CALL LCMGET(IPIDET,'COORD3',COORD3)
+        CALL LCMGTC(IPIDET,'DETNAM',12,DETNAM)
+        CALL LCMGTC(IPIDET,'REANAM',12,REANAM)
+      ENDIF
+      IPFLU=C_NULL_PTR
+      IPTRK=C_NULL_PTR
+      IPLIB=C_NULL_PTR
+      IPMAP=C_NULL_PTR
+      CMODUL=' '
+      DO I=2,NENTRY
+        IF(IENTRY(I).GT.2) CALL XABORT('IDET: LCM object expected.')
+        IF(JENTRY(I).NE.2) CALL XABORT('IDET: LCM object in read-only '
+     > //'MODE EXPECTED AT RHS.')
+        CALL LCMGTC(KENTRY(I),'SIGNATURE',12,HSIGN)
+        IF(HSIGN.EQ.'L_FLUX') THEN
+          IPFLU=KENTRY(I)
+        ELSEIF(HSIGN.EQ.'L_TRACK') THEN
+          IPTRK=KENTRY(I)
+          CALL LCMGTC(IPTRK,'TRACK-TYPE',12,CMODUL)
+        ELSEIF(HSIGN.EQ.'L_LIBRARY') THEN
+          IPLIB=KENTRY(I)
+        ELSEIF(HSIGN.EQ.'L_MAP') THEN
+          IPMAP=KENTRY(I)
+        ELSE
+          TEXT12=HENTRY(I)
+          CALL XABORT('IDET: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     >    '. L_FLUX, L_TRACK or L_LIBRARY expected.')
+        ENDIF
+      ENDDO
+      IF(CMODUL.NE.'TRIVAC') CALL XABORT('IDET: TRIVAC tracking expect'
+     > //'ed.')
+*----
+*  READ INPUTS
+*----
+      IMPX=1
+      ICORN=1
+   10 CALL REDGET(INDIC,NITMA,FLOT,TEXT12,DFLOT)
+      IF(INDIC.NE.3) CALL XABORT('IDET: character data expected.')
+      IF(TEXT12.EQ.'EDIT') THEN
+        CALL REDGET(INDIC,IMPX,FLOT,TEXT12,DFLOT)
+        IF(INDIC.NE.1) CALL XABORT('IDET: integer data expected.')
+      ELSE IF(TEXT12.EQ.'DETNAME') THEN
+        CALL REDGET(INDIC,NITMA,FLOT,DETNAM,DFLOT)
+        IF(INDIC.NE.3) CALL XABORT('IDET: character data expected(1).')
+      ELSE IF(TEXT12.EQ.'REANAME') THEN
+        CALL REDGET(INDIC,NITMA,FLOT,REANAM,DFLOT)
+        IF(INDIC.NE.3) CALL XABORT('IDET: character data expected(2).')
+      ELSE IF(TEXT12.EQ.'DETECTOR') THEN
+   20   CALL REDGET(INDIC,NITMA,FLOT,TEXT12,DFLOT)
+        IF(INDIC.NE.3) CALL XABORT('IDET: character data expected.')
+   30   IF(TEXT12.EQ.'POSITION') THEN
+*         Cartesian position of a single detector
+          NDETC=NDETC+1
+          IF(NDETC.GT.MAXCO) THEN
+*           extend the allocated space to store detectors
+            MAXCO_2=MAXCO+100
+            ALLOCATE(COORD1_2(MAXNI,MAXCO_2),COORD2_2(MAXNI,MAXCO_2),
+     >      COORD3_2(MAXNI,MAXCO_2),NINX_2(MAXCO_2),NINY_2(MAXCO_2),
+     >      NINZ_2(MAXCO_2))
+            COORD1_2(:MAXNI,:MAXCO)=COORD1(:MAXNI,:MAXCO)
+            COORD2_2(:MAXNI,:MAXCO)=COORD2(:MAXNI,:MAXCO)
+            COORD3_2(:MAXNI,:MAXCO)=COORD3(:MAXNI,:MAXCO)
+            NINX_2(:MAXCO)=NINX(:MAXCO)
+            NINY_2(:MAXCO)=NINY(:MAXCO)
+            NINZ_2(:MAXCO)=NINZ(:MAXCO)
+            DEALLOCATE(NINZ,NINY,NINX,COORD3,COORD2,COORD1)
+            MAXCO=MAXCO_2
+            COORD1=>COORD1_2
+            COORD2=>COORD2_2
+            COORD3=>COORD3_2
+            NINX=>NINX_2
+            NINY=>NINY_2
+            NINZ=>NINZ_2
+          ENDIF
+          NINX(NDETC)=1
+          NINY(NDETC)=1
+          NINZ(NDETC)=1
+          CALL REDGET(INDIC,NITMA,FLOT,TEXT12,DFLOT)
+          IF(INDIC.EQ.2) THEN
+            COORD1(1,NDETC)=FLOT
+          ELSE IF((INDIC.EQ.3).AND.(TEXT12.EQ.'INTEG')) THEN
+            NINX(NDETC)=MAXNI
+            CALL REDGET(INDIC,NITMA,COO1,TEXT12,DFLOT)
+            IF(INDIC.NE.2) CALL XABORT('IDET: COORD1 data1 expected.')
+            CALL REDGET(INDIC,NITMA,COO2,TEXT12,DFLOT)
+            IF(INDIC.NE.2) CALL XABORT('IDET: COORD1 data2 expected.')
+            IF(COO2.LE.COO1) CALL XABORT('IDET: COORD1 data2<=data1.')
+            DELTA=(COO2-COO1)/REAL(MAXNI-1)
+            DO INX=1,MAXNI
+              COORD1(INX,NDETC)=COO1+REAL(INX-1)*DELTA
+            ENDDO
+          ELSE
+            CALL XABORT('IDET: COORD1 data or INTEG keyword expected.')
+          ENDIF
+          CALL REDGET(INDIC,NITMA,FLOT,TEXT12,DFLOT)
+          IF(INDIC.EQ.2) THEN
+            COORD2(1,NDETC)=FLOT
+          ELSE IF((INDIC.EQ.3).AND.(TEXT12.EQ.'INTEG')) THEN
+            NINY(NDETC)=MAXNI
+            CALL REDGET(INDIC,NITMA,COO1,TEXT12,DFLOT)
+            IF(INDIC.NE.2) CALL XABORT('IDET: COORD2 data1 expected.')
+            CALL REDGET(INDIC,NITMA,COO2,TEXT12,DFLOT)
+            IF(INDIC.NE.2) CALL XABORT('IDET: COORD2 data2 expected.')
+            IF(COO2.LE.COO1) CALL XABORT('IDET: COORD2 data2<=data1.')
+            DELTA=(COO2-COO1)/REAL(MAXNI-1)
+            DO INY=1,MAXNI
+              COORD2(INY,NDETC)=COO1+REAL(INY-1)*DELTA
+            ENDDO
+          ELSE
+            CALL XABORT('IDET: COORD2 data or INTEG keyword expected.')
+          ENDIF
+          CALL REDGET(INDIC,NITMA,FLOT,TEXT12,DFLOT)
+          IF(INDIC.EQ.2) THEN
+            COORD3(1,NDETC)=FLOT
+            GO TO 20
+          ELSE IF(INDIC.EQ.3) THEN
+            IF(TEXT12.EQ.'INTEG') THEN
+              NINZ(NDETC)=MAXNI
+              CALL REDGET(INDIC,NITMA,COO1,TEXT12,DFLOT)
+              IF(INDIC.NE.2) CALL XABORT('IDET: COORD3 data1 expected.')
+              CALL REDGET(INDIC,NITMA,COO2,TEXT12,DFLOT)
+              IF(INDIC.NE.2) CALL XABORT('IDET: COORD3 data2 expected.')
+              IF(COO2.LE.COO1) CALL XABORT('IDET: COORD3 data2<=data1.')
+              DELTA=(COO2-COO1)/REAL(MAXNI-1)
+              DO INZ=1,MAXNI
+                COORD3(INZ,NDETC)=COO1+REAL(INZ-1)*DELTA
+              ENDDO
+              GO TO 20
+            ELSE
+              COORD3(1,NDETC)=1.0
+              GO TO 30
+            ENDIF
+          ELSE
+            CALL XABORT('IDET: real or character data expected.')
+          ENDIF
+        ELSE IF(TEXT12.EQ.'ENDD') THEN
+          GO TO 10
+        ELSE
+          CALL XABORT('IDET: POSITION, MIXTURE or ENDP keyword expec'
+     >    //'ted.')
+        ENDIF
+        GO TO 20
+      ELSE IF(TEXT12.EQ.'NOCCOR') THEN
+        ICORN=0
+      ELSE IF(TEXT12.EQ.'CCOR') THEN
+        ICORN=1
+      ELSE IF(TEXT12.EQ.';') THEN
+        GO TO 40
+      ELSE
+        CALL XABORT('IDET: unknownn keyword-->'//TEXT12)
+      ENDIF
+      GO TO 10
+*----
+*  PERFORM FLUX INTERPOLATION OVER DETECTOR LOCATIONS
+*----
+   40 IF(NDETC.EQ.0) CALL XABORT('IDET: no detector defined.')
+      ALLOCATE(DETECT(NDETC))
+      CALL IDET01(IPTRK,IPFLU,IPLIB,IPMAP,IMPX,NDETC,MAXNI,NINX,NINY,
+     > NINZ,COORD1,COORD2,COORD3,DETNAM,REANAM,ICORN,DETECT)
+*----
+*  PRINT DETECTOR RESPONSE
+*----
+      IF(IMPX.GT.0) THEN
+        WRITE(6,'(/25H DET: DETECTOR READINGS (,2A12,1H))') DETNAM,
+     >  REANAM
+        WRITE(6,'(10X,8HDETECTOR,5X,7HREADING)')
+        DO I=1,NDETC
+          WRITE(6,'(8X,I10,1P,E16.5)') I,DETECT(I)
+        ENDDO
+      ENDIF
+*----
+*  SAVE DETECTOR INFORMATION ON LCM
+*----
+      ISTATE(:NSTATE)=0
+      ISTATE(1)=MAXNI
+      ISTATE(2)=NDETC
+      CALL LCMPUT(IPIDET,'STATE-VECTOR',NSTATE,1,ISTATE)
+      CALL LCMPUT(IPIDET,'NINX',NDETC,1,NINX)
+      CALL LCMPUT(IPIDET,'NINY',NDETC,1,NINY)
+      CALL LCMPUT(IPIDET,'NINZ',NDETC,1,NINZ)
+      CALL LCMPUT(IPIDET,'COORD1',MAXNI*NDETC,2,COORD1)
+      CALL LCMPUT(IPIDET,'COORD2',MAXNI*NDETC,2,COORD2)
+      CALL LCMPUT(IPIDET,'COORD3',MAXNI*NDETC,2,COORD3)
+      CALL LCMPTC(IPIDET,'DETNAM',12,DETNAM)
+      CALL LCMPTC(IPIDET,'REANAM',12,DETNAM)
+      CALL LCMPUT(IPIDET,'RESPON',NDETC,2,DETECT)
+*----
+*  RELEASE MEMORY
+*----
+      DEALLOCATE(DETECT,NINZ,NINY,NINX,COORD3,COORD2,COORD1)
+      RETURN
+      END
diff --git a/Donjon/src/IDET01.f b/Donjon/src/IDET01.f
new file mode 100644
index 0000000..6cb4e56
--- /dev/null
+++ b/Donjon/src/IDET01.f
@@ -0,0 +1,440 @@
+*DECK IDET01
+      SUBROUTINE IDET01(IPTRK,IPFLU,IPLIB,IPMAP,IMPX,NDETC,MAXNI,NINX,
+     > NINY,NINZ,COORD1,COORD2,COORD3,DETNAM,REANAM,ICORN,DETECT)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute detector integrated response on Cartesian geometry
+*
+*Copyright:
+* Copyright (C) 2019 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPTRK   pointer to the tracking.
+* IPFLU   pointer to the finite-element flux.
+* IPLIB   pointer to the interpolated microlib.
+* IPMAP   pointer to the fuelmap.
+* IMPX    print parameter.
+* NDETC   number of detectors
+* MAXNI   first dimension of matrices NIN and COORD.
+* NINX    number of interpolation points per detector along x axis.
+* NINY    number of interpolation points per detector along y axis.
+* NINZ    number of interpolation points per detector along z axis.
+* COORD1  interpolation points per detector along x axis.
+* COORD2  interpolation points per detector along y axis.
+* COORD3  interpolation points per detector along z axis.
+* DETNAM  character*12 alias name of the isotope used as detector.
+* REANAM  character*12 name of the nuclear reaction used as detector.
+* ICORN   flag to activate corner flux correction (0/1: ON/OFF).
+*
+*Parameters: output
+* DETECT  detector response.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPTRK,IPFLU,IPLIB,IPMAP
+      INTEGER IMPX,NDETC,MAXNI,NINX(MAXNI),NINY(MAXNI),NINZ(MAXNI),ICORN
+      REAL COORD1(MAXNI,NDETC),COORD2(MAXNI,NDETC),COORD3(MAXNI,NDETC),
+     > DETECT(NDETC)
+      CHARACTER DETNAM*12,REANAM*12
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER NSTATE
+      PARAMETER (NSTATE=40)
+      INTEGER ISTATE(NSTATE)
+      LOGICAL L3D
+      CHARACTER HSMG*131,CMODUL*12
+      TYPE(C_PTR) JPFLU,JPLIB,KPLIB,IPMAC,JPMAC,KPMAC
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, DIMENSION(:), ALLOCATABLE :: MAT,KFLX,KN,IMIX
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: MIXT
+      REAL, DIMENSION(:), ALLOCATABLE :: XX,YY,ZZ,XXX,YYY,ZZZ,MXD,MYD,
+     > MZD,FLXD,GAR,TERPX,TERPY,TERPZ
+      REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: TFLUX,AFLUX,DFLUX,SIGF
+      CHARACTER(LEN=12), DIMENSION(:), ALLOCATABLE :: HNAMIS
+      TYPE(C_PTR), DIMENSION(:), ALLOCATABLE :: IPISO
+*----
+*  RECOVER GENERAL TRACKING INFORMATION
+*----
+      IF(.NOT.C_ASSOCIATED(IPTRK)) CALL XABORT('IDET01: IPTRK not set.')
+      CALL LCMGTC(IPTRK,'TRACK-TYPE',12,CMODUL)
+      CALL LCMGET(IPTRK,'STATE-VECTOR',ISTATE)
+      NREG=ISTATE(1)
+      NUN=ISTATE(2)
+      ITYPE=ISTATE(6)
+      NLF=0
+      ICHX=0
+      IDIM=1
+      IF(ITYPE.EQ.5) THEN
+        IDIM=2
+      ELSE IF(ITYPE.EQ.7) THEN
+        IDIM=3
+      ELSE
+        CALL XABORT('IDET01: Cartesian geometry expected.')
+      ENDIF
+      IELEM=ISTATE(9)
+      L4=ISTATE(11)
+      ICHX=ISTATE(12)
+      NLF=ISTATE(30)
+      NXD=ISTATE(14)
+      NYD=ISTATE(15)
+      NZD=ISTATE(16)
+      LL4F=0
+      LL4X=0
+      LL4Y=0
+      IF(CMODUL.EQ.'TRIVAC') THEN
+         LL4F=ISTATE(25)
+         LL4X=ISTATE(27)
+         LL4Y=ISTATE(28)
+      ENDIF
+      L3D=(NZD.GT.0)
+      IF(.NOT.L3D) CALL XABORT('IDET01: 3D geometry expected.')
+      NZD=MAX(1,NZD)
+      ALLOCATE(MAT(NREG),KFLX(NREG))
+      CALL LCMGET(IPTRK,'MATCOD',MAT)
+      CALL LCMGET(IPTRK,'KEYFLX',KFLX)
+      ALLOCATE(MXD(NXD+1),MYD(NYD+1),MZD(NZD+1))
+      ALLOCATE(XX(NREG),YY(NREG),ZZ(NREG))
+      CALL LCMGET(IPTRK,'XX',XX)
+      CALL LCMGET(IPTRK,'YY',YY)
+      CALL LCMGET(IPTRK,'ZZ',ZZ)
+*----
+*  RECOVER FINITE-ELEMENT FLUX INFORMATION
+*----
+      IF(.NOT.C_ASSOCIATED(IPFLU)) CALL XABORT('IDET01: IPFLU not set.')
+      CALL LCMGET(IPFLU,'STATE-VECTOR',ISTATE)
+      NG=ISTATE(1)
+*----
+*  RECOVER RENUMBERED MIXTURE INDICES FROM FUELMAP
+*----
+      IF(C_ASSOCIATED(IPMAP)) THEN
+        CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+        IF(ISTATE(4).NE.NG) CALL XABORT('IDET01: invalid group nb(1).')
+        CALL LCMSIX(IPMAP,'GEOMAP',1)
+          CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+          NEL=NXD*NYD*NZD
+          IF(ISTATE(3).NE.NXD) CALL XABORT('IDET01: invalid NXD.')
+          IF(ISTATE(4).NE.NYD) CALL XABORT('IDET01: invalid NYD.')
+          IF(ISTATE(5).NE.NZD) CALL XABORT('IDET01: invalid NZD.')
+          IF(ISTATE(6).NE.NEL) CALL XABORT('IDET01: invalid NEL.')
+          IF(NREG.NE.NEL) CALL XABORT('IDET01: invalid NREG.')
+        CALL LCMSIX(IPMAP,' ',2)
+        CALL LCMGET(IPMAP,'BMIX',MAT)
+      ENDIF
+*----
+*  RECOVER MICROLIB INFORMATION
+*----
+      IF(.NOT.C_ASSOCIATED(IPLIB)) CALL XABORT('IDET01: IPLIB not set.')
+      CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+      MAXMIX=ISTATE(1)
+      NBISO=ISTATE(2)
+      IF(ISTATE(3).NE.NG) CALL XABORT('IDET01: invalid group nb(2).')
+      NMIX=ISTATE(14)
+      ALLOCATE(IMIX(NBISO),HNAMIS(NBISO),IPISO(NBISO),GAR(NG))
+      CALL LCMGET(IPLIB,'ISOTOPESMIX',IMIX)
+      CALL LCMGTC(IPLIB,'ISOTOPESUSED',12,NBISO,HNAMIS)
+      DO ISO=1,NBISO
+        IF(HNAMIS(ISO).EQ.DETNAM) GO TO 10
+      ENDDO
+      DO ISO=1,NBISO
+        WRITE(6,'(5X,3H-->,A12)') HNAMIS(ISO)
+      ENDDO
+      WRITE(HSMG,'(48HIDET01: NO DETECTOR ISOTOPE FOUND IN MICROLIB WI,
+     > 8HTH NAME=,A12)') DETNAM
+      CALL XABORT(HSMG)
+   10 CALL LIBIPS(IPLIB,NBISO,IPISO)
+      JPLIB=LCMGID(IPLIB,'ISOTOPESLIST')
+*----
+*  COMPUTE MESH FROM L_TRACK
+*----
+      ALLOCATE(XXX(NXD),YYY(NYD))
+      XXX(:NXD)=0.0
+      YYY(:NYD)=0.0
+      IREG=0
+      IF(L3D) THEN
+        ALLOCATE(ZZZ(NZD))
+        ZZZ(:NZD)=0.0
+        DO K=1,NZD
+          DO J=1,NYD
+            DO I=1,NXD
+              IREG=IREG+1
+              IF(XX(IREG).NE.0.0) THEN
+                IF(XXX(I).EQ.0.0) THEN
+                  XXX(I)=XX(IREG)
+                ELSE IF(ABS(XXX(I)-XX(IREG)).GT.1.0E-6) THEN
+                  CALL XABORT('IDET01: inconsistent tracking in X')
+                ENDIF
+              ENDIF
+              IF(YY(IREG).NE.0.0) THEN
+                IF(YYY(J).EQ.0.0) THEN
+                  YYY(J)=YY(IREG)
+                ELSE IF(ABS(YYY(J)-YY(IREG)).GT.1.0E-6) THEN
+                  CALL XABORT('IDET01: inconsistent tracking in Y')
+                ENDIF
+              ENDIF
+              IF(ZZ(IREG).NE.0.0) THEN
+                IF(ZZZ(K).EQ.0.0) THEN
+                  ZZZ(K)=ZZ(IREG)
+                ELSE IF(ABS(ZZZ(K)-ZZ(IREG)).GT.1.0E-6) THEN
+                  CALL XABORT('IDET01: inconsistent tracking in Z')
+                ENDIF
+              ENDIF
+            ENDDO
+          ENDDO
+        ENDDO
+      ELSE
+        DO J=1,NYD
+          DO I=1,NXD
+            IREG=IREG+1
+            IF(XX(IREG).NE.0.0) THEN
+              IF(XXX(I).EQ.0.0) THEN
+                XXX(I)=XX(IREG)
+              ELSE IF(ABS(XXX(I)-XX(IREG)).GT.1.0E-6) THEN
+                CALL XABORT('IDET01: inconsistent tracking in X')
+              ENDIF
+            ENDIF
+            IF(YY(IREG).NE.0.0) THEN
+              IF(YYY(J).EQ.0.0) THEN
+                YYY(J)=YY(IREG)
+              ELSE IF(ABS(YYY(J)-YY(IREG)).GT.1.0E-6) THEN
+                CALL XABORT('IDET01: inconsistent tracking in Y')
+              ENDIF
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDIF
+      IF(IREG.NE.NREG) CALL XABORT('IDET01: invalid tracking')
+      MXD(1)=0.0
+      MYD(1)=0.0
+      MZD(1)=0.0
+      DO I=1,NXD
+        MXD(I+1)=MXD(I)+XXX(I)
+      ENDDO
+      MYD(1)=0.0
+      DO I=1,NYD
+        MYD(I+1)=MYD(I)+YYY(I)
+      ENDDO
+      MZD(1)=0.0
+      IF(L3D) THEN
+        DO I=1,NZD
+          MZD(I+1)=MZD(I)+ZZZ(I)
+        ENDDO
+        DEALLOCATE(ZZZ)
+      ELSE
+        MZD(2)=0.0
+      ENDIF
+      DEALLOCATE(YYY,XXX)
+*----
+*  PERFORM FLUX INTERPOLATION OVER DETECTOR LOCATIONS
+*----
+      IF(IMPX.GT.1) THEN
+        WRITE(6,'(/29H IDET01: DETECTOR INFORMATION)')
+        WRITE(6,'(5X,12HENERGY GROUP,1X,8HDETECTOR,2X,7HMIXTURE,5X,
+     1  13HDETECTOR FLUX,3X,11HDONJON FLUX,5X,9HFLUX RATO,7X,
+     2  11HDRAGON FLUX,5X,10HFISSION XS)')
+      ENDIF
+      ALLOCATE(FLXD(NUN))
+      JPFLU=LCMGID(IPFLU,'FLUX')
+      DO I=1,NDETC
+        ININX=NINX(I)
+        ININY=NINY(I)
+        ININZ=NINZ(I)
+        ALLOCATE(TFLUX(ININX,ININY,ININZ,NG))
+        DO IG=1,NG
+          CALL LCMGDL(JPFLU,IG,FLXD)
+          IF(ICHX.EQ.1) THEN
+*           Variational collocation method
+            CALL LCMLEN(IPTRK,'KN',MAXKN,ITYLCM)
+            MKN=MAXKN/(NXD*NYD*NZD)
+            ALLOCATE(KN(MAXKN))
+            CALL LCMGET(IPTRK,'KN',KN)
+            CALL LCMSIX(IPTRK,'BIVCOL',1)
+            CALL LCMLEN(IPTRK,'T',LC,ITYLCM)
+            CALL LCMGET(IPTRK,'E',E)
+            CALL LCMSIX(IPTRK,' ',2)
+            CALL VALUE2(LC,MKN,NXD,NYD,NZD,L4,COORD1(1,I),COORD2(1,I),
+     1      COORD3(1,I),MXD,MYD,MZD,FLXD,MAT,KN,ININX,ININY,ININZ,E,
+     2      TFLUX(1,1,1,IG))
+            DEALLOCATE(KN)
+          ELSE IF(ICHX.EQ.2) THEN
+*           Raviart-Thomas finite element method
+            CALL VALUE4(IELEM,NUN,NXD,NYD,NZD,COORD1(1,I),COORD2(1,I),
+     1      COORD3(1,I),MXD,MYD,MZD,FLXD,MAT,KFLX,ININX,ININY,ININZ,
+     2      TFLUX(1,1,1,IG))
+          ELSE IF(ICHX.EQ.3) THEN
+*           Nodal collocation method (MCFD)
+            CALL VALUE1(IDIM,NXD,NYD,NZD,L4,COORD1(1,I),COORD2(1,I),
+     1      COORD3(1,I),MXD,MYD,MZD,FLXD,MAT,IELEM,ININX,ININY,ININZ,
+     2      TFLUX(1,1,1,IG))
+          ELSE IF(ICHX.EQ.6) THEN
+*           Analytic nodal method (ANM)
+            IF(IMPX.GT.0) WRITE(6,100) ICORN
+            IPMAC=LCMGID(IPLIB,'MACROLIB')
+            JPMAC=LCMGID(IPMAC,'GROUP')
+            CALL LCMLEN(IPTRK,'KN',MAXKN,ITYLCM)
+            ALLOCATE(KN(MAXKN))
+            CALL LCMGET(IPTRK,'KN',KN)
+            KPMAC=LCMGIL(JPMAC,IG)
+            CALL VALU5(KPMAC,NXD,NYD,NZD,LL4F,LL4X,LL4Y,NUN,NMIX,
+     1      COORD1(1,I),COORD2(1,I),COORD3(1,I),MXD,MYD,MZD,FLXD,MAT,
+     2      KFLX,KN,ININX,ININY,ININZ,ICORN,TFLUX(1,1,1,IG))
+            DEALLOCATE(KN)
+          ELSE
+            CALL XABORT('IDET01: interpolation not implemented.')
+          ENDIF
+        ENDDO
+*----
+*  RECOVER AVERAGED FLUX FROM FINITE-ELEMENT CALCULATION
+*----
+        ALLOCATE(AFLUX(ININX,ININY,ININZ,NG),MIXT(ININX,ININY,ININZ))
+        DO INX=1,ININX
+          NX=0
+          DO IX=1,NXD
+            IF(COORD1(INX,I).LE.MXD(IX)) EXIT
+            NX=NX+1
+          ENDDO
+          DO INY=1,ININY
+            NY=0
+            DO IY=1,NYD
+              IF(COORD2(INY,I).LE.MXD(IY)) EXIT
+              NY=NY+1
+            ENDDO
+            DO INZ=1,ININZ
+              NZ=0
+              DO IZ=1,NZD
+                IF(COORD3(INZ,I).LE.MZD(IZ)) EXIT
+                NZ=NZ+1
+              ENDDO
+              IF(NX*NY*NZ.EQ.0) THEN
+                WRITE(HSMG,'(38HIDET01: element not found for detector,
+     1          I5,7h(1). x=,1p,e12.4,3H y=,e12.4,3H z=,e12.4)') I,
+     2          COORD1(INX,I),COORD2(INY,I),COORD3(INZ,I)
+                CALL XABORT(HSMG)
+              ENDIF
+              IEL=(NZ-1)*NXD*NYD+(NY-1)*NXD+NX
+              IF(MAT(IEL).EQ.0) THEN
+                WRITE(HSMG,'(38HIDET01: element not found for detector,
+     1          I5,7h(1). x=,1p,e12.4,3H y=,e12.4,3H z=,e12.4)') I,
+     2          COORD1(INX,I),COORD2(INY,I),COORD3(INZ,I)
+                CALL XABORT(HSMG)
+              ENDIF
+              MIXT(INX,INY,INZ)=MAT(IEL)
+              IUN=KFLX(IEL)
+              IF(IUN.EQ.0) CALL XABORT('IDET01: flux not defined.')
+              DO IG=1,NG
+                CALL LCMGDL(JPFLU,IG,FLXD)
+                AFLUX(INX,INY,INZ,IG)=FLXD(IUN)
+              ENDDO
+            ENDDO
+          ENDDO
+        ENDDO
+*----
+*  RECOVER FLUX AND FISSION CROSS SECTION FROM MICROLIB
+*----
+        ALLOCATE(DFLUX(ININX,ININY,ININZ,NG),SIGF(ININX,ININY,ININZ,NG))
+        DO INX=1,ININX
+          DO INY=1,ININY
+            DO INZ=1,ININZ
+              IBM=MIXT(INX,INY,INZ)
+              DFLUX(INX,INY,INZ,:NG)=0.0
+              SIGF(INX,INY,INZ,:NG)=0.0
+              DO ISO=1,NBISO
+                IF((HNAMIS(ISO).EQ.DETNAM).AND.(IMIX(ISO).EQ.IBM)) THEN
+                  KPLIB=IPISO(ISO) ! set ISO-th isotope
+                  CALL LCMLEN(KPLIB,REANAM,LENGT,ITYLCM)
+                  IF(LENGT.NE.NG) THEN
+                    CALL LCMLIB(KPLIB)
+                    WRITE(HSMG,'(23HIDET01: unable to find ,A,6H for i,
+     >              7Hsotope ,A,11H in mixture,I6)') REANAM,DETNAM,IBM
+                    CALL XABORT(HSMG)
+                  ENDIF
+                  CALL LCMGET(KPLIB,'NWT0',GAR)
+                  DFLUX(INX,INY,INZ,:NG)=GAR(:NG)
+                  CALL LCMGET(KPLIB,REANAM,GAR)
+                  SIGF(INX,INY,INZ,:NG)=GAR(:NG)
+                ENDIF
+              ENDDO
+            ENDDO
+          ENDDO
+        ENDDO
+*----
+*  PRINT DETECTOR-DEPENDENT VALUES
+*----
+        IF(IMPX.GT.1) THEN
+          DO IG=1,NG
+            DO INZ=1,ININZ
+              DO INY=1,ININY
+                DO INX=1,ININX
+                  IBM=MIXT(INX,INY,INZ)
+                  TFLUX_I=TFLUX(INX,INY,INZ,IG)
+                  AFLUX_I=AFLUX(INX,INY,INZ,IG)
+                  DFLUX_I=DFLUX(INX,INY,INZ,IG)
+                  SIGF_I=SIGF(INX,INY,INZ,IG)
+                  WRITE(6,'(8X,3I9,1P,5E16.5)') IG,I,IBM,TFLUX_I,
+     >            AFLUX_I,TFLUX_I/AFLUX_I,DFLUX_I,SIGF_I
+                ENDDO
+              ENDDO
+            ENDDO
+          ENDDO
+        ENDIF
+*----
+*  COMPUTE DETECTOR RESPONSE
+*----
+        ALLOCATE(TERPX(ININX),TERPY(ININY),TERPZ(ININZ))
+        IF(ININX.EQ.1) THEN
+          TERPX(1)=1.0
+        ELSE
+          CALL ALTERI(.TRUE.,ININX,COORD1(1,I),COORD1(1,I),
+     >    COORD1(ININX,I),TERPX)
+        ENDIF
+        IF(ININY.EQ.1) THEN
+          TERPY(1)=1.0
+        ELSE
+          CALL ALTERI(.TRUE.,ININY,COORD2(1,I),COORD2(1,I),
+     >    COORD2(ININY,I),TERPY)
+        ENDIF
+        IF(ININZ.EQ.1) THEN
+          TERPZ(1)=1.0
+        ELSE
+          CALL ALTERI(.TRUE.,ININZ,COORD3(1,I),COORD3(1,I),
+     >    COORD3(ININZ,I),TERPZ)
+        ENDIF
+*       integrate along axial direction
+        DETECT(I)=0.0
+        DO IG=1,NG
+          ZNUM=0.0
+          ZDEN=0.0
+          DO INX=1,ININX
+            DO INY=1,ININY
+              DO INZ=1,ININZ
+                TRP=TERPX(INX)*TERPY(INY)*TERPZ(INZ)
+                ZNUM=ZNUM+TRP*TFLUX(INX,INY,INZ,IG)*SIGF(INX,INY,INZ,IG)
+                ZDEN=ZDEN+TRP
+              ENDDO
+            ENDDO
+          ENDDO
+          DETECT(I)=DETECT(I)+ZNUM/ZDEN
+        ENDDO
+        DEALLOCATE(TERPZ,TERPY,TERPX)
+        DEALLOCATE(SIGF,DFLUX,MIXT,AFLUX,TFLUX)
+      ENDDO
+*----
+*  RELEASE MEMORY
+*----
+      DEALLOCATE(FLXD)
+      DEALLOCATE(GAR,IPISO,HNAMIS,IMIX)
+      DEALLOCATE(XX,YY,ZZ,KFLX,MAT)
+      RETURN
+  100 FORMAT(/46H IDET01: CORNER FLUX CORRECTION (0/1: OFF/ON)=,I3)
+      END
diff --git a/Donjon/src/LNSR.f b/Donjon/src/LNSR.f
new file mode 100644
index 0000000..a72ddc4
--- /dev/null
+++ b/Donjon/src/LNSR.f
@@ -0,0 +1,523 @@
+*DECK LNSR
+      SUBROUTINE LNSR(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* single iteration for the line optimization of the objective function.
+*
+*Copyright:
+* Copyright (C) 2019 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The calling specifications are:
+* OPTIM := LNSR: OPTIM :: (lnsr\_data) ;
+* where
+*   OPTIM : name of the \emph{optimize} object (L\_OPTIMIZE signature) 
+*     containing the optimization informations. Object OPTIM must appear on 
+*     both LHS and RHS to be able to update the previous values.
+*   (lnsr\_data) : structure containing the data to the module LNSR.
+*
+*Reference:
+*  L. Armijo, "Minimization of functions having Lipschitz continuous
+*  first partial derivatives," Pacific journal of mathematics, Vol. 16,
+*  No. 1, 1-3, 1966.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER (NSTATE=40,MAXINT=30)
+      TYPE(C_PTR) IPGRAD
+      CHARACTER TEXT12*12,HSIGN*12
+      INTEGER ISTATE(NSTATE),CNVTST,DNVTST,hist_nr
+      DOUBLE PRECISION OPTPRR(NSTATE)
+      REAL FLOTT
+      DOUBLE PRECISION DFLOTT,SR,DSAVE(3)
+      PARAMETER(XI=0.5D0,WIDTH=0.5D0) ! Armijo parameters
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: XP,GP,V,Y,YGG,GGY,
+     1 FF,UD,GAMMA
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: X,P,G,XMIN,XMAX
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: AA,GG,DFF,TDFF,
+     1 SS,YY
+*----
+*  PARAMETER VALIDATION.
+*----
+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('LNSR: LCM'
+     1 //' OBJECT EXPECTED AT LHS.')
+      IF(JENTRY(1).NE.1) CALL XABORT('LNSR: OBJECT IN MODIFICATION MOD'
+     1  //'E EXPECTED.')
+      IPGRAD=KENTRY(1)
+      CALL LCMGTC(IPGRAD,'SIGNATURE',12,HSIGN)
+      IF(HSIGN.NE.'L_OPTIMIZE') THEN
+         TEXT12=HENTRY(1)
+         CALL XABORT('LNSR: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     1   '. L_OPTIMIZE EXPECTED.')
+      ENDIF
+      CNVTST=-1
+      ICONV =0
+      DNVTST=-1
+*----
+*  READ INPUT PARAMETERS
+*----
+      CALL LCMGET(IPGRAD,'STATE-VECTOR',ISTATE)
+      IF((ISTATE(2).NE.0).AND.(ISTATE(8).NE.4)) THEN
+        CALL XABORT('LNSR: CONSTRAINTS NOT IMPLEMENTED.')
+      ENDIF
+      NVAR  =ISTATE(1)
+      NFUNC =ISTATE(2)+1
+      IOPT  =ISTATE(3)
+      ICONV =ISTATE(4)
+      IF((IOPT.NE.1).AND.(IOPT.NE.-1)) CALL XABORT('LNSR: IOPT not equ'
+     1  //'al to 1 or -1')
+      IEXT  =ISTATE(5)
+      IF(IEXT.EQ.0) IEXT=1
+      IEDSTP=ISTATE(6)
+      IHESS =ISTATE(7)
+      IMETH =ISTATE(8)
+      ISTEP =ISTATE(10)
+      JCONV =ISTATE(11)
+      MAXEXT=ISTATE(12)
+      NSTART=ISTATE(13)
+      CALL LCMGET(IPGRAD,'OPT-PARAM-R',OPTPRR)
+      SR=OPTPRR(1)
+      EPS1=OPTPRR(2)
+      EPS2=OPTPRR(3)
+      EPS3=OPTPRR(4)
+      IPICK=0
+      hist_nr=10
+      IPRINT=1
+   10 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+      IF(INDIC.EQ.10) GO TO 20
+      IF(INDIC.NE.3) CALL XABORT('LNSR: CHARACTER DATA EXPECTED(1).')
+   15 IF(TEXT12.EQ.'EDIT') THEN
+        CALL REDGET(INDIC,IPRINT,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1) CALL XABORT('LNSR: INTEGER DATA EXPECTED(1).')
+      ELSE IF(TEXT12.EQ.'MINIMIZE') THEN
+        IOPT=1
+      ELSE IF(TEXT12.EQ.'MAXIMIZE') THEN
+        IOPT=-1
+      ELSE IF(TEXT12.EQ.'OUT-STEP-LIM') THEN
+*       Set maximum step for line optimization.
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.EQ.2) THEN
+          SR=FLOTT
+        ELSE IF(INDIC.EQ.4) THEN
+          SR=DFLOTT
+        ELSE
+          CALL XABORT('LNSR: REAL OR DOUBLE PRECISION VALUE EXPECTED.')
+        ENDIF
+      ELSE IF(TEXT12.EQ.'INN-STEP-EPS') THEN
+*       Set the tolerence used for line optimization.
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.EQ.2) THEN
+          EPS3=FLOTT
+        ELSE IF(INDIC.EQ.4) THEN
+          EPS3=DFLOTT
+        ELSE
+          CALL XABORT('LNSR: REAL OR DOUBLE PRECISION VALUE EXPECTED.')
+        ENDIF
+      ELSE IF(TEXT12.EQ.'OUT-STEP-EPS') THEN
+*       Set the tolerence used for external iterations.
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.EQ.2) THEN
+          EPS2=FLOTT
+        ELSE IF(INDIC.EQ.4) THEN
+          EPS2=DFLOTT
+        ELSE
+          CALL XABORT('LNSR: REAL OR DOUBLE PRECISION VALUE EXPECTED.')
+        ENDIF
+      ELSE IF(TEXT12.EQ.'OUT-ITER-MAX') THEN
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1) CALL XABORT('LNSR: INTEGER DATA EXPECTED(2).')
+        IF(MAXEXT.EQ.0) MAXEXT=NITMA
+      ELSE IF(TEXT12.EQ.'OUT-RESTART') THEN
+        CALL REDGET(INDIC,NSTART,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1) CALL XABORT('LNSR: INTEGER DATA EXPECTED(3).')
+      ELSE IF(TEXT12.EQ.'SD') THEN
+        IHESS=0
+      ELSE IF(TEXT12.EQ.'CG') THEN
+        IHESS=1
+      ELSE IF(TEXT12.EQ.'BFGS') THEN
+        IHESS=2
+      ELSE IF(TEXT12.EQ.'LBFGS') THEN
+        IHESS=3
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.EQ.1) THEN
+*         hist_nr: number of corrections stored in LBFGS method
+          hist_nr=NITMA
+        ELSE IF(INDIC.EQ.3) THEN
+          GO TO 15
+        ELSE
+          CALL XABORT('LNSR: INTEGER OR CHARACTER VALUE EXPECTED.')
+        ENDIF
+      ELSE IF(TEXT12.EQ.'NEWT') THEN
+        IHESS=4
+      ELSE IF(TEXT12.EQ.'INN-CONV-TST') THEN
+*       Internal convergence test
+        IPICK=1
+        GO TO 20
+      ELSE IF(TEXT12(:1).EQ.';') THEN
+        GO TO 20
+      ELSE 
+        CALL XABORT('LNSR: '//TEXT12//' IS AN INVALID KEYWORD.')
+      ENDIF
+      GO TO 10
+*----
+*  RECOVER INFORMATION FROM OPTIM OBJECT
+*----
+   20 ISTEP=ISTEP+1
+      ALLOCATE(X(NVAR),P(NVAR),G(NVAR),XMIN(NVAR),XMAX(NVAR))
+      IF(IMETH.EQ.4) THEN
+        ALLOCATE(FF(NFUNC))
+        CALL LCMGET(IPGRAD,'FOBJ-CST-VAL',FF)
+        F=DOT_PRODUCT(FF(:NFUNC),FF(:NFUNC))
+        DEALLOCATE(FF)
+      ELSE
+        CALL LCMGET(IPGRAD,'FOBJ-CST-VAL',F)
+        CALL LCMGET(IPGRAD,'GRADIENT',G)
+      ENDIF
+      CALL LCMGET(IPGRAD,'VAR-VALUE',X)
+      CALL LCMGET(IPGRAD,'VAR-VAL-MIN',XMIN)
+      CALL LCMGET(IPGRAD,'VAR-VAL-MAX',XMAX)
+      CALL LCMLEN(IPGRAD,'LNSR-INFO',ILONG,ITYLCM)
+      IF(ILONG.NE.0) THEN
+        CALL LCMGET(IPGRAD,'LNSR-INFO',DSAVE)
+        SLOPE=DSAVE(1)
+        ALAM=DSAVE(2)
+        GNORM=DSAVE(3)
+      ELSE
+        SLOPE=0.0D0
+        ALAM=0.0D0
+        GNORM=0.0D0
+      ENDIF
+*----
+*  SET THE DIRECTION AND INITIALIZATION OF THE LINE SEARCH
+*----
+      IF(ISTEP.EQ.1) THEN
+        IF(IPRINT.GT.0) WRITE(6,100) IEXT,F
+        IF(IHESS.EQ.0) THEN
+*         Steepest descent
+          P(:NVAR)=-G(:NVAR)
+        ELSE IF(IHESS.EQ.1) THEN
+          IF(IEXT.EQ.1) THEN
+*           Steepest descent
+            P(:NVAR)=-G(:NVAR)
+            GNORM=DOT_PRODUCT(G(:NVAR),G(:NVAR))/REAL(NVAR)
+          ELSE
+*           Conjugate gradient
+            GNORMP=GNORM
+            CALL LCMGET(IPGRAD,'DIRECTION',P)
+            GNORM=DOT_PRODUCT(G(:NVAR),G(:NVAR))/REAL(NVAR)
+            P(:NVAR)=-G(:NVAR)+(GNORM/GNORMP)*P(:NVAR)
+          ENDIF
+        ELSE IF(IHESS.EQ.2) THEN
+*         BFGS
+          IF(IEXT.EQ.1) THEN
+            ALLOCATE(GG(NVAR,NVAR))
+            GG(:NVAR,:NVAR)=0.0D0
+            DO I=1,NVAR
+              GG(I,I)=1.0D0
+            ENDDO
+*           Steepest descent
+            P(:NVAR)=-G(:NVAR)
+          ELSE
+            ALLOCATE(V(NVAR),Y(NVAR),XP(NVAR),GP(NVAR))
+            CALL LCMSIX(IPGRAD,'OLD-VALUE',1)
+              CALL LCMGET(IPGRAD,'VAR-VALUE',XP)
+              CALL LCMGET(IPGRAD,'GRADIENT',GP)
+            CALL LCMSIX(IPGRAD,' ',2)
+            V(:NVAR)=X(:NVAR)-XP(:NVAR)
+            Y(:NVAR)=G(:NVAR)-GP(:NVAR)
+            SVY=DOT_PRODUCT(V(:NVAR),Y(:NVAR))
+            IF(SVY.EQ.0.0D0) CALL XABORT('LNSR: DIVIDE CHECK IN BFGS.')
+            DEALLOCATE(GP,XP)
+            ALLOCATE(GG(NVAR,NVAR),GGY(NVAR),YGG(NVAR),AA(NVAR,NVAR))
+            CALL LCMGET(IPGRAD,'HESSIAN',GG)
+            SVYI=1.0D0/SVY
+            DO I=1,NVAR
+              TMP1=0.0D0
+              TMP2=0.0D0
+              DO J=1,NVAR
+                AA(J,I)=V(J)*V(I)*SVYI
+                TMP1=TMP1+GG(I,J)*Y(J)
+                TMP2=TMP2+Y(J)*GG(J,I)
+              ENDDO
+              GGY(I)=TMP1
+              YGG(I)=TMP2
+            ENDDO
+            B=1.0D0
+            DO I=1,NVAR
+              B=B+Y(I)*GGY(I)*SVYI
+            ENDDO
+            AA(:NVAR,:NVAR)=AA(:NVAR,:NVAR)*B
+            DO J=1,NVAR
+              DO I=1,NVAR
+                AA(I,J)=AA(I,J)-(V(I)*YGG(J)+GGY(I)*V(J))*SVYI
+              ENDDO
+            ENDDO
+            GG(:NVAR,:NVAR)=GG(:NVAR,:NVAR)+AA(:NVAR,:NVAR)
+            P(:NVAR)= 0.0D0
+            DO I=1,NVAR
+              P(:NVAR)=P(:NVAR)-GG(:NVAR,I)*G(I)
+            ENDDO
+            DEALLOCATE(AA,YGG,GGY,Y,V)
+          ENDIF
+          CALL LCMPUT(IPGRAD,'HESSIAN',NVAR*NVAR,4,GG)
+          DEALLOCATE(GG)
+        ELSE IF(IHESS.EQ.3) THEN
+*         Limited memory BFGS
+          ALLOCATE(SS(NVAR,hist_nr),YY(NVAR,hist_nr))
+          P(:NVAR)=G(:NVAR)
+          IF(IEXT.EQ.1) THEN
+            SS(:NVAR,:hist_nr)=0.0D0
+            YY(:NVAR,:hist_nr)=0.0D0
+          ELSE
+*           quasi-Newton search
+            ALLOCATE(GAMMA(hist_nr),XP(NVAR),GP(NVAR))
+            CALL LCMGET(IPGRAD,'LBFGS-S',SS)
+            CALL LCMGET(IPGRAD,'LBFGS-Y',YY)
+            CALL LCMSIX(IPGRAD,'OLD-VALUE',1)
+              CALL LCMGET(IPGRAD,'VAR-VALUE',XP)
+              CALL LCMGET(IPGRAD,'GRADIENT',GP)
+            CALL LCMSIX(IPGRAD,' ',2)
+            J=MOD(IEXT-1,hist_nr)+1
+            SS(:NVAR,J)=X(:NVAR)-XP(:NVAR)
+            YY(:NVAR,J)=G(:NVAR)-GP(:NVAR)
+            SVY=DOT_PRODUCT(SS(:NVAR,J),YY(:NVAR,J))
+            IF(SVY.EQ.0.0D0) CALL XABORT('LNSR: DIVIDE CHECK IN LBFGS.')
+            DEALLOCATE(GP,XP)
+            IBOUND=MIN(IEXT-1,hist_nr)
+            DO IB=IBOUND,1,-1
+              J=MOD(IEXT+IB-IBOUND-1,hist_nr)+1
+              TAU=DOT_PRODUCT(SS(:NVAR,J),YY(:NVAR,J))
+              GAMMA(IB)=DOT_PRODUCT(SS(:NVAR,J),P(:NVAR))/TAU
+              P(:NVAR)=P(:NVAR)-GAMMA(IB)*YY(:NVAR,J)
+            ENDDO
+            DO IB=1,IBOUND
+              J=MOD(IEXT+IB-IBOUND-1,hist_nr)+1
+              TAU=DOT_PRODUCT(SS(:NVAR,J),YY(:NVAR,J))
+              BETA=DOT_PRODUCT(YY(:NVAR,J),P(:NVAR))/TAU
+              P(:NVAR)=P(:NVAR)+(GAMMA(IB)-BETA)*SS(:NVAR,J)
+            ENDDO
+            DEALLOCATE(GAMMA)
+          ENDIF
+          CALL LCMPUT(IPGRAD,'LBFGS-S',NVAR*hist_nr,4,SS)
+          CALL LCMPUT(IPGRAD,'LBFGS-Y',NVAR*hist_nr,4,YY)
+          DEALLOCATE(YY,SS)
+          P(:NVAR)=-P(:NVAR)
+        ELSE IF(IHESS.EQ.4) THEN
+*         Newton method for unconstrained optimization
+          ALLOCATE(FF(NFUNC),DFF(NVAR,NFUNC),TDFF(NFUNC,NVAR),
+     1    UD(NVAR))
+          CALL LCMGET(IPGRAD,'FOBJ-CST-VAL',FF)
+          CALL LCMGET(IPGRAD,'GRADIENT',DFF)
+          G(:NVAR)=2.0D0*MATMUL(DFF,FF)
+          TDFF=TRANSPOSE(DFF)
+          CALL ALST2F(NFUNC,NFUNC,NVAR,TDFF,UD)
+          CALL ALST2S(NFUNC,NFUNC,NVAR,TDFF,UD,FF,P)
+          P(:NVAR)=-P(:NVAR)
+          DEALLOCATE(UD,TDFF,DFF,FF)
+        ENDIF
+        GNORM=DOT_PRODUCT(G(:NVAR),G(:NVAR))/REAL(NVAR)
+        PABS=SQRT(DOT_PRODUCT(P(:NVAR),P(:NVAR)))
+        P(:NVAR)=P(:NVAR)*SR/PABS ! stepsize normalization
+        SLOPE=DOT_PRODUCT(G(:NVAR),P(:NVAR))
+        ALAM=1.0D0
+        IF(IOPT.EQ.-1) F=-F
+        FOLD=F
+        CALL LCMPUT(IPGRAD,'DIRECTION',NVAR,4,P)
+        CALL LCMSIX(IPGRAD,'OLD-VALUE',1)
+          CALL LCMPUT(IPGRAD,'VAR-VALUE',NVAR,4,X)
+          CALL LCMPUT(IPGRAD,'FOBJ-CST-VAL',1,4,FOLD)
+        CALL LCMSIX(IPGRAD,' ',2)
+        GO TO 30
+      ELSE
+*       recover values at beginning of line search
+        CALL LCMGET(IPGRAD,'DIRECTION',P)
+        CALL LCMSIX(IPGRAD,'OLD-VALUE',1)
+          CALL LCMGET(IPGRAD,'VAR-VALUE',X)
+          CALL LCMGET(IPGRAD,'FOBJ-CST-VAL',FOLD)
+          IF(IOPT.EQ.-1) FOLD=-FOLD
+        CALL LCMSIX(IPGRAD,' ',2)
+      ENDIF
+*----
+*  SINGLE INNER ITERATION OF THE LINE OPTIMIZATION
+*----
+      IF(IOPT.EQ.-1) F=-F
+      IF(F.LE.FOLD+XI*ALAM*SLOPE) THEN
+*       Armijo condition
+        JCONV =1
+        GO TO 40
+      ELSE IF(ISTEP.GT.MAXINT) THEN
+        JCONV =2
+        GO TO 40
+      ENDIF
+      ALAM=ALAM*WIDTH
+   30 X(:NVAR)=X(:NVAR)+ALAM*P(:NVAR)
+      DO I=1,NVAR
+        X(I)=MAX(XMIN(I),MIN(XMAX(I),X(I)))
+      ENDDO
+      CALL LCMPUT(IPGRAD,'VAR-VALUE',NVAR,4,X)
+   40 DEALLOCATE(XMAX,XMIN,G,P,X)
+      IF(IPRINT.GT.0) WRITE(6,110) IEXT,ISTEP,ALAM,F,JCONV
+      IF(IPRINT.GT.2) THEN
+        ALLOCATE(X(NVAR),P(NVAR))
+        CALL LCMGET(IPGRAD,'DIRECTION',P)
+        CALL LCMGET(IPGRAD,'VAR-VALUE',X)
+        WRITE(6,120) '    LINE SEARCH DIRECTION',(P(I),I=1,NVAR)
+        WRITE(6,120) 'OUTPUT DECISION VARIABLES',(X(I),I=1,NVAR)
+        DEALLOCATE(P,X)
+      ENDIF
+*----
+*  TEST FOR EXTERNAL ITERATION CONVERGENCE
+*----
+      IF(JCONV.GE.1) THEN
+        DNVTST=1
+        TEST2=ABS(F-FOLD)
+        IF(GNORM.LT.0.01*EPS2) THEN
+          IF(IPRINT.GT.0) PRINT *,'>>> OUTER CONVERGED WRT GNORM'
+          CNVTST=1
+          ICONV =1
+        ELSE IF((TEST2.LT.EPS2).AND.(ISTEP.GT.1)) THEN
+          IF(IPRINT.GT.0) PRINT *,'>>> OUTER CONVERGED WRT F-FOLD'
+          CNVTST=1
+          ICONV =1
+        ELSE IF(IEXT.GE.MAXEXT) THEN
+          IF(IPRINT.GT.0) PRINT *,'>>> OUTER REACHES MAXIMUM ITERATION'
+          CNVTST=1
+          ICONV =1
+        ENDIF
+        IF(IPRINT.GT.0) WRITE(6,130) IEXT,ABS(ALAM),GNORM,TEST2,EPS2
+*----
+*  RESTART CG OR BFGS HESSIAN MATRIX CALCULATION
+*----
+        IF((NSTART.NE.0).AND.(IEXT.GE.NSTART)) THEN
+          IEXT=0
+          MAXEXT=MAXEXT-NSTART
+        ENDIF
+*----
+*  SAVE OLD GRADIENT
+*----
+        ALLOCATE(G(NVAR),P(NVAR))
+        CALL LCMGET(IPGRAD,'GRADIENT',G)
+        CALL LCMGET(IPGRAD,'DIRECTION',P)
+        CALL LCMSIX(IPGRAD,'OLD-VALUE',1)
+          CALL LCMPUT(IPGRAD,'GRADIENT',NVAR,4,G)
+        CALL LCMSIX(IPGRAD,' ',2)
+        DEALLOCATE(P,G)
+        IEXT=IEXT+1
+      ENDIF
+*----
+*  SAVE THE STATE VECTORS
+*----
+      ISTATE(:NSTATE)=0
+      ISTATE(1)=NVAR
+      ISTATE(3)=IOPT
+      ISTATE(4)=ICONV
+      ISTATE(5)=IEXT
+      ISTATE(6)=IEDSTP
+      ISTATE(7)=IHESS
+      ISTATE(8)=IMETH
+      ISTATE(10)=ISTEP
+      ISTATE(11)=JCONV
+      ISTATE(12)=MAXEXT
+      ISTATE(13)=NSTART
+      IF(IPRINT.GT.0) WRITE(6,140) (ISTATE(I),I=1,13)
+      CALL LCMPUT(IPGRAD,'STATE-VECTOR',NSTATE,1,ISTATE)
+      OPTPRR(:NSTATE)=0.0D0
+      OPTPRR(1)=SR
+      OPTPRR(2)=EPS1
+      OPTPRR(3)=EPS2
+      OPTPRR(4)=EPS3
+      IF(IPRINT.GT.0) WRITE(6,150) (OPTPRR(I),I=1,4)
+      CALL LCMPUT(IPGRAD,'OPT-PARAM-R',NSTATE,4,OPTPRR)
+      DSAVE(1)=SLOPE
+      DSAVE(2)=ALAM
+      DSAVE(3)=GNORM
+      CALL LCMPUT(IPGRAD,'LNSR-INFO',3,4,DSAVE)
+      IF(IPRINT.GT.2) CALL LCMLIB(IPGRAD)
+*----
+*  RECOVER THE CONVERGENCE FLAGS AND SAVE IT IN A CLE-2000 VARIABLE
+*----
+      IF(IPICK.EQ.1) THEN
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.-5) CALL XABORT('LNSR: OUTPUT LOGICAL EXPECTED.')
+        INDIC=5
+        CALL REDPUT(INDIC,DNVTST,FLOTT,TEXT12,DFLOTT)
+   50   CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3) CALL XABORT('LNSR: CHARACTER DATA EXPECTED(2).')
+        IF(TEXT12.EQ.'OUT-CONV-TST') THEN
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          IF(INDIC.NE.-5) CALL XABORT('LNSR: OUTPUT LOGICAL EXPECTED.')
+          INDIC=5
+          CALL REDPUT(INDIC,CNVTST,FLOTT,TEXT12,DFLOTT)
+          GO TO 50
+        ELSE IF (TEXT12.EQ.';') THEN
+          RETURN
+        ELSE
+          CALL XABORT('LNSR: ; CHARACTER EXPECTED.')
+        ENDIF      
+      ENDIF      
+      RETURN
+*
+  100 FORMAT(/14H LNSR: ##ITER=,I8,20H OBJECTIVE FUNCTION=,1P,E14.6)
+  110 FORMAT(/21H LNSR: EXTERNAL ITER=,I5,18H LINE SEARCH ITER=,I4,
+     1 7H ALPHA=,1P,E17.10,20H OBJECTIVE FUNCTION=,E17.10,6H CONV=,I2)
+  120 FORMAT(/7H LNSR: ,A25,1H=,1P,8E12.4/(33X,8E12.4))
+  130 FORMAT(/26H LNSR: EXTERNAL ITERATION=,I4,12H ACCURACIES=,1P,
+     1 3E12.4,6H EPS2=,E12.4)
+  140 FORMAT(/8H OPTIONS/8H -------/
+     1 7H NVAR  ,I8,32H   (NUMBER OF CONTROL VARIABLES)/
+     2 7H NCST  ,I8,26H   (NUMBER OF CONSTRAINTS)/
+     3 7H IOPT  ,I8,37H   (=1/-1: MINIMIZATION/MAXIMIZATION)/
+     4 7H ICONV ,I8,43H   (=0/1: EXTERNAL NOT CONVERGED/CONVERGED)/
+     5 7H IEXT  ,I8,32H   (INDEX OF EXTERNAL ITERATION)/
+     6 7H IEDSTP,I8,13H   (NOT USED)/
+     7 7H IHESS ,I8,46H   (=0/1/2/3/4: STEEPEST/CG/BFGS/LBFGS/NEWTON)/
+     8 7H ISEARC,I8,35H   (=0/1/2: NO SEARCH/OPTEX/NEWTON)/
+     9 7H IMETH ,I8,13H   (NOT USED)/
+     1 7H ISTEP ,I8,35H   (INDEX OF LINE SEARCH ITERATION)/
+     2 7H JCONV ,I8,48H   (=0/1/2: LINE SEARCH NOT CONVERGED/CONVERGED)/
+     3 7H MAXEXT,I8,42H   (MAXIMUM NUMBER OF EXTERNAL ITERATIONS)/
+     4 7H NSTART,I8,37H   (EXTERNAL ITERATION RESTART CYCLE))
+  150 FORMAT(/
+     1 12H REAL PARAM:,1P/12H -----------/
+     2 7H SR    ,D12.4,33H   (MAXIMUM LINE SEARCH STEPSIZE)/
+     3 7H EPS1  ,D12.4,13H   (NOT USED)/
+     4 7H EPS2  ,D12.4,31H   (EXTERNAL CONVERGENCE LIMIT)/
+     5 7H EPS3  ,D12.4,31H   (INTERNAL CONVERGENCE LIMIT))
+      END
diff --git a/Donjon/src/LZC.f b/Donjon/src/LZC.f
new file mode 100644
index 0000000..2fc9204
--- /dev/null
+++ b/Donjon/src/LZC.f
@@ -0,0 +1,133 @@
+*DECK LZC

+      SUBROUTINE LZC(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Read specification for the liquid zone controllers; add the new data

+* to the existing device object.

+*

+*Copyright:

+* Copyright (C) 2007 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* D. Sekki

+*

+*Parameters: input

+* NENTRY  number of data structures transfered to this module.

+* HENTRY  name of the data structures.

+* IENTRY  data structure type where:

+*         IENTRY=1 for LCM memory object;

+*         IENTRY=2 for XSM file;

+*         IENTRY=3 for sequential binary file;

+*         IENTRY=4 for sequential ASCII file.

+* JENTRY  access permission for the data structure where:

+*         JENTRY=0 for a data structure in creation mode;

+*         JENTRY=1 for a data structure in modifications mode;

+*         JENTRY=2 for a data structure in read-only mode.

+* KENTRY  data structure pointer.

+*

+*Comments:

+* The LZC: module specification is:

+* DEVICE MATEX := LZC: [ DEVICE ] MATEX :: (desclzc) ;

+* where

+*   DEVICE : name of the \emph{device} object.

+* Note, if the rod-type devices are not present in the reactor core, then 

+* DEVICE object must appear only on the LHS (i.e. in create mode), it will 

+* contain the information only with respect to the liquid zone controllers. 

+* However, if the rod-type devices are present in the reactor core, then they 

+* must be specified first (i.e. before the liquid controllers) using the DEVINI:

+* module. In the last case, the DEVICE object must also appear on the RHS 

+* (i.e. in modification mode), it will contain the additional and separate 

+* information with respect to the liquid zone controllers.

+*   MATEX  : name of the \emph{matex} object 

+* that will be updated by the module. The lzc-devices material mixtures are

+* appended to the previous material index and the lzc-devices indices are

+* also modified, accordingly.

+*   (desclzc) : structure describing the input data to the LZC: module.

+*

+*-----------------------------------------------------------------------

+*

+      USE GANLIB

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)

+      TYPE(C_PTR)  KENTRY(NENTRY)

+      CHARACTER    HENTRY(NENTRY)*12

+*----

+*  LOCAL VARIABLES

+*----

+      PARAMETER(NSTATE=40)

+      CHARACTER HSIGN*12,TEXT12*12

+      INTEGER ISTATE(NSTATE)

+      REAL LIMIT(6)

+      LOGICAL LNEW

+      TYPE(C_PTR) IPDEV,IPMTX

+      REAL, ALLOCATABLE, DIMENSION(:) :: XXX,YYY,ZZZ

+*----

+*  PARAMETER VALIDATION

+*----

+      IF(NENTRY.NE.2)CALL XABORT('@LZC: TWO PARAMETERS EXPECTED')

+      TEXT12=HENTRY(1)

+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2))CALL XABORT('@LZ'

+     1 //'C: LCM OBJECT EXPECTED FOR L_DEVICE ('//TEXT12//').')

+      IF(JENTRY(1).EQ.1)THEN

+        CALL LCMGTC(KENTRY(1),'SIGNATURE',12,HSIGN)

+        IF(HSIGN.NE.'L_DEVICE')CALL XABORT('@LZC: MISSING L_DEV'

+     1   //'ICE OBJECT.')

+        LNEW=.FALSE.

+      ELSEIF(JENTRY(1).EQ.0)THEN

+        HSIGN='L_DEVICE'

+        CALL LCMPTC(KENTRY(1),'SIGNATURE',12,HSIGN)

+        LNEW=.TRUE.

+      ELSE

+       CALL XABORT('@LZC: ONLY CREATE OR MODIFICATION MODE EXPEC'

+     1 //'TED FOR L_DEVICE OBJECT.')

+      ENDIF

+      IPDEV=KENTRY(1)

+      IF((IENTRY(2).NE.1).AND.(IENTRY(2).NE.2))CALL XABORT('@LZ'

+     1 //'C: LCM OBJECT EXPECTED FOR L_MATEX.')

+      CALL LCMGTC(KENTRY(2),'SIGNATURE',12,HSIGN)

+      IF(HSIGN.NE.'L_MATEX')CALL XABORT('@LZC: MISSING L_MATEX.')

+      IF(JENTRY(2).NE.1)CALL XABORT('@LZC: MODIFICATION MODE EX'

+     1 //'PECTED FOR L_MATEX.')

+      IPMTX=KENTRY(2)

+*----

+*  RECOVER INFORMATION

+*----

+      ISTATE(:NSTATE)=0

+      CALL LCMGET(IPMTX,'STATE-VECTOR',ISTATE)

+      IGEO=ISTATE(6)

+      IF(IGEO.NE.7)CALL XABORT('@LZC: ONLY'

+     1 //' 3D-CARTESIAN GEOMETRY ALLOWED.')

+      NMIX=ISTATE(2)

+      NTOT=ISTATE(5)

+      LX=ISTATE(8)

+      LY=ISTATE(9)

+      LZ=ISTATE(10)

+*     LIMITS ALONG X-AXIS

+      ALLOCATE(XXX(LX+1))

+      XXX(:LX+1)=0.0

+      CALL LCMGET(IPMTX,'MESHX',XXX)

+      LIMIT(1)=XXX(1)

+      LIMIT(2)=XXX(LX+1)

+      DEALLOCATE(XXX)

+*     LIMITS ALONG Y-AXIS

+      ALLOCATE(YYY(LY+1))

+      YYY(:LY+1)=0.0

+      CALL LCMGET(IPMTX,'MESHY',YYY)

+      LIMIT(3)=YYY(1)

+      LIMIT(4)=YYY(LY+1)

+      DEALLOCATE(YYY)

+*     LIMITS ALONG Z-AXIS

+      ALLOCATE(ZZZ(LZ+1))

+      ZZZ(:LZ+1)=0.0

+      CALL LCMGET(IPMTX,'MESHZ',ZZZ)

+      LIMIT(5)=ZZZ(1)

+      LIMIT(6)=ZZZ(LZ+1)

+      DEALLOCATE(ZZZ)

+*     READ LZC INPUT DATA

+      CALL LZCDRV(IPDEV,IPMTX,IGEO,NMIX,NTOT,LIMIT,LNEW)

+      RETURN

+      END

diff --git a/Donjon/src/LZCDGD.f b/Donjon/src/LZCDGD.f
new file mode 100644
index 0000000..be3f70e
--- /dev/null
+++ b/Donjon/src/LZCDGD.f
@@ -0,0 +1,156 @@
+*DECK LZCDGD

+      SUBROUTINE LZCDGD(IPDEV,NLZC,LGRP,IMPX)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Create the liquid-zone-controllers group directories on the device

+* data structure.

+*

+*Copyright:

+* Copyright (C) 2007 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* D. Sekki

+*

+*Parameters: input

+* IPDEV  pointer to device information.

+* NLZC   total number of liquid zone controllers.

+* LGRP   total number of lzc-groups.

+* IMPX   printing index (=0 for no print).

+*

+*-----------------------------------------------------------------------

+*

+      USE GANLIB

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      TYPE(C_PTR) IPDEV

+      INTEGER NLZC,LGRP,IMPX

+*----

+*  LOCAL VARIABLES

+*----

+      PARAMETER(IOUT=6)

+      CHARACTER TEXT*12

+      INTEGER LZCID(NLZC)

+      DOUBLE PRECISION DFLOT

+      TYPE(C_PTR) JPDEV,KPDEV

+*----

+*  CREATE GROUPS

+*----

+      JPDEV=LCMLID(IPDEV,'LZC_GROUP',LGRP)

+      IGRP=0

+      IF(IMPX.GT.0)WRITE(IOUT,1001)

+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+      IF(ITYP.NE.3)CALL XABORT('@LZCDGD: KEYWORD GROUP-ID EXPECTED.')

+      IF(TEXT.NE.'GROUP-ID')CALL XABORT('@LZCDGD: KEYWORD GROUP-'

+     1 //'ID EXPECTED.')

+   10 IGRP=IGRP+1

+      CALL REDGET(ITYP,JGRP,FLOT,TEXT,DFLOT)

+      IF(ITYP.NE.1)CALL XABORT('@LZCDGD: INTEGER GROUP-ID NUMBER'

+     1 //' EXPECTED.')

+      IF(JGRP.NE.IGRP)THEN

+        WRITE(IOUT,*)'@LZCDGD: READ GROUP-ID NUMBER #',JGRP

+        WRITE(IOUT,*)'@LZCDGD: EXPECTED GROUP-ID NUMBER #',IGRP

+        CALL XABORT('@LZCDGD: WRONG GROUP-ID NUMBER.')

+      ENDIF

+      IF(JGRP.GT.LGRP)THEN

+        WRITE(IOUT,*)'@LZCDGD: GIVEN TOTAL NUMBER OF GROUPS ',LGRP

+        WRITE(IOUT,*)'@LZCDGD: READ GROUP-ID NUMBER #',JGRP

+        CALL XABORT('@LZCDGD: WRONG GROUP-ID NUMBER.')

+      ENDIF

+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+      IF(ITYP.NE.3)CALL XABORT('@LZCDGD: KEYWORD EXPECTED.')

+*----

+*  OPTION ALL

+*----

+      IF(TEXT.EQ.'ALL')THEN

+        KPDEV=LCMDIL(JPDEV,IGRP)

+        DO 30 ID=1,NLZC

+        LZCID(ID)=ID

+   30   CONTINUE

+        CALL LCMPUT(KPDEV,'GROUP-ID',1,1,IGRP)

+        CALL LCMPUT(KPDEV,'NUM-LZC',1,1,NLZC)

+        CALL LCMPUT(KPDEV,'LZC-ID',NLZC,1,LZCID)

+*

+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+        IF(ITYP.NE.3)CALL XABORT('@LZCDGD: WRONG INPUT DATA.')

+        IF(TEXT.EQ.';')THEN

+          IF(IGRP.EQ.LGRP)THEN

+            NDG=NLZC

+            GOTO 100

+          ENDIF

+          WRITE(IOUT,*)'@LZCDGD: GIVEN TOTAL NUMBER OF GROUPS ',LGRP

+          WRITE(IOUT,*)'@LZCDGD: CREATED ONLY NUMBER OF GROUPS ',IGRP

+          CALL XABORT('@LZCDGD: WRONG NUMBER OF GROUPS.')

+        ELSEIF(TEXT.EQ.'GROUP-ID')THEN

+          IF(IMPX.GT.0)WRITE(IOUT,1000)IGRP,NLZC

+          GOTO 10

+        ELSE

+          CALL XABORT('@LZCDGD: WRONG KEYWORD '//TEXT)

+        ENDIF

+*----

+*  OPTION LZC-ID

+*----

+      ELSEIF(TEXT.EQ.'LZC-ID')THEN

+        NDG=0

+        LZCID(:NLZC)=0

+        KPDEV=LCMDIL(JPDEV,IGRP)

+*

+   50   CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+        IF(ITYP.EQ.3)THEN

+          IF(TEXT.EQ.';')THEN

+            IF(IGRP.EQ.LGRP)GOTO 100

+            WRITE(IOUT,*)'@LZCDGD: GIVEN TOTAL NUMBER OF GROUPS ',LGRP

+            WRITE(IOUT,*)'@LZCDGD: CREATED ONLY NUMBER OF GROUPS ',IGRP

+            CALL XABORT('@LZCDGD: WRONG NUMBER OF GROUPS.')

+          ELSEIF(TEXT.EQ.'GROUP-ID')THEN

+            IF(IMPX.GT.0)WRITE(IOUT,1000)IGRP,NDG

+            GOTO 10

+          ELSE

+            CALL XABORT('@LZCDGD: WRONG KEYWORD '//TEXT)

+          ENDIF

+*----

+*  LZC-ID NUMBERS

+*----

+        ELSEIF(ITYP.EQ.1)THEN

+          ID=NITMA

+          IF((ID.GT.NLZC).OR.(ID.LE.0))THEN

+            WRITE(IOUT,*)'@LZCDGD: FOR THE GROUP #',IGRP

+            WRITE(IOUT,*)'@LZCDGD: READ LZC-ID #',ID

+            CALL XABORT('@LZCDGD: WRONG LZC-ID NUMBER.')

+          ENDIF

+          DO I=1,NLZC

+            IF(ID.EQ.LZCID(I))THEN

+              WRITE(IOUT,*)'@LZCDGD: FOR THE GROUP #',IGRP

+              WRITE(IOUT,*)'@LZCDGD: REPEATED LZC-ID #',ID

+              CALL XABORT('@LZCDGD: WRONG LZC-ID NUMBER.')

+            ENDIF

+          ENDDO

+*

+          NDG=NDG+1

+          IF(NDG.GT.NLZC)THEN

+            WRITE(IOUT,*)'@LZCDGD: FOR THE GROUP #',IGRP

+            WRITE(IOUT,*)'@LZCDGD: WRONG TOTAL NUMBER OF LZC ',NDG

+            CALL XABORT('@LZCDGD: INVALID INPUT OF LZC-DEVICES.')

+          ENDIF

+          LZCID(NDG)=ID

+          CALL LCMPUT(KPDEV,'GROUP-ID',1,1,IGRP)

+          CALL LCMPUT(KPDEV,'NUM-LZC',1,1,NDG)

+          CALL LCMPUT(KPDEV,'LZC-ID',NDG,1,LZCID)

+        ELSE

+          CALL XABORT('@LZCDGD: WRONG INPUT DATA.')

+        ENDIF

+        GOTO 50

+      ELSE

+        CALL XABORT('@LZCDGD: WRONG KEYWORD '//TEXT)

+      ENDIF

+  100 IF(IMPX.GT.0)WRITE(IOUT,1000)IGRP,NDG

+      IF(IMPX.GT.0)WRITE(IOUT,1002)LGRP

+      RETURN

+*

+ 1000 FORMAT(/1X,'CREATED A GROUP #',I2.2,

+     1        4X,'INCLUDES TOTAL NUMBER OF LZC:',1X,I2)

+ 1001 FORMAT(/1X,'**  CREATING GROUPS FOR LZC-DEVICES  **')

+ 1002 FORMAT(/1X,39('-')/1X,'TOTAL NUMBER OF GROUPS CREATED:',I2)

+      END

diff --git a/Donjon/src/LZCDRV.f b/Donjon/src/LZCDRV.f
new file mode 100644
index 0000000..4f71429
--- /dev/null
+++ b/Donjon/src/LZCDRV.f
@@ -0,0 +1,161 @@
+*DECK LZCDRV

+      SUBROUTINE LZCDRV(IPDEV,IPMTX,IGEO,NMIX,NTOT,LIMIT,LNEW)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Read specifications for the liquid zone controllers from input file.

+*

+*Copyright:

+* Copyright (C) 2007 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* D. Sekki

+*

+*Parameters: input/output

+* IPDEV  pointer to device information.

+* IPMTX  pointer to matex information.

+* IGEO   index related to the reactor geometry.

+* NMIX   old maximum number of material mixtures.

+* NTOT   old total number of all mixtures.

+* LIMIT  core limiting coordinates.

+* LNEW   flag with respect to device object:

+*        =.true. in create mode; =.false. in modification mode.

+*

+*-----------------------------------------------------------------------

+*

+      USE GANLIB

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      TYPE(C_PTR) IPDEV,IPMTX

+      INTEGER NMIX,NTOT

+      REAL LIMIT(6)

+      LOGICAL LNEW

+*----

+*  LOCAL VARIABLES

+*----

+      PARAMETER(NSTATE=40,IOUT=6)

+      CHARACTER TEXT*12

+      INTEGER ISTATE(NSTATE)

+      DOUBLE PRECISION DFLOT

+      TYPE(C_PTR) JPDEV,KPDEV

+      INTEGER, ALLOCATABLE, DIMENSION(:) :: MIX,MAT

+*----

+*  READ INPUT DATA

+*----

+      IMPX=1

+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+      IF(ITYP.NE.3)CALL XABORT('@LZCDRV: CHARACTER DATA EXPECTED(1).')

+      IF(TEXT.NE.'EDIT')GOTO 10

+*     PRINTING INDEX

+      CALL REDGET(ITYP,IMPX,FLOT,TEXT,DFLOT)

+      IF(ITYP.NE.1)CALL XABORT('@LZCDRV: INTEGER FOR EDIT EXPECTED.')

+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+      IF(ITYP.NE.3)CALL XABORT('@LZCDRV: CHARACTER DATA EXPECTED(2).')

+   10 IF(TEXT.NE.'NUM-LZC')CALL XABORT('@LZCDRV: KEYWORD NUM-LZC EXP'

+     1 //'ECTED.')

+*     TOTAL NUMBER OF LZC

+      CALL REDGET(ITYP,NLZC,FLOT,TEXT,DFLOT)

+      IF(ITYP.NE.1)CALL XABORT('@LZCDRV: INTEGER TOTAL NUMBER OF LZC'

+     1 //' EXPECTED.')

+      IF(NLZC.LT.1)CALL XABORT('@LZCDRV: WRONG TOTAL NUMBER OF LZC <1')

+*

+      NTOT2=NTOT+NLZC*4

+      ALLOCATE(MIX(NTOT2),MAT(NTOT))

+      MIX(:NTOT2)=0

+      MAT(:NTOT)=0

+      CALL LCMGET(IPMTX,'MAT',MAT)

+      DO 20 I=1,NTOT

+      MIX(I)=MAT(I)

+   20 CONTINUE

+      DEALLOCATE(MAT)

+*----

+*  READ OPTION

+*----

+      IF(IMPX.GT.0)WRITE(IOUT,1000)NLZC

+      JPDEV=LCMLID(IPDEV,'DEV_LZC',NLZC)

+      K=0

+   30 K=K+1

+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+      IF(TEXT.EQ.'LZC')THEN

+        CALL REDGET(ITYP,ID,FLOT,TEXT,DFLOT)

+        IF(ITYP.NE.1)CALL XABORT('@LZCDRV: INTEGER ID NUM'

+     1   //'BER FOR THE CURRENT LZC EXPECTED.')

+        IF(ID.NE.K)THEN

+          WRITE(IOUT,*)'@LZCDRV: READ CURRENT LZC-ID #',ID

+          WRITE(IOUT,*)'@LZCDRV: EXPECTED LZC-ID #',K

+          CALL XABORT('@LZCDRV: WRONG INPUT OF ID NUMBER.')

+        ENDIF

+        IF(ID.GT.NLZC)THEN

+          WRITE(IOUT,*)'@LZCDRV: READ CURRENT LZC-ID #',ID

+          WRITE(IOUT,*)'@LZCDRV: GIVEN TOTAL NUMBER OF LZC:',NLZC

+          CALL XABORT('@LZCDRV: WRONG INPUT OF LZC-ID NUMBER. GRE'

+     1     //'ATER THAN THE TOTAL NUMBER OF LZC.')

+        ENDIF

+      ELSEIF((TEXT.EQ.'CREATE').OR.(TEXT.EQ.';'))THEN

+        GOTO 40

+      ELSE

+        WRITE(IOUT,*)'@LZCDRV: INVALID KEYWORD ',TEXT

+        CALL XABORT('@LZCDRV: KEYWORD OR ; EXPECTED.')

+      ENDIF

+      IF(IMPX.GT.1)WRITE(IOUT,1001)ID

+      KPDEV=LCMDIL(JPDEV,ID)

+*     READ INDIVIDUAL LZC DATA

+      CALL LZCGET(KPDEV,NTOT,NMIX,NTOT2,MIX,ID,LIMIT,IMPX)

+      GOTO 30

+   40 IF(ID.NE.NLZC)THEN

+        WRITE(IOUT,*)'@LZCDRV: GIVEN TOTAL NUMBER OF LZC ',NLZC

+        WRITE(IOUT,*)'@LZCDRV: READ ONLY THE NUMBER OF LZC ',ID

+        CALL XABORT('@LZCDRV: WRONG INPUT OF LZC DEVICES.')

+      ENDIF

+      IF(IMPX.GT.0)WRITE(IOUT,1002)ID

+      IF(TEXT.EQ.';')GOTO 50

+      LGRP=0

+*     TOTAL NUMBER OF LZC-GROUPS

+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+      IF(TEXT.NE.'LZC-GR')CALL XABORT('@LZCDRV: KEYWORD LZC-GR EX'

+     1 //'PECTED.')

+      CALL REDGET(ITYP,LGRP,FLOT,TEXT,DFLOT)

+      IF(ITYP.NE.1)CALL XABORT('@LZCDRV: INTEGER NUMBER OF LZC-GR'

+     1 //'OUPS EXPECTED.')

+      IF(LGRP.LT.1)CALL XABORT('@LZCDRV: WRONG NUMBER OF GROUPS <1')

+*     CREATE LZC-GROUPS

+      CALL LZCDGD(IPDEV,NLZC,LGRP,IMPX)

+*----

+*  STATE-VECTORS

+*----

+   50 ISTATE(:NSTATE)=0

+      IF(LNEW)THEN

+        ISTATE(1)=IGEO

+        ISTATE(4)=NLZC

+        ISTATE(5)=LGRP

+      ELSE

+*       UPDATE DEVICE

+        CALL LCMGET(IPDEV,'STATE-VECTOR',ISTATE)

+        ISTATE(4)=NLZC

+        ISTATE(5)=LGRP

+      ENDIF

+      CALL LCMPUT(IPDEV,'STATE-VECTOR',NSTATE,1,ISTATE)

+      IF(IMPX.GT.1)CALL LCMLIB(IPDEV)

+*     UPDATE MATEX

+      ISTATE(:NSTATE)=0

+      CALL LCMGET(IPMTX,'STATE-VECTOR',ISTATE)

+      ISTATE(2)=NMIX+NLZC*4

+      ISTATE(5)=NTOT2

+      CALL LCMPUT(IPMTX,'STATE-VECTOR',NSTATE,1,ISTATE)

+      CALL LCMPUT(IPMTX,'MAT',NTOT2,1,MIX)

+      DEALLOCATE(MIX)

+      IF(IMPX.EQ.99)THEN

+*       CHECK NEW COMPUTED VALUES

+        WRITE(IOUT,*)'OLD VALUES: NMIX=',NMIX,' NTOT=',NTOT

+        WRITE(IOUT,*)'NEW VALUES: NMIX=',ISTATE(2),' NTOT=',ISTATE(5)

+      ENDIF

+      IF(IMPX.GT.5)CALL LCMLIB(IPMTX)

+      RETURN

+*

+ 1000 FORMAT(/1X,'GIVEN TOTAL NUMBER OF LIQUID ZONE CONTROL',

+     1 'LERS: ',I2//1X,'**  READING INPUT DATA FOR LZC  **')

+ 1001 FORMAT(/6X,'=>',2X,'LZC #',I2.2)

+ 1002 FORMAT(/1X,35('-')/1X,'READ TOTAL NUMBER OF LZC: ',I2)

+      END

diff --git a/Donjon/src/LZCGET.f b/Donjon/src/LZCGET.f
new file mode 100644
index 0000000..bb421c6
--- /dev/null
+++ b/Donjon/src/LZCGET.f
@@ -0,0 +1,232 @@
+*DECK LZCGET

+      SUBROUTINE LZCGET(KPDEV,NTOT,NMIX,NTOT2,MIX,ID,LIMIT,IMPX)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Read the specification for a given liquid zone controller.

+*

+*Copyright:

+* Copyright (C) 2007 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* D. Sekki

+*

+*Parameters: input/output

+* KPDEV  pointer to DEV_LZC directory for lzc information.

+* NTOT   old total number of all mixtures.

+* NMIX   old maximum number of material mixtures.

+* NTOT2  new total number of all mixtures.

+* MIX    new mixture index of all mixtures.

+* ID     current lzc identification number.

+* LIMIT  core limiting coordinates.

+* IMPX   printing index (=0 for no print).

+*

+*-----------------------------------------------------------------------

+*

+      USE GANLIB

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      TYPE(C_PTR) KPDEV

+      INTEGER NTOT,NMIX,NTOT2,MIX(NTOT2),ID,IMPX

+      REAL LIMIT(6)

+*----

+*  LOCAL VARIABLES

+*----

+      PARAMETER(IOUT=6)

+      INTEGER EMIX(2),FMIX(2)

+      REAL MAXPOS(6),EMPTPOS(6),FULLPOS(6),LEVEL

+      DOUBLE PRECISION DFLOT

+      CHARACTER TEXT*12,AXIS

+*----

+*  REACTOR CORE LIMITS

+*----

+      XMIN=LIMIT(1)

+      XMAX=LIMIT(2)

+      YMIN=LIMIT(3)

+      YMAX=LIMIT(4)

+      ZMIN=LIMIT(5)

+      ZMAX=LIMIT(6)

+*----

+*  WHOLE LZC POSITION

+*----

+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+      IF(TEXT.NE.'MAXPOS')CALL XABORT('@LZCGET: KEYWORD MAXPOS EXP'

+     1 //'ECTED.')

+      DO I=1,6

+        CALL REDGET(ITYP,NITMA,MAXPOS(I),TEXT,DFLOT)

+        IF(ITYP.NE.2)CALL XABORT('@LZCGET: REAL FOR MAXPOS EXPECTED.')

+      ENDDO

+*----

+*  CHECK LZC POSITION

+*----

+      IF(MAXPOS(2).LT.MAXPOS(1))CALL XABORT('@LZCGET: WRONG X '

+     1 //'LZC COORDINATES: X- > X+')

+      IF(MAXPOS(1).LT.XMIN)CALL XABORT('@LZCGET: WRONG X- VALUE.')

+      IF(MAXPOS(2).GT.XMAX)CALL XABORT('@LZCGET: WRONG X+ VALUE.')

+*

+      IF(MAXPOS(4).LT.MAXPOS(3))CALL XABORT('@LZCGET: WRONG Y '

+     1 //'LZC COORDINATES: Y- > Y+')

+      IF(MAXPOS(3).LT.YMIN)CALL XABORT('@LZCGET: WRONG Y- VALUE.')

+      IF(MAXPOS(4).GT.YMAX)CALL XABORT('@LZCGET: WRONG Y+ VALUE.')

+*

+      IF(MAXPOS(6).LT.MAXPOS(5))CALL XABORT('@LZCGET: WRONG Z '

+     1 //'LZC COORDINATES: Z- > Z+')

+      IF(MAXPOS(5).LT.ZMIN)CALL XABORT('@LZCGET: WRONG Z- VALUE.')

+      IF(MAXPOS(6).GT.ZMAX)CALL XABORT('@LZCGET: WRONG Z+ VALUE.')

+*----

+*  MAX-FULL COORDINATE

+*----

+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+      IF(TEXT.NE.'MAX-FULL')CALL XABORT('@LZCGET: KEYWORD MAX-FULL'

+     1 //' EXPECTED.')

+      CALL REDGET(ITYP,NITMA,FULMAX,TEXT,DFLOT)

+      IF(ITYP.NE.2)CALL XABORT('@LZCGET: REAL FOR MAX-FULL COORDIN'

+     1 //'ATE EXPECTED.')

+*----

+*  LZC FILLING AXIS

+*----

+      HEIGHT=0.

+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+      IF(TEXT.NE.'AXIS')CALL XABORT('@LZCGET: KEYWORD AXIS EXPECTED.')

+      CALL REDGET(ITYP,NITMA,FLOT,AXIS,DFLOT)

+      IF(AXIS.NE.'X')THEN

+      IF(AXIS.NE.'Y')THEN

+      IF(AXIS.NE.'Z')THEN

+       CALL XABORT('@LZCGET: X, Y OR Z EXPECTED FOR AXIS.')

+      ELSE

+        IAXIS=3

+        IF(FULMAX.GT.MAXPOS(4))CALL XABORT('@LZCGET: WRONG MAX-FULL VA'

+     1  //'LUE: > Z+.')

+        IF(FULMAX.LT.MAXPOS(3))CALL XABORT('@LZCGET: WRONG MAX-FULL VA'

+     1  //'LUE: < Z-.')

+        HEIGHT=MAXPOS(6)-FULMAX

+      ENDIF

+      ELSE

+        IAXIS=2

+        IF(FULMAX.GT.MAXPOS(4))CALL XABORT('@LZCGET: WRONG MAX-FULL VA'

+     1  //'LUE: > Y+.')

+        IF(FULMAX.LT.MAXPOS(3))CALL XABORT('@LZCGET: WRONG MAX-FULL VA'

+     1  //'LUE: < Y-.')

+        HEIGHT=MAXPOS(4)-FULMAX

+      ENDIF

+      ELSE

+        IAXIS=1

+        IF(FULMAX.GT.MAXPOS(2))CALL XABORT('@LZCGET: WRONG MAX-FULL VA'

+     1  //'LUE: > X+.')

+        IF(FULMAX.LT.MAXPOS(1))CALL XABORT('@LZCGET: WRONG MAX-FULL VA'

+     1  //'LUE: < X-.')

+        HEIGHT=MAXPOS(2)-FULMAX

+      ENDIF

+      IF(HEIGHT.EQ.0.)CALL XABORT('@LZCGET: MAX-FULL WATER HEIGHT =0.')

+*----

+*  LZC FILLING LEVEL

+*----

+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+      IF(TEXT.NE.'LEVEL')CALL XABORT('@LZCGET: KEYWORD LEVEL EXPECTED.')

+      CALL REDGET(ITYP,NITMA,LEVEL,TEXT,DFLOT)

+      IF(ITYP.NE.2)CALL XABORT('@LZCGET: REAL FOR FILLING LEVEL EX'

+     1 //'PECTED.')

+      IF(LEVEL.GT.1.)CALL XABORT('@LZCGET: WRONG FILLING LEVEL: > 1.')

+      IF(LEVEL.LT.0.)CALL XABORT('@LZCGET: WRONG FILLING LEVEL: < 0.')

+*----

+*  LZC FILLING RATE

+*----

+      RATE=0.

+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+      IF(ITYP.NE.3)CALL XABORT('@LZCGET: CHARACTER DATA EXPECTED(1).')

+      IF(TEXT.NE.'RATE')GOTO 10

+      CALL REDGET(ITYP,NITMA,RATE,TEXT,DFLOT)

+      IF(ITYP.NE.2)CALL XABORT('@LZCGET: REAL FOR RATE EXPECTED.')

+      IF(RATE.LT.0.)CALL XABORT('@DEVSET: WRONG RATE VALUE < 0.')

+*----

+*  LZC FILLING TIME

+*----

+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+      IF(ITYP.NE.3)CALL XABORT('@LZCGET: CHARACTER DATA EXPECTED(2).')

+   10 TIME=0.

+      IF(TEXT.NE.'TIME')GOTO 20

+      CALL REDGET(ITYP,NITMA,TIME,TEXT,DFLOT)

+      IF(ITYP.NE.2)CALL XABORT('@LZCGET: REAL FOR TIME EXPECTED.')

+      IF(TIME.LT.0.)CALL XABORT('@DEVSET: WRONG TIME VALUE < 0.')

+*----

+*  LZC MIXTURES

+*----

+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+      IF(ITYP.NE.3)CALL XABORT('@LZCGET: CHARACTER DATA EXPECTED(3).')

+*     EMPTY PART

+   20 IF(TEXT.NE.'EMPTY-MIX')CALL XABORT('@LZCGET: KEYWORD EMPTY-MI'

+     1 //'X EXPECTED.')

+      DO I=1,2

+        CALL REDGET(ITYP,EMIX(I),FLOT,TEXT,DFLOT)

+        IF(ITYP.NE.1)CALL XABORT('@LZCGET: INTEGER EMPTY-MIX NUMBER'

+     1 //' EXPECTED.')

+        MIX(NTOT+(ID-1)*4+I)=EMIX(I)

+        EMIX(I)=NMIX+(ID-1)*4+I

+      ENDDO

+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)

+      IF(ITYP.NE.3)CALL XABORT('@LZCGET: CHARACTER DATA EXPECTED(4).')

+*     FULL PART

+      IF(TEXT.NE.'FULL-MIX')CALL XABORT('@LZCGET: KEYWORD FULL-MIX '

+     1 //'EXPECTED.')

+      DO I=1,2

+        CALL REDGET(ITYP,FMIX(I),FLOT,TEXT,DFLOT)

+        IF(ITYP.NE.1)CALL XABORT('@LZCGET: INTEGER FULL-MIX NUMBER '

+     1 //'EXPECTED.')

+        MIX(NTOT+(ID-1)*4+I+2)=FMIX(I)

+        FMIX(I)=NMIX+(ID-1)*4+I+2

+      ENDDO

+*----

+*  CURRENT LZC POSITION

+*----

+      DELH=LEVEL*HEIGHT

+      DO I=1,6

+        EMPTPOS(I)=MAXPOS(I)

+        FULLPOS(I)=MAXPOS(I)

+      ENDDO

+      IF(IAXIS.EQ.1)THEN

+        FULLPOS(1)=MAXPOS(2)-DELH

+        EMPTPOS(2)=FULLPOS(1)

+      ELSEIF(IAXIS.EQ.2)THEN

+        FULLPOS(3)=MAXPOS(4)-DELH

+        EMPTPOS(4)=FULLPOS(3)

+      ELSEIF(IAXIS.EQ.3)THEN

+        FULLPOS(5)=MAXPOS(6)-DELH

+        EMPTPOS(6)=FULLPOS(5)

+      ENDIF

+*----

+*  STORE LZC DATA

+*----

+      CALL LCMPUT(KPDEV,'LZC-ID',1,1,ID)

+      CALL LCMPUT(KPDEV,'MAX-POS',6,2,MAXPOS)

+      CALL LCMPUT(KPDEV,'AXIS',1,1,IAXIS)

+      CALL LCMPUT(KPDEV,'HEIGHT',1,2,HEIGHT)

+      CALL LCMPUT(KPDEV,'LEVEL',1,2,LEVEL)

+      CALL LCMPUT(KPDEV,'EMPTY-POS',6,2,EMPTPOS)

+      CALL LCMPUT(KPDEV,'FULL-POS',6,2,FULLPOS)

+      CALL LCMPUT(KPDEV,'EMPTY-MIX',2,1,EMIX)

+      CALL LCMPUT(KPDEV,'FULL-MIX',2,1,FMIX)

+      CALL LCMPUT(KPDEV,'RATE',1,2,RATE)

+      CALL LCMPUT(KPDEV,'TIME',1,2,TIME)

+*

+      IF(IMPX.GT.1)WRITE(IOUT,1000)MAXPOS(1),MAXPOS(3),MAXPOS(5),

+     1 MAXPOS(2),MAXPOS(4),MAXPOS(6),HEIGHT,AXIS,LEVEL,EMPTPOS(1),

+     2 EMPTPOS(3),EMPTPOS(5),EMPTPOS(2),EMPTPOS(4),EMPTPOS(6),

+     3 FULLPOS(1),FULLPOS(3),FULLPOS(5),FULLPOS(2),FULLPOS(4),

+     4 FULLPOS(6),RATE,TIME

+      RETURN

+*

+ 1000 FORMAT(/5X,'WHOLE POSITION :',

+     1   4X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4/

+     2  37X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4/

+     3  /5X,'FIL-HEIGHT =',F9.4/

+     4  /5X,'FIL-AXIS : ',A1,5X,'FIL-LEVEL =',F8.4/

+     5  /5X,'EMPTY-PART POSITION :',

+     6   5X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4/

+     7  32X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4/

+     8  /5X,'FULL-PART POSITION :',

+     9   5X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4/

+     1  32X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4/

+     2  /5X,'FIL-RATE =',E11.4,5X,'FIL-TIME =',E11.4/)

+      END

diff --git a/Donjon/src/MACCRE.f b/Donjon/src/MACCRE.f
new file mode 100644
index 0000000..40615f1
--- /dev/null
+++ b/Donjon/src/MACCRE.f
@@ -0,0 +1,206 @@
+*DECK MACCRE
+      SUBROUTINE MACCRE(IPOLD,IPNEW,NL,NW,NF,NGRP,NMXOLD,NMXNEW,NTOT,
+     1 MIX,LMAP,IMPX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover nuclear properties from an initial macrolib and store them
+* in a new one containing one mixture per region.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* J. Koclas, E. Varin, D. Sekki
+*
+*Parameters: input
+* IPOLD   pointer to the initial macrolib.
+* NL      number of legendre orders (=1 for isotropic scattering).
+* NW      legendre order of NWT information (=0: NTOT0; =1: NTOT1).
+* NF      number of fissile isotopes.
+* NGRP    number of energy groups.
+* NMXOLD  number of material mixtures in the initial macrolib.
+* NMXNEW  number of material mixtures in the final macrolib.
+* NTOT    total number of all (material and virtual) mixtures.
+* MIX     index of all (material and virtual) mixtures.
+* LMAP    flag for the initial macrolib:
+*          =.true. if the fuel map macrolib.
+* IMPX    printing index (=0 for no print).
+*
+*Parameters: output
+* IPNEW   pointer to the final macrolib.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPOLD,IPNEW
+      INTEGER NL,NW,NF,NGRP,NMXOLD,NMXNEW,NTOT,MIX(NTOT)
+      LOGICAL LMAP
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(IOUT=6)
+      CHARACTER CM*2,NAME*12,FIRST*12
+      TYPE(C_PTR) JPOLD,JPNEW,KPOLD,KPNEW
+      REAL, ALLOCATABLE, DIMENSION(:) ::SCAT,SCAT2,DATA,DATA2
+*
+      ALLOCATE(SCAT(NMXOLD*NL*NGRP*NGRP))
+      ALLOCATE(SCAT2(NMXNEW*NL*NGRP*NGRP))
+      SCAT(:NMXOLD*NL*NGRP*NGRP)=0.0
+      SCAT2(:NMXNEW*NL*NGRP*NGRP)=0.0
+*----
+*  RECOVER MACROLIB DATA
+*----
+      JPOLD=LCMGID(IPOLD,'GROUP')
+      JPNEW=LCMLID(IPNEW,'GROUP',NGRP)
+      DO 100 JGR=1,NGRP
+      KPOLD=LCMGIL(JPOLD,JGR)
+      KPNEW=LCMDIL(JPNEW,JGR)
+      IF(IMPX.GT.3)CALL LCMLIB(KPOLD)
+      IF(IMPX.GT.2)WRITE(IOUT,*)'** TREATING ENERGY GROUP #',JGR
+      NAME=' '
+      CALL LCMNXT(KPOLD,NAME)
+      FIRST=NAME
+   10 CALL LCMLEN(KPOLD,NAME,LENGT,ITYP)
+      IF((INDEX(NAME,'NTOT0').EQ.1).OR.(INDEX(NAME,'DIF').EQ.1).OR.
+     1   (INDEX(NAME,'NFT').EQ.1).OR.(INDEX(NAME,'OVE').EQ.1).OR.
+     2   (INDEX(NAME,'H-F').EQ.1).OR.(INDEX(NAME,'SIG').EQ.1))THEN
+*     RECOVER THESE PROPERTIES
+        IF(IMPX.GT.2)WRITE(IOUT,*)'PROPERTY NAME : ',NAME
+        IF(LENGT.EQ.NMXOLD)THEN
+          ALLOCATE(DATA(NMXOLD),DATA2(NMXNEW))
+          DATA(:NMXOLD)=0.0
+          DATA2(:NMXNEW)=0.0
+          CALL LCMGET(KPOLD,NAME,DATA)
+          IF(LMAP)THEN
+*         RECOVER EXISTING DATA
+            CALL LCMLEN(KPNEW,NAME,LENGT2,ITYP2)
+            IF(LENGT2.NE.0)CALL LCMGET(KPNEW,NAME,DATA2)
+          ENDIF
+          ITOT=0
+          DO 20 IBM=1,NTOT
+          IF(MIX(IBM).EQ.0)GOTO 20
+          ITOT=ITOT+1
+          IF(LMAP)THEN
+*         ONLY FUEL DATA WILL BE COPIED
+            IF(MIX(IBM).GT.0)GOTO 20
+            J=-MIX(IBM)
+          ELSE
+*         FUEL DATA WILL NOT BE COPIED
+            IF(MIX(IBM).LT.0)GOTO 20
+            J=MIX(IBM)
+          ENDIF
+*         COPY DATA
+          DATA2(ITOT)=DATA(J)
+   20     CONTINUE
+*         STORE DATA
+          CALL LCMPUT(KPNEW,NAME,NMXNEW,ITYP,DATA2)
+          DEALLOCATE(DATA,DATA2)
+        ELSEIF(LENGT.EQ.-1)THEN
+          CALL XABORT('@MACCRE: '//NAME//' IS A DIRECTORY.')
+        ELSEIF(LENGT.NE.0)THEN
+          CALL XABORT('@MACCRE: INVALID INPUT MACROLIB(1).')
+        ENDIF
+      ELSE IF((INDEX(NAME,'NUS').EQ.1).OR.(INDEX(NAME,'CHI').EQ.1))THEN
+*       RECOVER FISSION-RELATED PROPERTIES
+        IF(IMPX.GT.2)WRITE(IOUT,*)'PROPERTY NAME : ',NAME
+        IF(LENGT.EQ.NMXOLD*NF)THEN
+          ALLOCATE(DATA(NMXOLD*NF),DATA2(NMXNEW*NF))
+          DATA(:NMXOLD*NF)=0.0
+          DATA2(:NMXNEW*NF)=0.0
+          CALL LCMGET(KPOLD,NAME,DATA)
+          IF(LMAP)THEN
+*         RECOVER EXISTING DATA
+            CALL LCMLEN(KPNEW,NAME,LENGT2,ITYP2)
+            IF(LENGT2.NE.0)CALL LCMGET(KPNEW,NAME,DATA2)
+          ENDIF
+          ITOT=0
+          DO 35 INF=1,NF
+          DO 30 IBM=1,NTOT
+          IF(MIX(IBM).EQ.0)GOTO 30
+          ITOT=ITOT+1
+          IF(LMAP)THEN
+*         ONLY FUEL DATA WILL BE COPIED
+            IF(MIX(IBM).GT.0)GOTO 30
+            J=-MIX(IBM)
+          ELSE
+*         FUEL DATA WILL NOT BE COPIED
+            IF(MIX(IBM).LT.0)GOTO 30
+            J=MIX(IBM)
+          ENDIF
+*         COPY DATA
+          J1=(INF-1)*NMXOLD+J
+          DATA2(ITOT)=DATA(J1)
+   30     CONTINUE
+   35     CONTINUE
+*         STORE DATA
+          CALL LCMPUT(KPNEW,NAME,NMXNEW*NF,ITYP,DATA2)
+          DEALLOCATE(DATA,DATA2)
+        ELSEIF(LENGT.EQ.-1)THEN
+          CALL XABORT('@MACCRE: '//NAME//' IS A DIRECTORY.')
+        ELSEIF(LENGT.NE.0)THEN
+          CALL XABORT('@MACCRE: INVALID INPUT MACROLIB(2).')
+        ENDIF
+      ENDIF
+      CALL LCMNXT(KPOLD,NAME)
+      IF(FIRST.EQ.NAME)GOTO 40
+      GOTO 10
+*     RECOVER SCAT,IJJ,NJJ,IPOS
+   40 IF(IMPX.GT.2)WRITE(IOUT,*)'RECOVERING OF SCAT,IJJ,NJJ,IPOS'
+      DO IL=1,NL
+        WRITE (CM,'(I2.2)') IL-1
+        CALL LCMLEN(KPOLD,'SCAT'//CM,LENGT,ITYP)
+        IF(LENGT.EQ.0)THEN
+          EXIT
+        ELSEIF(LENGT.GT.NMXOLD*NL*NGRP*NGRP)THEN
+          CALL XABORT('@MACCRE: INVALID INPUT MACROLIB(3).')
+        ELSEIF(LENGT.GT.0)THEN
+          CALL MACSCA(KPOLD,KPNEW,SCAT,SCAT2,CM,JGR,IL,MIX,NMXNEW,NTOT,
+     1    NMXOLD,NL,NGRP,LMAP)
+        ENDIF
+      ENDDO
+*     RECOVER NTOT1 information
+      IF(NW.GT.0) THEN
+        ALLOCATE(DATA(NMXOLD),DATA2(NMXNEW))
+        DATA(:NMXOLD)=0.0
+        DATA2(:NMXNEW)=0.0
+        CALL LCMGET(KPOLD,'NTOT1',DATA)
+        IF(LMAP)THEN
+*       RECOVER EXISTING DATA
+          CALL LCMLEN(KPNEW,'NTOT0',LENGT1,ITYP1)
+          CALL LCMLEN(KPNEW,'NTOT1',LENGT2,ITYP2)
+          IF(LENGT2.NE.0) THEN
+            CALL LCMGET(KPNEW,'NTOT1',DATA2)
+          ELSE IF(LENGT1.NE.0) THEN
+            CALL LCMGET(KPNEW,'NTOT0',DATA2)
+          ENDIF
+        ENDIF
+        ITOT=0
+        DO 50 IBM=1,NTOT
+        IF(MIX(IBM).EQ.0)GOTO 50
+        ITOT=ITOT+1
+        IF(LMAP)THEN
+*       ONLY FUEL DATA WILL BE COPIED
+          IF(MIX(IBM).GT.0)GOTO 50
+          J=-MIX(IBM)
+        ELSE
+*       FUEL DATA WILL NOT BE COPIED
+          IF(MIX(IBM).LT.0)GOTO 50
+          J=MIX(IBM)
+        ENDIF
+*       COPY DATA
+        DATA2(ITOT)=DATA(J)
+   50   CONTINUE
+*       STORE DATA
+        CALL LCMPUT(KPNEW,'NTOT1',NMXNEW,ITYP,DATA2)
+        DEALLOCATE(DATA,DATA2)
+      ENDIF
+      IF(IMPX.GT.3)CALL LCMLIB(KPNEW)
+  100 CONTINUE
+      DEALLOCATE(SCAT,SCAT2)
+      RETURN
+      END
diff --git a/Donjon/src/MACINI.f b/Donjon/src/MACINI.f
new file mode 100644
index 0000000..86037d0
--- /dev/null
+++ b/Donjon/src/MACINI.f
@@ -0,0 +1,260 @@
+*DECK MACINI
+      SUBROUTINE MACINI(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Construct a new macrolib that will contain one mixture number per
+* material region; fuel-map macrolib is required.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* J. Koclas, E. Varin, D. Sekki
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The MACINI: module specification is:
+* MACRO2 MATEX := MACINI: MATEX MACRO [ MACFL  ] :: [ EDIT iprint ] [ FUEL ] ;
+* where
+*   MACRO2 : name of the extended \emph{macrolib} to be created by the module.
+*   MATEX  : name of the \emph{matex} object containing an extended material 
+*     index over the reactor geometry. MATEX must be specified in the 
+*     modification mode; it will store the recovered h-factors per each fuel 
+*     region.
+*   MACRO  : name of a \emph{macrolib}, created using either MAC:, CRE:, NCR: 
+*     or AFM: module, for the evolution-independent material properties 
+*     (see structure (desccre1) or refer to the DRAGON user guide).
+*   MACFL  : name of a fuel-map \emph{macrolib}, created using either CRE:, 
+*     NCR: or AFM: module, for the interpolated fuel properties (see structure
+*     (desccre2) or refer to the DRAGON user guide).
+*   EDIT   : keyword used to set iprint.
+*   iprint : integer index used to control the printing on screen: = 0 for
+*     no print; = 1 for minimum printing; larger values produce increasing 
+*     amounts of output. The default value is iprint = 1.
+*   FUEL   : keyword used to indicate that MACRO is a fuel-map \emph{macrolib}
+*     in case where only two RHS objects are defined. By default, MACRO contains
+*     evolution-independent cross sections.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(NSTATE=40,IOUT=6)
+      CHARACTER HSIGN*12,TEXT*12
+      INTEGER ISTATE(NSTATE)
+      DOUBLE PRECISION DFLOT
+      LOGICAL LMAP,LWD1,LWD2
+      TYPE(C_PTR) IPMAC,IPMTX,IPMAC1,IPMAC2,JPMAC,KPMAC
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: MIX
+      REAL, ALLOCATABLE, DIMENSION(:) :: HFAC,WDLA
+*----
+*  PARAMETER VALIDATION
+*----
+      IF((NENTRY.LE.2).OR.(NENTRY.GE.5)) 
+     1  CALL XABORT('@MACINI: 3 OR 4 PARAMETERS EXPECTED.')
+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2))CALL XABORT('@MACINI:'
+     1 //' LCM OBJECT EXPECTED AT LHS.')
+      IF(JENTRY(1).NE.0)CALL XABORT('@MACINI: CREATE MODE EXPECTED'
+     1 //' FOR L_MACROLIB AT LHS.')
+      IPMAC=KENTRY(1)
+*     L_MATEX
+      IF((IENTRY(2).NE.1).AND.(IENTRY(2).NE.2))CALL XABORT('@MACINI:'
+     1 //' LCM OBJECT EXPECTED AT RHS.')
+      IF(JENTRY(2).NE.1)CALL XABORT('@MACINI: MODIFICATION MODE EX'
+     1 //'PECTED FOR L_MATEX OBJECT.')
+      CALL LCMGTC(KENTRY(2),'SIGNATURE',12,HSIGN)
+      IF(HSIGN.NE.'L_MATEX')THEN
+        TEXT=HENTRY(2)
+        CALL XABORT('@MACINI: SIGNATURE OF '//TEXT//' IS '//HSIGN//
+     1  '. L_MATEX EXPECTED AT RHS.')
+      ENDIF
+      IPMTX=KENTRY(2)
+      DO IEN=3,NENTRY
+      IF((IENTRY(IEN).NE.1).AND.(IENTRY(IEN).NE.2))CALL XABORT('@MACIN'
+     1 //'I: LCM OBJECT EXPECTED AT RHS.')
+      IF(JENTRY(IEN).NE.2)CALL XABORT('@MACINI: READ-ONLY MODE EXPEC'
+     1 //'TED FOR THE LCM OBJECTS AT RHS.')
+      ENDDO
+*     L_MACROLIB(1)
+      CALL LCMGTC(KENTRY(3),'SIGNATURE',12,HSIGN)
+      IF(HSIGN.NE.'L_MACROLIB')THEN
+        TEXT=HENTRY(3)
+        CALL XABORT('@MACINI: SIGNATURE OF '//TEXT//' IS '//HSIGN//
+     1  '. FIRST MACROLIB EXPECTED AT RHS.')
+      ENDIF
+      IPMAC1=KENTRY(3)
+*     L_MACROLIB(2)
+      IF(NENTRY.EQ.4) THEN
+        CALL LCMGTC(KENTRY(4),'SIGNATURE',12,HSIGN)
+        IF(HSIGN.NE.'L_MACROLIB')THEN
+          TEXT=HENTRY(4)
+          CALL XABORT('@MACINI: SIGNATURE OF '//TEXT//' IS '//HSIGN//
+     1    '. FUEL-MAP MACROLIB EXPECTED AT RHS.')
+        ENDIF
+        IPMAC2=KENTRY(4)
+      ELSE
+        IPMAC2=C_NULL_PTR
+      ENDIF
+*----
+*  RECOVER INFORMATION
+*----
+      ISTATE(:NSTATE)=0
+      CALL LCMGET(IPMAC1,'STATE-VECTOR',ISTATE)
+*     MACROLIB(1)-INFO
+      NGRP=ISTATE(1)
+      NMIX1=ISTATE(2)
+      NL=ISTATE(3)
+      NF1=ISTATE(4)
+      NDEL1=ISTATE(7)
+      NDEL2=0
+      LEAK=ISTATE(9)
+      NW1=ISTATE(10)
+*     MACROLIB(2)-INFO
+      NF2=1
+      IF(NENTRY.EQ.4) THEN
+        ISTATE(:NSTATE)=0
+        CALL LCMGET(IPMAC2,'STATE-VECTOR',ISTATE)
+        NMIX2=ISTATE(2)
+        NDEL2=ISTATE(7)
+        NL=MAX(ISTATE(3),NL)
+        NW2=ISTATE(10)
+        NF2=ISTATE(4)
+        IF((NF2.NE.NF1).AND.(NF1.GT.1)) THEN
+          WRITE(IOUT,*)'MACROLIB=',HENTRY(1),' NF=',NF1,' (0 EXPECTED)'
+          WRITE(IOUT,*)'MACROLIB=',HENTRY(2),' NF=',NF2
+          CALL XABORT('@MACINI: INCONSISTENT NUMBER OF FISSILE ISOTOPE'
+     1    //'S.')
+        ENDIF
+        IF(ISTATE(1).NE.NGRP)CALL XABORT('@MACINI: DIFFERENT NGRP'
+     1 //' NUMBER IN TWO MACROLIB OBJECTS.')
+        IF(ISTATE(3).NE.NL)CALL XABORT('@MACINI: INCONSISTENT NL '
+     1 //'NUMBER IN TWO MACROLIB OBJECTS.')
+        IF(ISTATE(9).NE.LEAK)CALL XABORT('@MACINI: DIFFERENT LEAK'
+     1 //' NUMBER IN TWO MACROLIB OBJECTS.')
+      ENDIF
+      ISTATE(:NSTATE)=0
+      CALL LCMGET(IPMTX,'STATE-VECTOR',ISTATE)
+*     MATEX-INFO
+      NMIX=ISTATE(2)
+      NTOT=ISTATE(5)
+      ALLOCATE(MIX(NTOT))
+      MIX(:NTOT)=0
+      CALL LCMGET(IPMTX,'MAT',MIX)
+      IMPX=1
+      LMAP=.FALSE.
+   10 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.EQ.10)GOTO 20
+      IF(ITYP.NE.3)CALL XABORT('@MACINI: CHARACTER DATA EXPECTED.')
+      IF(TEXT.EQ.'EDIT')THEN
+*       READ PRINTING INDEX
+        CALL REDGET(ITYP,IMPX,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@MACINI: INTEGER FOR EDIT EXPECTED.')
+      ELSE IF(TEXT.EQ.'FUEL')THEN
+*       ASSUME FUEL-MAP MACROLIB
+        IF(NENTRY.NE.3) CALL XABORT ('@MACINI: 3 PARAMETERS EXPECTED.')
+        LMAP=.TRUE.
+      ELSE IF(TEXT.EQ.';')THEN
+        GO TO 20
+      ELSE
+        CALL XABORT('@MACINI: FINAL ; EXPECTED.')
+      ENDIF
+      GO TO 10
+*----
+*  NEW MACROLIB CREATION
+*----
+   20 IF(IMPX.GT.1)WRITE(IOUT,*)'NUMBER OF ENERGY GROUPS  ',NGRP
+      IF(IMPX.GT.1)WRITE(IOUT,*)'TOTAL NUMBER OF MIXTURES ',NMIX
+*     DO NOT INCLUDE FUEL PROPERTIES
+      IF(IMPX.GT.0)WRITE(IOUT,*)'** TREATING FIRST MACROLIB **'
+      CALL MACCRE(IPMAC1,IPMAC,NL,NW1,NF1,NGRP,NMIX1,NMIX,NTOT,MIX,LMAP,
+     1 IMPX)
+      IF(IMPX.GT.1)CALL LCMLIB(IPMAC)
+*     INCLUDE FUEL PROPERTIES
+      IF(NENTRY.EQ.4) THEN
+        LMAP=.TRUE.
+        IF(IMPX.GT.0)WRITE(IOUT,*)'** TREATING FUEL-MAP MACROLIB **'
+        CALL MACCRE(IPMAC2,IPMAC,NL,NW2,NF2,NGRP,NMIX2,NMIX,NTOT,MIX,
+     1  LMAP,IMPX)
+      ENDIF
+      DEALLOCATE(MIX)
+*----
+*  RECOVER LAMBDA-D
+*----
+      CALL LCMLEN(IPMAC1,'LAMBDA-D',LENGTH,ITYLCM)
+      LWD1=(LENGTH.EQ.NDEL1).AND.(NDEL1.GT.0)
+      LWD2=.FALSE.
+      IF(NENTRY.EQ.4) THEN
+        CALL LCMLEN(IPMAC2,'LAMBDA-D',LENGTH,ITYLCM)
+        LWD2=(LENGTH.EQ.NDEL2).AND.(NDEL2.GT.0)
+      ENDIF
+      NDEL=0
+      IF(LWD1) THEN
+        NDEL=NDEL1
+        ALLOCATE(WDLA(NDEL))
+        CALL LCMGET(IPMAC1,'LAMBDA-D',WDLA)
+        CALL LCMPUT(IPMAC,'LAMBDA-D',NDEL,2,WDLA)
+        DEALLOCATE(WDLA)
+      ELSE IF(LWD2) THEN
+        NDEL=NDEL2
+        ALLOCATE(WDLA(NDEL))
+        CALL LCMGET(IPMAC2,'LAMBDA-D',WDLA)
+        CALL LCMPUT(IPMAC,'LAMBDA-D',NDEL,2,WDLA)
+        DEALLOCATE(WDLA)
+      ENDIF
+*----
+*  STATE-VECTOR
+*----
+      ISTATE(:NSTATE)=0
+      ISTATE(1)=NGRP
+      ISTATE(2)=NMIX
+      ISTATE(3)=NL
+      IF(NENTRY.EQ.3) THEN
+        ISTATE(4)=NF1
+      ELSE IF(NENTRY.EQ.4) THEN
+        ISTATE(4)=NF2
+      ENDIF
+      ISTATE(7)=NDEL
+      ISTATE(9)=LEAK
+      CALL LCMPUT(IPMAC,'STATE-VECTOR',NSTATE,1,ISTATE)
+      HSIGN='L_MACROLIB'
+      CALL LCMPTC(IPMAC,'SIGNATURE',12,HSIGN)
+      IF(IMPX.GT.0)CALL LCMLIB(IPMAC)
+*----
+*  RECOVER H-FACTOR AND SAVE ON L_MATEX
+*----
+      ALLOCATE(HFAC(NMIX*NGRP))
+      JPMAC=LCMGID(IPMAC,'GROUP')
+      DO JGR=1,NGRP
+      KPMAC=LCMGIL(JPMAC,JGR)
+      CALL LCMLEN(KPMAC,'H-FACTOR',LENGT,ITYP)
+      IF(LENGT.NE.NMIX)CALL XABORT('@MACINI: UNABLE TO FIND H'
+     1 //'-FACTOR BLOCK DATA IN THE NEW MACROLIB.')
+      CALL LCMGET(KPMAC,'H-FACTOR',HFAC((JGR-1)*NMIX+1))
+      ENDDO
+      CALL LCMPUT(IPMTX,'H-FACTOR',NMIX*NGRP,2,HFAC)
+      DEALLOCATE(HFAC)
+      RETURN
+      END
diff --git a/Donjon/src/MACSCA.f b/Donjon/src/MACSCA.f
new file mode 100644
index 0000000..619ad45
--- /dev/null
+++ b/Donjon/src/MACSCA.f
@@ -0,0 +1,169 @@
+*DECK MACSCA
+      SUBROUTINE MACSCA(KPOLD,KPNEW,SCAT,SCAT2,CM,JGR,IL,MIX,NMXNEW,
+     1 NTOT,NMXOLD,NL,NGRP,LMAP)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover scattering matrices and store them in a new macrolib for
+* a given anistropic level and energy group.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* J. Koclas, E. Varin, D. Sekki
+*
+*Parameters: input
+* KPOLD   pointer to group directory in the initial macrolib.
+* NL      number of legendre orders (=1 for isotropic scattering).
+* NGRP    number of energy groups.
+* NMXOLD  number of material mixtures in the initial macrolib.
+* NMXNEW  number of material mixtures in the final macrolib.
+* MIX     index of all (material and virtual) mixtures per region.
+* NTOT    total number of all (material and virtual) mixtures.
+* SCAT    scattering matrices in the initial macrolib.
+* SCAT2   scattering matrices in the final macrolib.
+* IL      anisotropic level to be treated.
+* JGR     energy group to be treated.
+* CM      anisotropic level in I2.2 format.
+* LMAP    flag for the initial macrolib:
+*          =.true. if the fuel map macrolib.
+*
+*Parameters: output
+* KPNEW   pointer to group directory in the final macrolib.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) KPOLD,KPNEW
+      REAL SCAT(NMXOLD,NL,NGRP,NGRP),SCAT2(NMXNEW,NL,NGRP,NGRP)
+      INTEGER MIX(NTOT)
+      CHARACTER CM*2
+      LOGICAL LMAP
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IPOS,IPOS2
+      INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: IJJ,IJJ2,NJJ,NJJ2
+      REAL, ALLOCATABLE, DIMENSION(:) :: WORK,WORK2
+      CHARACTER HSMG*131
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(IPOS(NMXOLD),IPOS2(NMXNEW),IJJ(NMXOLD,NL,NGRP),
+     1 IJJ2(NMXNEW,NL,NGRP),NJJ(NMXOLD,NL,NGRP),NJJ2(NMXNEW,NL,NGRP))
+      ALLOCATE(WORK(NMXOLD*NGRP),WORK2(NMXNEW*NGRP))
+      WORK(:NMXOLD*NGRP)=0.0
+      WORK2(:NMXNEW*NGRP)=0.0
+*----
+*  RECOVER EXISTING DATA
+*----
+      CALL LCMLEN(KPNEW,'NJJS'//CM,ILENG,ITYP)
+      IF(LMAP.AND.(ILENG.GT.0))THEN
+        IF(ILENG.NE.NMXNEW)CALL XABORT('@MACSCA: INVALID MACROLIB(1).')
+        CALL LCMGET(KPNEW,'SCAT'//CM,WORK2(1))
+        CALL LCMGET(KPNEW,'NJJS'//CM,NJJ2(1,IL,JGR))
+        CALL LCMGET(KPNEW,'IJJS'//CM,IJJ2(1,IL,JGR))
+        CALL LCMGET(KPNEW,'IPOS'//CM,IPOS2(1))
+        DO 15 IBM=1,NMXNEW
+          IJJ0=IJJ2(IBM,IL,JGR)
+          IPOSDE=IPOS2(IBM)
+          DO 10 IGR=IJJ0,IJJ0-NJJ2(IBM,IL,JGR)+1,-1
+            SCAT2(IBM,IL,IGR,JGR)=WORK2(IPOSDE)
+            IPOSDE=IPOSDE+1
+   10     CONTINUE
+   15   CONTINUE
+      ENDIF
+*----
+*  RECOVER SCAT,IJJ,NJJ,IPOS
+*----
+      CALL LCMLEN(KPOLD,'NJJS'//CM,ILENG,ITYP)
+      IF(ILENG.EQ.0)CALL XABORT('@MACSCA: INVALID MACROLIB(2).')
+      CALL LCMGET(KPOLD,'SCAT'//CM,WORK(1))
+      CALL LCMGET(KPOLD,'NJJS'//CM,NJJ(1,IL,JGR))
+      CALL LCMGET(KPOLD,'IJJS'//CM,IJJ(1,IL,JGR))
+      CALL LCMGET(KPOLD,'IPOS'//CM,IPOS(1))
+      DO 25 IBM=1,NMXOLD
+        IJJ0=IJJ(IBM,IL,JGR)
+        IPOSDE=IPOS(IBM)
+        DO 20 IGR=IJJ0,IJJ0-NJJ(IBM,IL,JGR)+1,-1
+          SCAT(IBM,IL,IGR,JGR)=WORK(IPOSDE)
+          IPOSDE=IPOSDE+1
+   20   CONTINUE
+   25 CONTINUE
+*----
+*  NEW SCAT2
+*----
+      ITOT=0
+      DO 50 IBM=1,NTOT
+      IF(MIX(IBM).EQ.0)GOTO 50
+      ITOT=ITOT+1
+      IF(LMAP)THEN
+*     ONLY FUEL DATA WILL BE COPIED
+        IF(MIX(IBM).GT.0)GOTO 50
+        J=-MIX(IBM)
+        IF(J.GT.NMXOLD) THEN
+          WRITE(HSMG,'(25HMACSCA: A MIXTURE INDEX (,I6,12H) IS GREATER,
+     >    36H THAN THE TOTAL NUMBER OF MIXTURES (,I6,14H) IN 2ND RHS M,
+     >    8HACROLIB.)') J,NMXOLD
+          CALL XABORT(HSMG)
+        ENDIF
+      ELSE
+*     FUEL DATA WILL NOT BE COPIED
+        IF(MIX(IBM).LT.0)GOTO 50
+        J=MIX(IBM)
+        IF(J.GT.NMXOLD) THEN
+          WRITE(HSMG,'(25HMACSCA: A MIXTURE INDEX (,I6,12H) IS GREATER,
+     >    36H THAN THE TOTAL NUMBER OF MIXTURES (,I6,14H) IN 1ST RHS M,
+     >    8HACROLIB.)') J,NMXOLD
+          CALL XABORT(HSMG)
+        ENDIF
+      ENDIF
+*     COPY DATA
+      IJJ0=IJJ(J,IL,JGR)
+      DO 40 IGR=IJJ0,IJJ0-NJJ(J,IL,JGR)+1,-1
+        SCAT2(ITOT,IL,IGR,JGR)=SCAT(J,IL,IGR,JGR)
+   40 CONTINUE
+   50 CONTINUE
+*----
+*  NEW IJJ2 AND NJJ2
+*----
+      DO 70 IBM=1,NMXNEW
+        IGMIN=JGR
+        IGMAX=JGR
+        DO 60 IGR=NGRP,1,-1
+        IF(SCAT2(IBM,IL,IGR,JGR).NE.0.)THEN
+          IGMIN=MIN(IGMIN,IGR)
+          IGMAX=MAX(IGMAX,IGR)
+        ENDIF
+   60   CONTINUE
+      IJJ2(IBM,IL,JGR)=IGMAX
+      NJJ2(IBM,IL,JGR)=IGMAX-IGMIN+1
+   70 CONTINUE
+*----
+*  STORE SCAT2,IJJ2,NJJ2,IPOS2
+*----
+      IPOSDE=0
+      DO 85 IBM=1,NMXNEW
+        IPOS2(IBM)=IPOSDE+1
+        DO 80 IGR=IJJ2(IBM,IL,JGR),IJJ2(IBM,IL,JGR)-
+     1            NJJ2(IBM,IL,JGR)+1,-1
+          IPOSDE=IPOSDE+1
+          WORK2(IPOSDE)=SCAT2(IBM,IL,IGR,JGR)
+   80   CONTINUE
+   85 CONTINUE
+      CALL LCMPUT(KPNEW,'SCAT'//CM,IPOSDE,2,WORK2)
+      CALL LCMPUT(KPNEW,'IPOS'//CM,NMXNEW,1,IPOS2)
+      CALL LCMPUT(KPNEW,'NJJS'//CM,NMXNEW,1,NJJ2(1,IL,JGR))
+      CALL LCMPUT(KPNEW,'IJJS'//CM,NMXNEW,1,IJJ2(1,IL,JGR))
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(WORK2,WORK)
+      DEALLOCATE(NJJ2,NJJ,IJJ2,IJJ,IPOS2,IPOS)
+      RETURN
+      END
diff --git a/Donjon/src/MCC.f b/Donjon/src/MCC.f
new file mode 100644
index 0000000..61ae08c
--- /dev/null
+++ b/Donjon/src/MCC.f
@@ -0,0 +1,273 @@
+*DECK MCC
+      SUBROUTINE MCC(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Fuel map modification module.
+*
+*Copyright:
+* Copyright (C) 2013 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* M. Cordiez
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The MCC: module specifications are:
+* [FLMAP1] := MCC: FLMAP1 [FLMAP2] :: (descmcc1) ; 
+* where
+*   FLMAP1 : name of the \emph{MAP} object that will contain the updated 
+*     fuel-lattice information. If FLMAP1 appears on both LHS and RHS, it will 
+*     be updated; if it only appears on RHS, it will only be read to display 
+*     its contents.
+*   FLMAP2 : name of the \emph{MAP} object that contains information to be 
+*     recovered to update FLMAP1. If FLMAP2 exists, data to update FLMAP1 will 
+*     be taken in it. If not, data to update FLMAP1 will be taken in FLMAP1.
+*   (descmcc1) : structure describing the main input data to the MCC: module. 
+*     Note that this input data is mandatory and must be specified either if 
+*     FLMAP1 is updated or only read.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(NSTATE=40)
+      INTEGER ISTATE(NSTATE),NPARAM
+      INTEGER PTYPETCOOL,PTYPEDCOOL,VALSIZE
+      REAL TSAT
+      CHARACTER HSIGN*12,TEXT*40,REC1*40,REC2*40,PNAME*12
+      DOUBLE PRECISION DFLOT
+      LOGICAL :: EXISTENCE=.FALSE.,EXISTENCE2=.FALSE.
+      LOGICAL :: PRESTCOOL=.FALSE.,PRESDCOOL=.FALSE.
+      TYPE(C_PTR) IPMAP,JPMAP,KPMAP,IPMAP2
+      REAL, ALLOCATABLE, DIMENSION(:) :: VALTCOOL,VALDCOOL
+*----
+*  PARAMETER VALIDATION
+*----
+      IF(NENTRY.LT.1)CALL XABORT('@MCC: MINIMUM OF 1 OBJECT EXPECTED.')
+      IPMAP=KENTRY(1)
+      IF(NENTRY.EQ.2) IPMAP2=KENTRY(2)
+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2))CALL XABORT('@MCC:'
+     > //' LCM OBJECT EXPECTED AT LHS.')
+      IF(JENTRY(1).NE.1)CALL XABORT('@MCC: FLMAP1 MUST BE IN'
+     > //' MODIFICATION MODE AND NOT IN CREATION MODE.')
+      CALL LCMGTC(IPMAP,'SIGNATURE',12,HSIGN)
+      IF(HSIGN.NE.'L_MAP')THEN
+        TEXT=HENTRY(2)
+        CALL XABORT('@MCC: SIGNATURE OF '//TEXT//' IS '//HSIGN//
+     >  '. L_MAP EXPECTED.')
+      ENDIF
+      IF(NENTRY.EQ.2) THEN
+        IPMAP2=KENTRY(2)
+        IF((IENTRY(2).NE.1).AND.(IENTRY(2).NE.2))CALL XABORT('@MCC:'
+     > //' LCM OBJECT EXPECTED FOR FLMAP2.')
+        IF(JENTRY(2).NE.2)CALL XABORT('@MCC: FLMAP2 MUST BE IN READ-'
+     >    //'ONLY MODE AND NOT IN CREATION MODE.')
+        CALL LCMGTC(IPMAP,'SIGNATURE',12,HSIGN)
+        IF(HSIGN.NE.'L_MAP')THEN
+          TEXT=HENTRY(2)
+          CALL XABORT('@MCC: SIGNATURE OF '//TEXT//' IS '//HSIGN//
+     >    '. L_MAP EXPECTED.')
+        ENDIF
+      ENDIF
+*----
+*  RECOVER L_MAP STATE-VECTOR
+*----
+      CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+      NB=ISTATE(1)
+      NCH=ISTATE(2)
+      NPARAM=ISTATE(8)
+      IMPX=1
+*----
+*  READ INPUT DATA
+*----
+   10 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('@MCC: CHARACTER DATA EXPECTED.')
+* Read printing index
+      IF(TEXT.EQ.'EDIT') THEN
+        CALL REDGET(ITYP,IMPX,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@MCC: INTEGER FOR EDIT EXPECTED.')
+* Name of the record that is to be modified
+      ELSE IF(TEXT.EQ.'REC') THEN
+        CALL REDGET(ITYP,NITMA,FLOT,REC1,DFLOT)
+        IF(ITYP.NE.3) CALL XABORT('@MCC: STRING PARAMETER EXPECTED '
+     >               //'FOR THE NAME OF THE RECORD THAT IS '
+     >               //'TO BE MODIFIED.')
+* Checking of the record existence
+        JPMAP=LCMGID(IPMAP,'PARAM')
+        EXISTENCE=.FALSE.
+        DO IPAR=1,NPARAM,1
+          KPMAP=LCMGIL(JPMAP,IPAR)
+          CALL LCMGTC(KPMAP,'P-NAME',12,PNAME)
+          IF(PNAME.EQ.REC1) THEN
+            EXISTENCE=.TRUE.
+            EXIT  
+          ENDIF
+        ENDDO
+        IF(.NOT.EXISTENCE) CALL XABORT('@MCC: LOCAL PARAMETER: '
+     >                 //REC1//' DOES NOT EXIST IN THE FUEL MAP.')
+*
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+*********
+* Case of a uniform edition
+*********
+        IF(TEXT.EQ.'UNI') THEN
+          CALL REDGET(ITYP,NITMA,VAL1,TEXT,DFLOT)
+          IF(ITYP.NE.2) CALL XABORT('@MCC: REAL VALUE EXPECTED FOR '
+     >                            //'value1.')
+*         Fuel map modification: every value set to VAL1
+          CALL MCCMOD(IMPX,IPMAP,NPARAM,NCH,NB,REC1,VAL1,0)
+        ELSEIF(TEXT.EQ.'ADD') THEN
+          CALL REDGET(ITYP,NITMA,VAL2,TEXT,DFLOT)
+          IF(ITYP.NE.2) CALL XABORT('@MCC: REAL VALUE EXPECTED FOR '
+     >                            //'value2.')
+*         Fuel map modification: every value incremented of VAL2
+          CALL MCCMOD(IMPX,IPMAP,NPARAM,NCH,NB,REC1,VAL2,1)
+*********
+* Case of a copy from a different directory or fuel map
+*********
+* Same fuel map
+        ELSEIF(TEXT.EQ.'SAME') THEN
+          CALL REDGET(ITYP,NITMA,FLOT,REC2,DFLOT)
+          IF(ITYP.NE.3) CALL XABORT('@MCC: STRING PARAMETER EXPECTED '
+     >                            //'FOR THE NAME OF THE RECORD rec2 ')
+          IF((REC1.EQ.REC2).AND.(IMPX.GT.0)) WRITE(6,'(A)') 'WARNING: '
+     >           //'rec1 AND rec2 ARE IDENTICAL! THIS CALL IS USELESS.'
+* Checking of the record existence
+          JPMAP=LCMGID(IPMAP,'PARAM')
+          EXISTENCE2=.FALSE.
+          DO IPAR=1,NPARAM,1
+            KPMAP=LCMGIL(JPMAP,IPAR)
+            CALL LCMGTC(KPMAP,'P-NAME',12,PNAME)
+            IF(PNAME.EQ.REC2) THEN
+              EXISTENCE2=.TRUE.
+              EXIT  
+            ENDIF
+          ENDDO
+          IF(.NOT.EXISTENCE) CALL XABORT('@MCC: LOCAL PARAMETER: '
+     >                 //REC1//' DOES NOT EXIST IN THE FUEL MAP.')
+          CALL MCCCPY(IMPX,IPMAP,IPMAP,NPARAM,NCH,NB,REC1,REC2)
+*
+* Different fuel map
+        ELSEIF(TEXT.EQ.'READ') THEN
+          CALL REDGET(ITYP,NITMA,FLOT,REC2,DFLOT)
+          IF(ITYP.NE.3) CALL XABORT('@MCC: STRING PARAMETER EXPECTED '
+     >                            //'FOR THE NAME OF THE RECORD rec2 ')
+* Checking of the record existence
+          JPMAP=LCMGID(IPMAP2,'PARAM')
+          EXISTENCE2=.FALSE.
+          DO IPAR=1,NPARAM,1
+            KPMAP=LCMGIL(JPMAP,IPAR)
+            CALL LCMGTC(KPMAP,'P-NAME',12,PNAME)
+            IF(PNAME.EQ.REC2) THEN
+              EXISTENCE2=.TRUE.
+              EXIT  
+            ENDIF
+          ENDDO
+          IF(.NOT.EXISTENCE) CALL XABORT('@MCC: LOCAL PARAMETER: '
+     >                 //REC1//' DOES NOT EXIST IN THE FUEL MAP.')
+          CALL MCCCPY(IMPX,IPMAP,IPMAP2,NPARAM,NCH,NB,REC1,REC2)
+        ELSE
+          CALL XABORT('@MCC: WRONG KEYWORD.')
+        ENDIF
+*********
+* Calculation of D-COOL from T-COOL
+*********
+      ELSE IF(TEXT.EQ.'TTD') THEN
+        CALL REDGET(ITYP,NITMA,PINLET,TEXT,DFLOT)
+        IF(ITYP.NE.2) CALL XABORT('@MCC: REAL PARAMETER EXPECTED '
+     >                          //'FOR THE CORE PRESSURE.')
+* Checking of the existence of the T-COOL and D-COOL directories
+* Recovery of T-COOL data
+        JPMAP=LCMGID(IPMAP,'PARAM')
+        DO IPAR=1,NPARAM,1
+          KPMAP=LCMGIL(JPMAP,IPAR)
+          CALL LCMGTC(KPMAP,'P-NAME',12,PNAME)
+          IF(PNAME.EQ.'T-COOL') THEN
+            PRESTCOOL=.TRUE.
+            CALL LCMGET(KPMAP,'P-TYPE',PTYPETCOOL)
+            IF(PTYPETCOOL.EQ.1) THEN
+              VALSIZE=1
+              ALLOCATE(VALTCOOL(VALSIZE))
+              CALL LCMGET(KPMAP,'P-VALUE',VALTCOOL)
+            ELSE
+              VALSIZE=NCH*NB
+              ALLOCATE(VALTCOOL(VALSIZE))
+              CALL LCMGET(KPMAP,'P-VALUE',VALTCOOL)
+            ENDIF
+          ENDIF
+          IF(PNAME.EQ.'D-COOL') THEN
+            PRESDCOOL=.TRUE.
+            CALL LCMGET(KPMAP,'P-TYPE',PTYPEDCOOL)
+            IF(PTYPEDCOOL.EQ.1) THEN
+              VALSIZE=1
+              ALLOCATE(VALDCOOL(VALSIZE))
+            ELSE
+              VALSIZE=NCH*NB
+              ALLOCATE(VALDCOOL(VALSIZE))
+            ENDIF
+          ENDIF
+        ENDDO
+        IF(.NOT.PRESTCOOL) CALL XABORT('@MCC: LOCAL PARAMETER:'
+     >                //' T-COOL DOES NOT EXIST IN THE FUEL MAP AND'
+     >                //' IS REQUIRED TO COMPUTE D-COOL.')
+        IF(.NOT.PRESDCOOL) CALL XABORT('@MCC: LOCAL PARAMETER:'
+     >                //' D-COOL DOES NOT EXIST IN THE FUEL MAP.')
+        IF(PTYPETCOOL.NE.PTYPEDCOOL) CALL XABORT('@MCC: T-COOL AND'
+     >                //' D-COOL HAVE DIFFERENT TYPES (ONE IS GLOBAL'
+     >                //' AND THE OTHER IS LOCAL...).')
+* Definition of the pressure table size (the same as T-COOL table)
+        DO IVAL=1,VALSIZE,1
+          CALL THMSAT(PINLET,TSAT)
+          IF(VALTCOOL(IVAL).GT.TSAT) CALL XABORT('@MCC: WATER TEMPERA'
+     >           //'TURE IS GREATER THAN SATURATION TEMPERATURE (COO'
+     >           //'LANT IS BOILING).')
+          IF(VALTCOOL(IVAL).LT.273) CALL XABORT('@MCC: WATER TEMPERA'
+     >           //'TURE IS LOWER THAN 273K (FROZEN) IN SOME REGIONS.')
+          CALL THMPT(PINLET,VALTCOOL(IVAL),VALDCOOL(IVAL),R1,R2,R3,R4)
+          VALDCOOL(IVAL)=VALDCOOL(IVAL)/1000
+        ENDDO
+* Replacement of the old D-COOL values by the new ones
+        JPMAP=LCMGID(IPMAP,'PARAM')
+        DO IPAR=1,NPARAM,1
+          KPMAP=LCMGIL(JPMAP,IPAR)
+          CALL LCMGTC(KPMAP,'P-NAME',12,PNAME)
+          IF(PNAME.EQ.'D-COOL') THEN
+            CALL LCMPUT(KPMAP,'P-VALUE',VALSIZE,2,VALDCOOL)
+            EXIT
+          ENDIF
+        ENDDO
+        IF(IMPX.GE.1) WRITE(6,'(1X,A/)') 'PARAMETER D-COOL HAS BEEN CO'
+     >                //'MPUTED FROM T-COOL USING THE WATER TABLES.'
+*
+      ELSE IF(TEXT.EQ.';') THEN
+        GO TO 20
+      ELSE
+        CALL XABORT('@MCC: INVALID KEYWORD: '//TEXT//'.')
+      ENDIF
+      GO TO 10
+*
+   20 RETURN
+      END
diff --git a/Donjon/src/MCCCPY.f b/Donjon/src/MCCCPY.f
new file mode 100644
index 0000000..92d7119
--- /dev/null
+++ b/Donjon/src/MCCCPY.f
@@ -0,0 +1,141 @@
+*DECK MCCCPY
+      SUBROUTINE MCCCPY(IMPX,IPMAP,IPMAP2,NPARAM,NCH,NB,REC1,REC2)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Modification of the data stored in the PARAM folder of a fuel map
+*
+*Copyright:
+* Copyright (C) 2012 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* M. Cordiez
+*
+*Parameters: input
+* IMPX    printing index (=0 for no print).
+* IPMAP   pointer of the fuel map 1
+* IPMAP2  pointer of the fuel map 2
+* NPARAM  number of parameters in the PARAM folder
+* NCH     number of fuel channels
+* NB      number of fuel bundles per channel
+* REC1    record to be updated
+* REC2    record to be copied
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER IMPX,NPARAM,NCH,NB
+      CHARACTER REC1*40,REC2*40
+      TYPE(C_PTR) IPMAP,IPMAP2
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(NSTATE=40)
+      INTEGER ISTATE2(NSTATE)
+      INTEGER VALSIZE,PTYPE
+      INTEGER PTYPE2,NPARAM2,NCH2,NB2,VALSIZE2
+      CHARACTER PNAME*12,PNAME2*12
+      REAL, ALLOCATABLE, DIMENSION(:) :: VALMOD,VALCOP
+      TYPE(C_PTR) JPMAP,KPMAP,JPMAP2,KPMAP2
+*----
+*  RECOVER L_MAP 2 STATE-VECTOR
+*----
+      CALL LCMGET(IPMAP2,'STATE-VECTOR',ISTATE2)
+      NB2=ISTATE2(1)
+      NCH2=ISTATE2(2)
+      NPARAM2=ISTATE2(8)
+      IF(NB.NE.NB2) CALL XABORT('@MCCCCPY: THE NUMBER OF FUEL'
+     >            //' BUNDLES PER CHANNEL IS DIFFERENT BETWEEN'
+     >            //' FLMAP1 AND FLMAP2.')
+      IF(NCH.NE.NCH2) CALL XABORT('@MCCCCPY: THE NUMBER OF FUEL'
+     >            //' CHANNELS IS DIFFERENT BETWEEN'
+     >            //' FLMAP1 AND FLMAP2.')
+*----
+*  RECOVERY OF L_MAP PARAMETERS
+*----
+* L_MAP1 (to be updated)
+      JPMAP=LCMGID(IPMAP,'PARAM')
+      DO IPAR=1,NPARAM,1
+        KPMAP=LCMGIL(JPMAP,IPAR)
+        CALL LCMGTC(KPMAP,'P-NAME',12,PNAME)
+        CALL LCMGET(KPMAP,'P-TYPE',PTYPE)
+        IF(PNAME.EQ.REC1) THEN
+          IF(IMPX.GE.3) CALL LCMLIB(KPMAP)
+          EXIT
+        ENDIF
+      ENDDO
+* L_MAP2 (to be copied)
+      JPMAP2=LCMGID(IPMAP2,'PARAM')
+      DO IPAR=1,NPARAM2,1
+        KPMAP2=LCMGIL(JPMAP2,IPAR)
+        CALL LCMGTC(KPMAP2,'P-NAME',12,PNAME2)
+        CALL LCMGET(KPMAP2,'P-TYPE',PTYPE2)
+        IF(PNAME2.EQ.REC2) THEN
+          IF(IMPX.GE.3) CALL LCMLIB(KPMAP2)
+          EXIT
+        ENDIF
+      ENDDO
+*
+* Checking of the type (local or global) of REC1
+      IF(PTYPE.EQ.1) THEN
+        IF(IMPX.GE.1) WRITE(6,210) 'PARAMETER ',PNAME,' IS GLOBAL'
+        VALSIZE=1
+        ALLOCATE(VALMOD(VALSIZE))
+      ELSE IF(PTYPE.EQ.2) THEN
+        IF(IMPX.GE.1) WRITE(6,210) 'PARAMETER ',PNAME,' IS LOCAL'
+        VALSIZE=NCH*NB
+        ALLOCATE(VALMOD(VALSIZE))
+      ELSE 
+        CALL XABORT('@MCCCPY: '//PNAME//'IS NEITHER LOCAL NOR GLOBAL'
+     >         //'AND THAT IS IMPOSSIBLE.') 
+      ENDIF
+* Checking of the type (local or global) of REC2
+      IF((PTYPE2.NE.1).AND.(PTYPE2.NE.2)) THEN
+        CALL XABORT('@MCCCPY: '//PNAME2//'IS NEITHER LOCAL NOR GLOBAL'
+     >         //'AND THAT IS IMPOSSIBLE.') 
+      ENDIF
+      IF(PTYPE2.EQ.1) THEN
+        IF(IMPX.GE.1) WRITE(6,210) 'PARAMETER ',PNAME2,' IS GLOBAL'
+        VALSIZE2=1
+        ALLOCATE(VALCOP(VALSIZE2))
+        CALL LCMGET(KPMAP2,'P-VALUE',VALCOP)
+      ELSE
+        IF(IMPX.GE.1) WRITE(6,210) 'PARAMETER ',PNAME2,' IS LOCAL'
+        VALSIZE2=NCH2*NB2
+        ALLOCATE(VALCOP(VALSIZE2))
+        CALL LCMGET(KPMAP2,'P-VALUE',VALCOP)
+      ENDIF
+      IF(PTYPE.EQ.1.AND.PTYPE2.EQ.2) CALL XABORT('@MCCCPY: '//PNAME
+     >         //'IS GLOBAL ON THE CORE AND '//PNAME2//'IS LOCAL.')
+      IF(PTYPE.EQ.2.AND.PTYPE2.EQ.1) CALL XABORT('@MCCCPY: '//PNAME
+     >         //'IS LOCAL ON THE CORE AND '//PNAME2//'IS GLOBAL.')
+*
+* Modification of REC1
+
+      VALMOD(:)=VALCOP(:)
+
+      CALL LCMPUT(KPMAP,'P-VALUE',VALSIZE,2,VALMOD)
+
+      IF(IMPX.GT.0.AND.C_ASSOCIATED(IPMAP,IPMAP2)) THEN
+        WRITE(6,220) 'EVERY VALUE OF THE RECORD ',REC1,' HAS BEEN '
+     >             //'UPDATED WITH THE ONES FROM ',REC2,' (SAME '
+     >             //'FUEL MAP).'
+      ELSEIF(IMPX.GT.0.AND.C_ASSOCIATED(IPMAP,IPMAP2)) THEN
+        WRITE(6,220) 'EVERY VALUE OF THE RECORD ',REC1,' HAS BEEN '
+     >             //'UPDATED WITH THE ONES FROM ',REC2,' (FUEL '
+     >             //'MAP FLMAP2).'
+      ENDIF
+
+* Array deallocation
+      DEALLOCATE(VALMOD)
+      DEALLOCATE(VALCOP)
+
+      RETURN
+
+  210 FORMAT(1X,A,A6,A/)
+  220 FORMAT(1X,A,A6,A,A6,A/)
+      END
diff --git a/Donjon/src/MCCMOD.f b/Donjon/src/MCCMOD.f
new file mode 100644
index 0000000..c61c85b
--- /dev/null
+++ b/Donjon/src/MCCMOD.f
@@ -0,0 +1,96 @@
+*DECK MCCMOD
+      SUBROUTINE MCCMOD(IMPX,IPMAP,NPARAM,NCH,NB,REC1,VAL,MODTYPE)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Modification of the data stored in the PARAM folder of a fuel map
+*
+*Copyright:
+* Copyright (C) 2012 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* M. Cordiez
+*
+*Parameters: input
+* IMPX    printing index (=0 for no print).
+* IPMAP   pointer of the fuel map
+* NPARAM  number of parameters in the PARAM folder
+* NCH     number of fuel channels
+* NB      number of fuel bundles per channel
+* REC1    record to be updated
+* VAL    uniform value (real) that is to be set to REC1
+* MODTYPE type of modification (0: new uniform value, 2: value added)
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER IMPX,NPARAM,NCH,NB,MODTYPE
+      REAL VAL
+      CHARACTER REC1*40
+      TYPE(C_PTR) IPMAP
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER VALSIZE,PTYPE
+      CHARACTER PNAME*12
+      REAL, ALLOCATABLE, DIMENSION(:) :: VALMOD
+      TYPE(C_PTR) JPMAP,KPMAP
+*----
+*  RECOVERY OF L_MAP PARAMETERS
+*----
+      JPMAP=LCMGID(IPMAP,'PARAM')
+      DO IPAR=1,NPARAM,1
+        KPMAP=LCMGIL(JPMAP,IPAR)
+        CALL LCMGTC(KPMAP,'P-NAME',12,PNAME)
+        CALL LCMGET(KPMAP,'P-TYPE',PTYPE)
+        IF(PNAME.EQ.REC1) THEN
+          IF(IMPX.GE.3) CALL LCMLIB(KPMAP)
+          EXIT
+        ENDIF
+      ENDDO
+
+* Checking of the type (local or global) of REC1
+      IF((PTYPE.NE.1).AND.(PTYPE.NE.2)) THEN
+        CALL XABORT('@MCCMOD: '//PNAME//'IS NEITHER LOCAL NOR GLOBAL'
+     >         //'AND THAT IS IMPOSSIBLE.') 
+      ENDIF
+      IF(PTYPE.EQ.1) THEN
+        IF(IMPX.GE.1) WRITE(6,210) 'PARAMETER ',PNAME,' IS GLOBAL'
+        VALSIZE=1
+        ALLOCATE(VALMOD(VALSIZE))
+      ELSE
+        IF(IMPX.GE.1) WRITE(6,210) 'PARAMETER ',PNAME,' IS LOCAL'
+        VALSIZE=NCH*NB
+        ALLOCATE(VALMOD(VALSIZE))
+      ENDIF
+
+* Modification of REC1
+      IF(MODTYPE.EQ.0) THEN
+        VALMOD=VAL
+      ELSE IF(MODTYPE.EQ.1) THEN
+        CALL LCMGET(KPMAP,'P-VALUE',VALMOD)
+        VALMOD=VALMOD+VAL
+      ENDIF
+
+      CALL LCMPUT(KPMAP,'P-VALUE',VALSIZE,2,VALMOD)
+
+      IF((MODTYPE.EQ.0).AND.(IMPX.GT.0)) THEN
+        WRITE(6,220) 'EVERY VALUE OF THE RECORD ',REC1,' HAS BEEN '
+     >             //'SET TO ',VAL,'.'
+      ELSE IF((MODTYPE.EQ.1).AND.(IMPX.GT.0)) THEN
+        WRITE(6,220) 'EVERY VALUE OF THE RECORD ',REC1,' HAS BEEN '
+     >             //'INCREASED OF ',VAL,'.'
+      ENDIF
+
+* Array deallocation
+      DEALLOCATE(VALMOD)
+
+      RETURN
+
+  210 FORMAT(1X,A,A6,A/)
+  220 FORMAT(1X,A,A6,A,F7.2,A/)
+      END
diff --git a/Donjon/src/MCR.f b/Donjon/src/MCR.f
new file mode 100644
index 0000000..52ec6c1
--- /dev/null
+++ b/Donjon/src/MCR.f
@@ -0,0 +1,564 @@
+*DECK MCR
+      SUBROUTINE MCR(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover and interpolate Microlib or Macrolib information from one or
+* many MPO database files.
+*
+*Copyright
+* Copyright (C) 2022 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file;
+*         IENTRY=6 for HDF5 file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The MCR: calling specifications are:
+* MLIB := MCR: [ { MLIB | MLIB2 } ] MPONAM1 [[ MPONAM2 ]] [ MAPFL ] 
+*   :: (mcr\_data) ; \\
+* where
+*   MLIB : name of a \emph{microlib} (type L\_LIBRARY) or \emph{macrolib} 
+*     (type L\_MACROLIB) containing the interpolated data. If this object also 
+*     appears on the RHS of structure (MCR:, it is open in modification mode 
+*     and updated.
+*   MLIB2 : name of an optional \emph{microlib} object whose content is copied 
+*     on MLIB.
+*   MPONAM1 : name of the \emph{MPO file} data structure.
+*   MPONAM2 : name of an additional \emph{MPO file} data structure. This
+*     object is optional.
+*   MAPFL : name of the \emph{map} object containing fuel regions description, 
+*     global parameter information (burnup, fuel/coolant temperatures, coolant 
+*     density, etc). Keyword TABLE is expected in (mcr\_data).
+*   mcr\_data : input data structure containing interpolation information.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      USE hdf5_wrap
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXR=12
+      INTEGER, PARAMETER::NSTATE=40
+      REAL B2, FLOTT
+      INTEGER ITYLCM, MAXISO, MAXNIS, NBISO, MY1, MY2, NB, NCAL, NCH,
+     > NCOMB, NDEPL, NDFI, NDFP, NFUEL, NGRP, NHEAVY, IBM, NISOS, NITMA,
+     > NLIGHT, NMIL, NMIX, NOTHER, NPARM, NPAR, NLOC, NREAC, NSTABL,
+     > NSURFD, NVTOT, NREA, NPRC, ADDRZI, ISO,ISOM,NISOM, IMPX, ILONG,
+     > IMPY, INDIC, ITER, ITEXT4, I, IACCS, ITH, J, NBESP, NALBP, ILUPS
+      CHARACTER TEXT4*4,TEXT12*12,HSMG*131,HSIGN*12,HEQUI*80,HMASL*80,
+     > NMDEPL(MAXR)*8,HEDIT*12,RECNAM*80
+      LOGICAL LADFM,LMACRO,LCUBIC,LRES,LPURE
+      DOUBLE PRECISION DFLOTT
+      INTEGER ISTATE(NSTATE)
+      TYPE(C_PTR) IPMAP,IPMPO,IPLIB,IPLIB2
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: MIXC,NISO,LISO,IADRY,ITNAM,
+     1 ITZEA,MATNO,KPAX,INAM,IZAE,HREAC,IDR,KPAR,ITODO,ISOTOPE,DIMS_MPO,
+     2 ADDRISO
+      REAL, ALLOCATABLE, DIMENSION(:) :: CONC,BPAX,RER,RRD,BPAR,YIELD
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: TERP
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: VTOT
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: DECAY
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:) :: YLDS
+      CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: NOMIS
+      CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:,:) :: HISO
+      CHARACTER(LEN=24), ALLOCATABLE, DIMENSION(:) :: TEXT24
+*
+      SAVE      NMDEPL
+      DATA      NMDEPL/'DECAY   ','NFTOT   ','NG      ','N2N     ',
+     >                 'N3N     ','N4N     ','NA      ','NP      ',
+     >                 'N2A     ','NNP     ','ND      ','NT      '/
+*----
+*  PARAMETER VALIDATION
+*----
+      IF(NENTRY.LE.1) CALL XABORT('MCR: MINIMUM OF 2 OBJECTS EXPECTED.')
+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('MCR: MACRO'
+     1 //'LIB LCM OBJECT EXPECTED AT LHS.')
+      IF((JENTRY(1).NE.0).AND.(JENTRY(1).NE.1)) CALL XABORT('MCR: MACRO'
+     1 //'LIB IN CREATE OR MODIFICATION MODE EXPECTED.')
+      IACCS=JENTRY(1)
+      IPLIB=KENTRY(1)
+      IPLIB2=C_NULL_PTR
+      IPMAP=C_NULL_PTR
+      NGRP=0
+      NMIX=0
+      IF(IACCS.EQ.1) THEN
+        CALL LCMGTC(IPLIB,'SIGNATURE',12,HSIGN)
+        IF(HSIGN.EQ.'L_LIBRARY') THEN
+          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+          NGRP=ISTATE(3)
+          NMIX=ISTATE(1)
+        ELSE IF(HSIGN.EQ.'L_MACROLIB') THEN
+          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+          NGRP=ISTATE(1)
+          NMIX=ISTATE(2)
+        ELSE
+          TEXT12=HENTRY(1)
+          CALL XABORT('MCR: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     1    '. L_LIBRARY OR L_MACROLIB EXPECTED.')
+        ENDIF
+      ENDIF
+      DO 10 I=2,NENTRY
+        IF((IENTRY(I).NE.1).AND.(IENTRY(I).NE.2).AND.(IENTRY(I).NE.6))
+     1  THEN
+          CALL XABORT('MCR: LCM OR HDF5 OBJECTS EXPECTED AT RHS.')
+        ENDIF
+        IF(JENTRY(I).NE.2) CALL XABORT('MCR:OBJECTS IN READ-ONLY MODE '
+     1 //'EXPECTED AT RHS.')
+        IF((IENTRY(I).EQ.1).OR.(IENTRY(I).EQ.2)) THEN
+          CALL LCMGTC(KENTRY(I),'SIGNATURE',12,HSIGN)
+          IF(HSIGN.EQ.'L_LIBRARY') THEN
+            IF(C_ASSOCIATED(IPLIB2)) CALL XABORT('MCR: ONLY ONE MICROL'
+     1      //'IB EXPECTED AT RHS.')
+            IPLIB2=KENTRY(I)
+            GO TO 10
+          ELSE IF(HSIGN.EQ.'L_MACROLIB') THEN
+            CALL XABORT('MCR: ANOTHER MACROLIB NOT EXPECTED AT RHS.')
+          ELSE IF(HSIGN.EQ.'L_MAP') THEN
+            IF(I.NE.NENTRY)CALL XABORT('MCR: FUEL-MAP EXPECTED TO BE T'
+     1      //'HE LAST OBJECT.')
+            IF(NENTRY.LT.3)CALL XABORT('MCR: MISSING MPO FILE.')
+            IPMAP=KENTRY(NENTRY)
+            CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+            NMIX=ISTATE(9)
+          ENDIF
+        ENDIF
+   10 CONTINUE
+*----
+*  READ THE INPUT DATA
+*----
+      NVTOT=0
+      LMACRO=.TRUE.
+      LCUBIC=.FALSE.
+      LRES=.FALSE.
+      LPURE=.FALSE.
+      B2=0.0
+      ITER=-1
+      IPMPO=C_NULL_PTR
+      HEQUI=' '
+      HMASL=' '
+      ILUPS=0
+      LADFM=.TRUE.
+      IMPX=1
+   20 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+      IF(INDIC.NE.3) CALL XABORT('MCR: CHARACTER DATA EXPECTED(1).')
+   30 IF(TEXT12.EQ.'EDIT') THEN
+*       READ THE PRINT INDEX.
+        CALL REDGET(INDIC,IMPX,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1) CALL XABORT('MCR: INTEGER DATA EXPECTED(1).')
+      ELSE IF(TEXT12.EQ.'NMIX') THEN
+*       READ THE MAXIMUM NUMBER OF MATERIAL MIXTURES.
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1) CALL XABORT('MCR: INTEGER DATA EXPECTED(2).')
+        IF(NITMA.LT.NMIX) THEN
+           WRITE(HSMG,'(20HMCR: NMIX MUST BE >=,I8)') NMIX
+           CALL XABORT(HSMG)
+        ENDIF
+        NMIX=NITMA
+      ELSE IF(TEXT12.EQ.'MACRO') THEN
+        LMACRO=.TRUE.
+      ELSE IF(TEXT12.EQ.'MICRO') THEN
+        LMACRO=.FALSE.
+      ELSE IF(TEXT12.EQ.'LINEAR') THEN
+        LCUBIC=.FALSE.
+      ELSE IF(TEXT12.EQ.'CUBIC') THEN
+        LCUBIC=.TRUE.
+      ELSE IF(TEXT12.EQ.'RES') THEN
+        IF((IACCS.EQ.0).AND.(.NOT.C_ASSOCIATED(IPLIB2))) THEN
+          CALL XABORT('MCR: RHS MICROLIB EXPECTED WITH RES OPTION.')
+        ENDIF
+        LRES=.TRUE.
+      ELSE IF(TEXT12.EQ.'PURE') THEN
+        LPURE=.TRUE.
+      ELSE IF(TEXT12.EQ.'UPS') THEN
+        ILUPS=1
+      ELSE IF(TEXT12.EQ.'MDF') THEN
+        LADFM=.FALSE.
+      ELSE IF(TEXT12.EQ.'MPO') THEN
+        IF(NMIX.EQ.0) CALL XABORT('MCR: ZERO NUMBER OF MIXTURES.')
+        IF(C_ASSOCIATED(IPMAP)) THEN
+          WRITE(IOUT,'(/43H MCR: ***WARNING*** A FUEL MAP IS SET AT RH,
+     1    26HS; KEYWORD TABLE EXPECTED.)')
+        ENDIF
+        IF((IACCS.EQ.0).AND.(C_ASSOCIATED(IPLIB2))) THEN
+          CALL LCMEQU(IPLIB2,IPLIB)
+          IACCS=1
+        ENDIF
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3) CALL XABORT('MCR: CHARACTER DATA EXPECTED(2).')
+        CALL REDGET(INDIC,NITMA,FLOTT,HEDIT,DFLOTT)
+        IF(INDIC.NE.3) CALL XABORT('MCR: CHARACTER DATA EXPECTED(3).')
+        IF(HEDIT.EQ.'default') HEDIT='output_0'
+        ITH=0
+        DO 50 I=2,NENTRY
+          IF(C_ASSOCIATED(KENTRY(I),IPLIB2)) GO TO 50
+          IF(TEXT12.EQ.HENTRY(I)) THEN
+            IPMPO=KENTRY(I)
+            ITH=I
+            GO TO 60
+          ENDIF
+   50   CONTINUE
+        CALL XABORT('MCR: MPO '//TEXT12//' NOT FOUND.')
+   60   WRITE(IOUT,320) HENTRY(ITH)
+        CALL MPOTOC(IPMPO,HEDIT,IMPX,NREA,NBISO,NMIL,NPAR,NLOC,MY1,MY2,
+     1  NISOS,NCAL,NGRP,NSURFD,NALBP,NPRC)
+        ALLOCATE(MIXC(NMIX),NISO(NMIX),LISO(NMIX),HISO(NMIX,NBISO),
+     1  ITODO(NMIX*NBISO))
+        ALLOCATE(TERP(NCAL,NMIX),CONC(NMIX*NBISO))
+*
+        CALL MCRDRV(IPMPO,LCUBIC,NMIX,IMPX,NMIL,NCAL,NBISO,NPAR,HEDIT,
+     1  ITER,MAXNIS,MIXC,TERP,NISO,LISO,HISO,CONC,ITODO)
+        GO TO 130
+      ELSE IF(TEXT12.EQ.'TABLE') THEN
+        IF(.NOT.C_ASSOCIATED(IPMAP)) CALL XABORT('MCR: MISSING FUEL-MA'
+     1  //'P OBJECT.')
+        ISTATE(:NSTATE)=0
+        CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+        NB=ISTATE(1)
+        NCH=ISTATE(2)
+        NCOMB=ISTATE(3)
+        NGRP=ISTATE(4)
+        NFUEL=ISTATE(7)
+        NPARM=ISTATE(8)
+        IF(NCOMB.EQ.0) CALL XABORT('MCR: NUMBER OF COMBUSTION ZONES NO'
+     1   //'T YET DEFINED IN THE FUEL MAP NCOMB=0.')
+        IF((IACCS.EQ.0).AND.(C_ASSOCIATED(IPLIB2))) THEN
+          CALL LCMEQU(IPLIB2,IPLIB)
+          IACCS=1
+        ENDIF
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3) CALL XABORT('MCR: CHARACTER DATA EXPECTED(4).')
+        CALL REDGET(INDIC,NITMA,FLOTT,HEDIT,DFLOTT)
+        IF(INDIC.NE.3) CALL XABORT('MCR: CHARACTER DATA EXPECTED(5).')
+        IF(HEDIT.EQ.'default') HEDIT='output_0'
+        ITH=0
+        DO 80 I=2,NENTRY
+          IF((C_ASSOCIATED(KENTRY(I),IPLIB2)).OR.
+     1       (C_ASSOCIATED(KENTRY(I),IPMAP))) GO TO 80
+          IF(TEXT12.EQ.HENTRY(I)) THEN
+            IPMPO=KENTRY(I)
+            ITH=I
+            GO TO 90
+          ENDIF
+   80   CONTINUE
+        CALL XABORT('MCR: MPO FILE '//TEXT12//' NOT FOUND.')
+   90   WRITE(IOUT,320) HENTRY(ITH)
+        CALL MPOTOC(IPMPO,HEDIT,IMPX,NREA,NBISO,NMIL,NPAR,NLOC,MY1,MY2,
+     1  NISOS,NCAL,NGRP,NSURFD,NALBP,NPRC)
+        IF(NPAR.EQ.0) CALL XABORT('MCR: NO PARAMETERS IN MPO FILE(2).')
+        ALLOCATE(MIXC(NMIX),NISO(NMIX),LISO(NMIX),HISO(NMIX,NBISO),
+     1  ITODO(NMIX*NBISO))
+        ALLOCATE(TERP(NCAL,NMIX),CONC(NMIX*NBISO))
+*
+        CALL MCRRGR(IPMPO,IPMAP,LCUBIC,NMIX,IMPX,NMIL,NCAL,NBISO,NCH,NB,
+     1  NFUEL,NPARM,NPAR,HEDIT,ITER,MAXNIS,MIXC,TERP,NISO,LISO,HISO,
+     2  CONC,ITODO)
+        GO TO 130
+      ELSE IF(TEXT12.EQ.'EQUI') THEN
+         CALL REDGET(INDIC,NITMA,FLOTT,HEQUI,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('MCR: CHARACTER DATA EXPECTED(6).')
+      ELSE IF(TEXT12.EQ.'MASL') THEN
+         CALL REDGET(INDIC,NITMA,FLOTT,HMASL,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('MCR: CHARACTER DATA EXPECTED(7)')
+      ELSE IF(TEXT12.EQ.'LEAK') THEN
+        CALL REDGET(INDIC,NITMA,B2,TEXT12,DFLOTT)
+        IF(INDIC.NE.2) CALL XABORT('MCR: REAL DATA EXPECTED.')
+      ELSE IF(TEXT12.EQ.'CHAIN') THEN
+        IF(LMACRO) CALL XABORT('MCR: MICRO KEYWORD EXPECTED.')
+        CALL MPOTOC(IPMPO,HEDIT,0,NREA,NBISO,NMIL,NPAR,NLOC,MY1,MY2,
+     1  NISOS,NCAL,NGRP,NSURFD,NALBP,NPRC)
+        IF(NBISO.EQ.0) CALL XABORT('MCR: NO PARTICULARIZED ISOTOPES.')
+        CALL LCMLEN(IPLIB,'VTOT_',ILONG,ITYLCM)
+        IF(ILONG.NE.NVTOT) CALL XABORT('MCR: INVALID LENGTH: VTOT(1).')
+        CALL LCMLEN(IPLIB,'YLDS_',ILONG,ITYLCM)
+        IF(ILONG.NE.MY1*MY2*NVTOT) CALL XABORT('MCR: INVALID LENGTH: Y'
+     1  //'LDS(1).')
+        CALL LCMLEN(IPLIB,'DECAYC_',ILONG,ITYLCM)
+        IF(ILONG.NE.NBISO*NVTOT) CALL XABORT('MCR: INVALID LENGTH: DEC'
+     1  //'AYC(1)')
+        ALLOCATE(VTOT(NVTOT),YLDS(MY1,MY2,NVTOT),DECAY(NBISO,NVTOT),
+     1  NOMIS(NBISO))
+        CALL LCMGET(IPLIB,'VTOT_',VTOT)
+        CALL LCMGET(IPLIB,'YLDS_',YLDS)
+        CALL LCMGET(IPLIB,'DECAYC_',DECAY)
+        WRITE(RECNAM,'(8H/output/,A,6H/info/)') TRIM(HEDIT)
+        CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"ISOTOPE",ISOTOPE)
+        CALL hdf5_read_data(IPMPO,"contents/isotopes/ISOTOPENAME",
+     1  TEXT24)
+        CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"ADDRISO",ADDRISO)
+        DO I=1,NBISO
+          NOMIS(I)=TEXT24(ISOTOPE(I)+1)(:8)
+        ENDDO
+        DEALLOCATE(TEXT24)
+        ALLOCATE(IADRY(NBISO))
+        IADRY(:NBISO)=0
+        DO IBM=1,NMIL
+          WRITE(RECNAM,'(8H/output/,A,9H/statept_,I0,6H/zone_,I0,1H/)')
+     1    TRIM(HEDIT),0,IBM-1
+          IF(hdf5_group_exists(IPMPO,TRIM(RECNAM)//"yields")) THEN
+            CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"ADDRZI",ADDRZI)
+            NISOM=ADDRISO(ADDRZI+2)-ADDRISO(ADDRZI+1)
+            CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"yields/ADDRY",
+     1      DIMS_MPO)
+            DO ISOM=1,NISOM
+              ISO=ADDRISO(ADDRZI+1)+ISOM
+              IADRY(ISO)=DIMS_MPO(ISOM)
+            ENDDO
+            DEALLOCATE(DIMS_MPO)
+          ENDIF
+        ENDDO
+        DEALLOCATE(ADDRISO)
+*
+        NBESP=1
+        ALLOCATE(ITNAM(3*NBISO),ITZEA(NBISO),MATNO(NBISO),
+     1  KPAX((NBISO+MAXR)*NBISO),BPAX((NBISO+MAXR)*NBISO*NBESP))
+        TEXT4='    '
+        READ(TEXT4,'(A4)') ITEXT4
+        ITNAM(:3*NBISO)=ITEXT4
+        ITZEA(:NBISO)=0
+        MATNO(:NBISO)=0
+        KPAX(:(NBISO+MAXR)*NBISO)=0
+        BPAX(:(NBISO+MAXR)*NBISO*NBESP)=0.0
+        CALL SCREIR(NMDEPL,MY1,MY2,1,NBISO,NOMIS,IADRY,NVTOT,VTOT,YLDS,
+     1              DECAY,ITNAM,ITZEA,KPAX,BPAX)
+        DEALLOCATE(IADRY,NOMIS,DECAY,YLDS,VTOT)
+        CALL LIBWET(MAXR,NBISO,NBESP,NSTATE,NMDEPL,ITNAM,ISTATE,MATNO,
+     1  KPAX,BPAX)
+        NDEPL=ISTATE(1)
+        NDFI=ISTATE(2)
+        NDFP=ISTATE(3)
+        NHEAVY=ISTATE(4)
+        NLIGHT=ISTATE(5)
+        NOTHER=ISTATE(6)
+        NSTABL=ISTATE(7)
+        NREAC=ISTATE(8)
+        NPAR=ISTATE(9)
+        NBESP=MAX(1,ISTATE(10))
+*----
+*  ALLOCATE DECAY CHAIN
+*----
+        NDEPL=MAX(NDEPL,1)
+        NDFI=MAX(NDFI,1)
+        NDFP=MAX(NDFP,1)
+        ALLOCATE(INAM(3*NDEPL),IZAE(NDEPL),IDR(NREAC*NDEPL),
+     1  RER(NREAC*NDEPL),RRD(NDEPL),KPAR(NPAR*NDEPL),BPAR(NPAR*NDEPL),
+     2  YIELD(NDFI*NDFP*NBESP))
+*----
+*  SET DECAY CHAIN
+*----
+        CALL LIBWED(MAXR,NBISO,NBESP,NDEPL,NDFI,NDFP,NHEAVY,NLIGHT,
+     >              NOTHER,NREAC,NPAR,ITNAM,ITZEA,MATNO,KPAX,BPAX,
+     >              INAM,IZAE,IDR,RER,RRD,KPAR,BPAR,YIELD)
+*----
+*  RELEASE WORK VECTORS FOR WIMS-AECL, WIMS-NEA, DRAGLIB
+*  AND INPUT FILE
+*----
+        DEALLOCATE(BPAX,KPAX,MATNO,ITZEA,ITNAM)
+*----
+*  SELECT USED DEPLETION REACTION NAMES
+*----
+        ALLOCATE(HREAC(2*NREAC))
+        DO 100 I=1,NREAC
+          READ(NMDEPL(I),'(2A4)') (HREAC(2*(I-1)+J),J=1,2)
+  100   CONTINUE
+*----
+*  PRINT DECAY CHAIN IF REQUIRED
+*----
+        IMPY=IMPX+2
+        CALL LIBEPR(IMPY,NDEPL,NBESP,NSTABL,NDFI,NDFP,NREAC,NPAR,
+     >              INAM,HREAC,IDR,RER,RRD,KPAR,BPAR,YIELD,IZAE)
+*----
+*  SAVE CHAIN
+*----
+        CALL LCMSIX(IPLIB,'DEPL-CHAIN',1)
+        CALL LCMPUT(IPLIB,'STATE-VECTOR',NSTATE,1,ISTATE)
+        NDEPL=ISTATE(1)
+        CALL LCMPUT(IPLIB,'ISOTOPESDEPL',3*NDEPL,3,INAM)
+        CALL LCMPUT(IPLIB,'CHARGEWEIGHT',NDEPL,1,IZAE)
+        CALL LCMPUT(IPLIB,'DEPLETE-IDEN',2*NREAC,3,HREAC)
+        CALL LCMPUT(IPLIB,'DEPLETE-REAC',NREAC*NDEPL,1,IDR)
+        CALL LCMPUT(IPLIB,'DEPLETE-ENER',NREAC*NDEPL,2,RER)
+        CALL LCMPUT(IPLIB,'DEPLETE-DECA',NDEPL,2,RRD)
+        CALL LCMPUT(IPLIB,'PRODUCE-REAC',NPAR*NDEPL,1,KPAR)
+        CALL LCMPUT(IPLIB,'PRODUCE-RATE',NPAR*NDEPL,2,BPAR)
+        IF(NDFP.GT.0) CALL LCMPUT(IPLIB,'FISSIONYIELD',NDFI*NDFP*NBESP,
+     >  2,YIELD)
+        CALL LCMSIX(IPLIB,' ',2)
+        CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+        ISTATE(11)=NDEPL
+        CALL LCMPUT(IPLIB,'STATE-VECTOR',NSTATE,1,ISTATE)
+*----
+*  DEALLOCATE DECAY CHAIN ARRAYS
+*----
+        DEALLOCATE(YIELD,BPAR,KPAR,RRD,RER,IDR,IZAE,INAM)
+      ELSE IF(TEXT12.EQ.';') THEN
+        GO TO 200
+      ELSE
+        CALL XABORT('MCR: '//TEXT12//' IS AN INVALID KEYWORD.')
+      ENDIF
+      GO TO 20
+*----
+*  PERFORM MULTIPARAMETER INTERPOLATION
+*----
+  130 CALL MPOTOC(IPMPO,HEDIT,0,NREA,NBISO,NMIL,NPAR,NLOC,MY1,MY2,
+     1 NISOS,NCAL,NGRP,NSURFD,NALBP,NPRC)
+*----
+*  BUILD THE INTERPOLATED MACROLIB
+*----
+      IF(LMACRO.AND.(MAXNIS.EQ.0)) THEN
+*       build a macrolib
+        CALL MCRMAC(IPLIB,IPMPO,IACCS,NMIL,NMIX,NGRP,LADFM,IMPX,HEQUI,
+     1  HMASL,NCAL,HEDIT,NSURFD,NALBP,ILUPS,MIXC,TERP,LPURE,B2)
+      ELSE
+*       build a microlib
+        IF(LMACRO)THEN
+          CALL LCMOP(IPLIB,'*TEMPORARY*',0,1,0)
+          IACCS=0
+        ENDIF
+        IF(IACCS.EQ.0)THEN
+          MAXISO=NBISO*NMIX
+        ELSE
+          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+          MAXISO=MAX(NBISO*NMIX,ISTATE(2))
+        ENDIF
+        NVTOT=NVTOT+1
+        ALLOCATE(VTOT(NVTOT),YLDS(MY1,MY2,NVTOT),DECAY(NBISO,NVTOT))
+        IF(NVTOT.GT.1) THEN
+          CALL LCMLEN(IPLIB,'VTOT_',ILONG,ITYLCM)
+          IF(ILONG.NE.NVTOT-1) CALL XABORT('MCR: INVALID LENGTH: VTOT('
+     1    //'2).')
+          CALL LCMLEN(IPLIB,'YLDS_',ILONG,ITYLCM)
+          IF(ILONG.NE.MY1*MY2*(NVTOT-1)) CALL XABORT('MCR: INVALID LEN'
+     1    //'GTH: YLDS(2).')
+          CALL LCMGET(IPLIB,'VTOT_',VTOT)
+          IF(MY1*MY2.GT.0) CALL LCMGET(IPLIB,'YLDS_',YLDS)
+          IF(NBISO.GT.0) CALL LCMGET(IPLIB,'DECAYC_',DECAY)
+        ENDIF
+        CALL MCRLIB(MAXNIS,MAXISO,IPLIB,IPMPO,IACCS,NMIX,NGRP,LADFM,
+     1  IMPX,HEQUI,HMASL,NCAL,HEDIT,ITER,MY1,MY2,NBISO,TERP,NISO,LISO,
+     2  HISO,CONC,ITODO,MIXC,LRES,LPURE,ILUPS,B2,VTOT(NVTOT),
+     3  YLDS(1,1,NVTOT),DECAY(1,NVTOT))
+        CALL LCMPUT(IPLIB,'VTOT_',NVTOT,4,VTOT)
+        IF(MY1*MY2.GT.0) THEN
+          CALL LCMPUT(IPLIB,'YLDS_',MY1*MY2*NVTOT,4,YLDS)
+        ENDIF
+        IF(NBISO.GT.0) CALL LCMPUT(IPLIB,'DECAYC_',NBISO*NVTOT,4,DECAY)
+        DEALLOCATE(VTOT,DECAY,YLDS)
+        IF(LMACRO) THEN
+          CALL LCMVAL(IPLIB,' ')
+          CALL LCMSIX(IPLIB,'MACROLIB',1)
+          CALL LCMEQU(IPLIB,KENTRY(1))
+          CALL LCMSIX(IPLIB,' ',2)
+          CALL LCMCL(IPLIB,2)
+        ENDIF
+      ENDIF
+      DEALLOCATE(LISO,NISO,HISO,ITODO,CONC,TERP,MIXC)
+*----
+*  PRINT THE STATE VECTOR
+*----
+      IF(IMPX.GT.0) THEN
+        IF(LMACRO) THEN
+          CALL LCMGET(KENTRY(1),'STATE-VECTOR',ISTATE)
+          WRITE(IOUT,290) IMPX,(ISTATE(I),I=1,7),ISTATE(9),ISTATE(12)
+          IF(IMPX.GT.3) CALL LCMLIB(KENTRY(1))
+        ELSE
+          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+          WRITE(IOUT,300) IMPX,(ISTATE(I),I=1,12)
+          WRITE(IOUT,310) (ISTATE(I),I=13,15),(ISTATE(I),I=17,24)
+          IF(IMPX.GT.3) CALL LCMLIB(IPLIB)
+        ENDIF
+        IF(.NOT.LADFM) WRITE(IOUT,'(31H FORCE USE OF MATRIX DISCONTINU,
+     1  12HITY FACTORS.)')
+      ENDIF
+*----
+*  CONTINUE DATA PROCESSING
+*----
+      IF(ITER.EQ.0) THEN
+        GO TO 200
+      ELSE IF(ITER.EQ.1) THEN
+        TEXT12='MPO'
+        GO TO 30
+      ELSE IF(ITER.EQ.2) THEN
+        TEXT12='TABLE'
+        GO TO 30
+      ELSE IF(ITER.EQ.3) THEN
+        TEXT12='CHAIN'
+        GO TO 30
+      ENDIF
+*----
+*  LEAVE MCR:
+*----
+  200 RETURN
+*
+  290 FORMAT(/8H OPTIONS/8H -------/
+     1 7H IMPX  ,I6,30H   (0=NO PRINT/1=SHORT/2=MORE)/
+     2 7H NGROUP,I6,28H   (NUMBER OF ENERGY GROUPS)/
+     3 7H NBMIX ,I6,39H   (NUMBER OF MIXTURES IN THE MACROLIB)/
+     4 7H NANISO,I6,34H   (MAXIMUM SCATTERING ANISOTROPY)/
+     5 7H NIFISS,I6,45H   (MAXIMUM NUMBER OF FISSILE ISOTOPES IN A M,
+     6 7HIXTURE)/
+     7 7H NEDMAC,I6,34H   (NUMBER OF CROSS SECTION EDITS)/
+     8 7H ITRANC,I6,45H   (0=NO TRANSPORT CORRECTION/1=APOLLO TYPE/2,
+     9 43H=RECOVER FROM LIBRARY/4=LEAKAGE CORRECTION)/
+     1 7H NLG   ,I6,39H   (NUMBER OF DELAYED PRECURSOR GROUPS)/
+     2 7H ILEAK ,I6,40H   (1=DIFF AVAILABLE; 2=DIFFX AVAILABLE)/
+     3 7H IDF   ,I6,47H   (0=NO INFO/1=ALBS INFO/2=FLUX GAP INFO/3=ADF,
+     4 32H GAP INFO/4=MATRIX ADF GAP INFO))
+  300 FORMAT(/8H OPTIONS/8H -------/
+     1 7H IMPX  ,I6,30H   (0=NO PRINT/1=SHORT/2=MORE)/
+     2 7H MAXMIX,I6,31H   (MAXIMUM NUMBER OF MIXTURES)/
+     3 7H NBISO ,I6,36H   (NUMBER OF ISOTOPES OR MATERIALS)/
+     4 7H NGRP  ,I6,28H   (NUMBER OF ENERGY GROUPS)/
+     5 7H NL    ,I6,30H   (NUMBER OF LEGENDRE ORDERS)/
+     6 7H ITRANC,I6,45H   (0=NO TRANSPORT CORRECTION/1=APOLLO TYPE/2,
+     7 57H=RECOVER FROM LIBRARY/3=WIMS-D TYPE/4=LEAKAGE CORRECTION)/
+     8 7H IPROB ,I6,23H   (0=DIRECT/1=ADJOINT)/
+     9 7H ITIME ,I6,28H   (1=STEADY-STATE/2=PROMPT)/
+     1 7H NLIB  ,I6,32H   (NUMBER OF SETS OF LIBRARIES)/
+     2 7H NGF   ,I6,48H   (NUMBER OF FAST GROUP WITHOUT SELF-SHIELDING)/
+     3 7H IGRMAX,I6,41H   (LAST GROUP INDEX WITH SELF-SHIELDING)/
+     4 7H NDEPL ,I6,33H   (NUMBER OF DEPLETING ISOTOPES)/
+     5 7H NCOMB ,I6,33H   (NUMBER OF DEPLETING MIXTURES))
+  310 FORMAT(7H NEDMAC,I6,34H   (NUMBER OF CROSS SECTION EDITS)/
+     1 7H NBMIX ,I6,23H   (NUMBER OF MIXTURES)/
+     2 7H NRES  ,I6,40H   (NUMBER OF SETS OF RESONANT MIXTURES)/
+     3 7H IPROC ,I6,48H   (-1=SKIP LIBRARY PROCESSING/0=DILUTION INTERP,
+     4 48HOLATION/1=USE PHYSICAL TABLES/2=BUILD A DRAGLIB/,
+     5 55H3=COMPUTE CALENDF TABLES/4=COMPUTE SLOWING-DOWN TABLES)/
+     6 7H IMAC  ,I6,45H   (0=DO NOT/1=DO BUILD AN EMBEDDED MACROLIB)/
+     7 7H NDEL  ,I6,31H   (NUMBER OF PRECURSOR GROUPS)/
+     8 7H NFISS ,I6,31H   (NUMBER OF FISSILE ISOTOPES)/
+     9 7H ISOADD,I6,37H   (0=COMPLETE BURNUP CHAIN/1=DO NOT)/
+     1 7H MAXISM,I6,40H   (MAX. NUMBER OF ISOTOPES PER MIXTURE)/
+     2 7H IPRECI,I6,34H   (CALENDF ACCURACY FLAG:1/2/3/4)/
+     3 7H IDF   ,I6,47H   (0=NO INFO/1=ALBS INFO/2=FLUX GAP INFO/3=ADF,
+     4 32H GAP INFO/4=MATRIX ADF GAP INFO))
+  320 FORMAT(/30H MCR: INTERPOLATING MPO FILE ',A12,2H'.)
+      END
diff --git a/Donjon/src/MCRAGF.f b/Donjon/src/MCRAGF.f
new file mode 100644
index 0000000..3c780f6
--- /dev/null
+++ b/Donjon/src/MCRAGF.f
@@ -0,0 +1,504 @@
+*DECK MCRAGF
+      SUBROUTINE MCRAGF(IPMAC,IPMPO,IACCS,NMIL,NMIX,NGRP,NALBP,LALBG,
+     1 LADFM,IMPX,NCAL,TERP,MIXC,NSURFD,HEDIT,VOSAP,VOLMI2,IDF)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Build the macrolib by scanning the NCAL elementary calculations and
+* weighting them with TERP factors. ADF and physical albedos part.
+*
+*Copyright:
+* Copyright (C) 2022 Ecole Polytechnique de Montreal
+*
+*Author(s):
+* A. Hebert
+*
+*Parameters: input
+* IPMAC   address of the output macrolib LCM object.
+* IPMPO   address of the MPO file.
+* IACCS   =0 macrolib is created; =1 ... is updated.
+* NMIL    number of material mixtures in the MPO file.
+* NMIX    maximum number of material mixtures in the macrolib.
+* NGRP    number of energy groups.
+* NALBP   number of physical albedos per energy group.
+* LALBG   type of physical albedos (.true.: diagonal; .false.: GxG).
+* LADFM   type of discontinuity factors (.true.: diagonal; .false.: GxG).
+* IMPX    print parameter (equal to zero for no print).
+* NCAL    number of elementary calculations in the MPO file.
+* TERP    interpolation factors.
+* MIXC    mixture index in the MPO file corresponding to each macrolib
+*         mixture. Equal to zero if a macrolib mixture is not updated.
+* NSURFD  number of discontinuity factors.
+* HEDIT   name of output group for a (multigroup mesh, output geometry)
+*         couple (generally equal to 'output_0').
+* VOSAP   zone volumes in the MPO file.
+* VOLMI2  mixture volumes in the macrolib.
+*
+*Parameters: output
+* IDF     type of discontinuity factors (DF) in the macrolib (=0: not
+*         used; =3: DF used; =4 matrix DF used). 
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      USE hdf5_wrap
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAC,IPMPO
+      INTEGER IACCS,NMIL,NMIX,NGRP,NALBP,IMPX,NCAL,MIXC(NMIX),NSURFD,IDF
+      REAL TERP(NCAL,NMIX),VOSAP(NMIL),VOLMI2(NMIX)
+      LOGICAL LALBG,LADFM
+      CHARACTER(LEN=12) HEDIT
+*----
+*  LOCAL VARIABLES
+*----
+      REAL WEIGHT,FACTOR
+      CHARACTER RECNAM*80,HSMG*131
+      INTEGER IKEFF,IKINF,I,IBM,IBMOLD,ICAL,IGR,JGR,ILONG,ITYLCM,IAL,
+     1 RANK,NBYTE,TYPE,TYPE2,TYPE4,DIMSR(5),NSURFD_OLD,NITMA
+      LOGICAL LNEW
+      DOUBLE PRECISION DGAR1,DGAR2
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      REAL, ALLOCATABLE, DIMENSION(:) :: GAR4,ZKINF,ZKEFF,VREAL
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: GAR6,ALBP,AVGFL2,DISFAC,VFLUX
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ADF2,ALBP2,ALBP_ERM,SFLUX
+      REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: ADF2M,ALBP2_E
+      CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: HADF
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(GAR4(NGRP*NGRP),GAR6(NGRP,2),ALBP2(NMIX,NALBP,NGRP),
+     1 ALBP2_E(NMIX,NALBP,NGRP,NGRP),ZKINF(NMIX),ZKEFF(NMIX),
+     2 HADF(NSURFD),ADF2(NMIX,NGRP,NSURFD),ADF2M(NMIX,NGRP,NGRP,NSURFD),
+     3 AVGFL2(NMIX,NGRP))
+*----
+*  MICROLIB INITIALIZATION
+*----
+      IKINF=0
+      IKEFF=0
+      IDF=0
+      LNEW=.TRUE.
+      IF(NSURFD.GT.0) THEN
+        WRITE(RECNAM,'(8H/output/,A,32H/statept_0/zone_0/discontinuity/)
+     &  ') TRIM(HEDIT)
+        LNEW=hdf5_group_exists(IPMPO,TRIM(RECNAM))
+        IF(LNEW) THEN
+*         new specification
+          CALL hdf5_info(IPMPO,TRIM(RECNAM)//"DFACTOR",RANK,TYPE2,
+     &    NBYTE,DIMSR)
+          CALL hdf5_info(IPMPO,TRIM(RECNAM)//"DFACTORGxG",RANK,TYPE4,
+     &    NBYTE,DIMSR)
+          IF(TYPE2.NE.99) THEN
+            IDF=3 ! discontinuity factor information
+          ELSE IF(TYPE4.NE.99) THEN
+            IDF=4 ! matrix discontinuity factor information
+          ELSE
+            CALL hdf5_list(IPMPO,TRIM(RECNAM))
+            CALL XABORT('MCRAGF: UNABLE TO SET TYPE OF DF.')
+          ENDIF
+        ELSE
+*         old specification
+          IDF=3 ! discontinuity factor information
+        ENDIF
+        ADF2(:NMIX,:NGRP,:NSURFD)=0.0
+        ADF2M(:NMIX,:NGRP,:NGRP,:NSURFD)=0.0
+      ENDIF
+      AVGFL2(:NMIX,:NGRP)=0.0
+      IF(NALBP.NE.0) ALBP2(:NMIX,:NALBP,:NGRP)=0.0
+      ZKINF(:NMIX)=0.0
+      ZKEFF(:NMIX)=0.0
+      NSURFD_OLD=NSURFD
+      IF(IACCS.NE.0) THEN
+        ! Recover ADF, GFF and physical albedos previously computed
+        CALL LCMLEN(IPMAC,'VOLUME',ILONG,ITYLCM)
+        IF(ILONG.EQ.0) CALL XABORT('MCRAGF: NO VOLUMES IN MACROLIB.')
+        CALL LCMGET(IPMAC,'VOLUME',VOLMI2)
+        IF(NALBP.GT.0) THEN
+          CALL LCMLEN(IPMAC,'ALBEDO',ILONG,ITYLCM)
+          IF(ILONG.EQ.NALBP*NGRP) THEN
+*           diagonal albedo matrix
+            ALLOCATE(ALBP(NALBP,NGRP))
+            CALL LCMGET(IPMAC,'ALBEDO',ALBP)
+            DO IBM=1,NMIX ! mixtures in Macrolib
+              ALBP2(IBM,:NALBP,:NGRP)=ALBP(:NALBP,:NGRP)
+            ENDDO
+            DEALLOCATE(ALBP)
+          ELSE IF(ILONG.EQ.NALBP*NGRP*NGRP) THEN
+*           GxG albedo matrix
+            ALLOCATE(ALBP_ERM(NALBP,NGRP,NGRP))
+            CALL LCMGET(IPMAC,'ALBEDO',ALBP_ERM)
+            DO IBM=1,NMIX ! mixtures in Macrolib
+              ALBP2_E(IBM,:NALBP,:NGRP,:NGRP)=
+     &                  ALBP_ERM(:NALBP,:NGRP,:NGRP)
+            ENDDO
+            DEALLOCATE(ALBP_ERM)
+          ENDIF
+        ENDIF
+        IF(NSURFD_OLD.GT.0) THEN
+          CALL LCMLEN(IPMAC,'ADF',ILONG,ITYLCM)
+          IF(ILONG.EQ.0) THEN
+            CALL LCMLIB(IPMAC)
+            CALL XABORT('MCRAGF: UNABLE TO FIND DIRECTORY ADF.')
+          ENDIF
+          CALL LCMSIX(IPMAC,'ADF',1)
+          CALL LCMGET(IPMAC,'NTYPE',NSURFD)
+          IF(NSURFD.GT.NSURFD_OLD) THEN
+            DEALLOCATE(ADF2M,ADF2,HADF)
+            ALLOCATE(HADF(NSURFD),ADF2(NMIX,NGRP,NSURFD),
+     &      ADF2M(NMIX,NGRP,NGRP,NSURFD))
+            ADF2(:NMIX,:NGRP,:NSURFD)=0.0
+            ADF2M(:NMIX,:NGRP,:NGRP,:NSURFD)=0.0
+          ENDIF
+          CALL LCMGTC(IPMAC,'HADF',8,NSURFD,HADF)
+          DO I=1,NSURFD
+            CALL LCMLEN(IPMAC,HADF(I),ILONG,ITYLCM)
+            IF(ILONG.EQ.NMIX*NGRP) THEN
+              CALL LCMGET(IPMAC,HADF(I),ADF2(1,1,I))
+            ELSE IF(ILONG.EQ.NMIX*NGRP*NGRP) THEN
+              CALL LCMGET(IPMAC,HADF(I),ADF2M(1,1,1,I))
+            ENDIF
+          ENDDO
+          CALL LCMGET(IPMAC,'AVG_FLUX',AVGFL2)
+          CALL LCMSIX(IPMAC,' ',2)
+        ENDIF
+        DO IBM=1,NMIX
+          IF(MIXC(IBM).NE.0) THEN
+            IF(NALBP.NE.0) THEN
+              IF(LALBG) THEN
+                ALBP2(IBM,:NALBP,:NGRP)=0.0
+              ELSE
+                ALBP2_E(IBM,:NALBP,:NGRP,:NGRP)=0.0
+              ENDIF
+            ENDIF
+            IF((NSURFD.GT.0).AND.(IDF.EQ.3)) THEN
+              ADF2(IBM,:NGRP,:NSURFD)=0.0
+            ELSE IF((NSURFD.GT.0).AND.(IDF.EQ.4)) THEN
+              ADF2M(IBM,:NGRP,:NGRP,:NSURFD)=0.0
+            ENDIF
+            AVGFL2(IBM,:NGRP)=0.0
+            ZKINF(IBM)=0.0
+            ZKEFF(IBM)=0.0
+          ENDIF
+        ENDDO
+      ENDIF
+*----
+*  OVERALL ELEMENTARY CALCULATION LOOP
+*----
+      DO 40 ICAL=1,NCAL
+      IF(NSURFD_OLD.GT.0) THEN
+        IF(LNEW) THEN
+          ALLOCATE(SFLUX(NMIL,NGRP**2,NSURFD_OLD),VFLUX(NMIL,NGRP))
+          DO IBMOLD=1,NMIL
+            WRITE(RECNAM,'(8H/output/,A,9H/statept_,I0,6H/zone_,I0,1H/)
+     &      ') TRIM(HEDIT),ICAL-1,IBMOLD-1
+            CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"ZONEFLUX",VREAL)
+            VFLUX(IBMOLD,:NGRP)=VREAL(:NGRP)/VOSAP(IBMOLD)
+            DEALLOCATE(VREAL)
+            WRITE(RECNAM,'(8H/output/,A,9H/statept_,I0,6H/zone_,I0,
+     &      15H/discontinuity/)') TRIM(HEDIT),ICAL-1,IBMOLD-1
+            CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"NSURF",NITMA)
+            IF(NITMA.NE.NSURFD_OLD) THEN
+              WRITE(HSMG,'(32HMCRAGF: THE NUMBER OF SURFACES (,I5,
+     &        12H) IN MIXTURE,I5,31H IS DIFFERENT FROM THE NUMBER (,I5,
+     &        15H) IN MIXTURE 1.)') NITMA,IBMOLD,NSURFD_OLD
+              CALL XABORT(HSMG)
+            ENDIF
+            IF(IDF.EQ.3) THEN
+              CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"DFACTOR",DISFAC)
+              DO I=1,NSURFD_OLD
+                SFLUX(IBMOLD,:NGRP,I)=DISFAC(I,:NGRP)
+              ENDDO
+              DEALLOCATE(DISFAC)
+            ELSE IF(IDF.EQ.4) THEN
+              CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"DFACTORGxG",
+     &        DISFAC)
+              DO I=1,NSURFD_OLD
+                SFLUX(IBMOLD,:NGRP**2,I)=DISFAC(I,:NGRP**2)
+              ENDDO
+              DEALLOCATE(DISFAC)
+            ENDIF
+          ENDDO
+        ELSE
+          ALLOCATE(SFLUX(NMIL,NGRP,NSURFD_OLD),VFLUX(NMIL,NGRP))
+          CALL SPHMOL(IPMPO,ICAL,NMIL,NGRP,NSURFD_OLD,HEDIT,VOSAP,
+     &    SFLUX,VFLUX)
+        ENDIF
+        DO IBM=1,NMIX ! mixtures in Macrolib
+          IBMOLD=MIXC(IBM)
+          IF(IBMOLD.GT.NMIL) CALL XABORT('MCRAGF: NMIL OVERFLOW.')
+          IF(IBMOLD.EQ.0) CYCLE
+          WEIGHT=TERP(ICAL,IBM)
+          IF(WEIGHT.EQ.0.0) CYCLE
+          IF(IDF.EQ.3) THEN
+            DO I=1,NSURFD_OLD
+              WRITE(HADF(I),'(3HFD_,I5.5)') I
+              ADF2(IBM,:NGRP,I)=ADF2(IBM,:NGRP,I)+WEIGHT*
+     &        SFLUX(IBMOLD,:NGRP,I)*VFLUX(IBMOLD,:NGRP)
+            ENDDO
+          ELSE IF(IDF.EQ.4) THEN
+            DO I=1,NSURFD_OLD
+              WRITE(HADF(I),'(3HFD_,I5.5)') I
+              DO JGR=1,NGRP
+                DO IGR=1,NGRP
+                  ADF2M(IBM,IGR,JGR,I)=ADF2M(IBM,IGR,JGR,I)+WEIGHT*
+     &            SFLUX(IBMOLD,(JGR-1)*NGRP+IGR,I)*VFLUX(IBMOLD,IGR)
+                ENDDO
+              ENDDO
+            ENDDO
+          ENDIF
+          AVGFL2(IBM,:NGRP)=AVGFL2(IBM,:NGRP)+WEIGHT*VFLUX(IBMOLD,:NGRP)
+        ENDDO
+        DEALLOCATE(VFLUX,SFLUX)
+      ENDIF
+*----
+*  PROCESS PHYSICAL ALBEDO INFORMATION
+*----
+      WRITE(RECNAM,'(8H/output/,A,9H/statept_,I0,6H/flux/)')
+     & TRIM(HEDIT),ICAL-1
+      IF((NALBP.GT.0).AND.LALBG) THEN
+*       diagonal albedo matrix
+        CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"ALBEDO",ALBP)
+        DO 20 IBM=1,NMIX ! mixtures in Macrolib
+        IBMOLD=MIXC(IBM)
+        IF(IBMOLD.EQ.0) GO TO 20
+        WEIGHT=TERP(ICAL,IBM)
+        IF(WEIGHT.EQ.0.0) GO TO 20
+        DO IGR=1,NGRP
+          DO IAL=1,NALBP
+            FACTOR=(1.0-ALBP(IAL,IGR))/(1.0+ALBP(IAL,IGR))
+            ALBP2(IBM,IAL,IGR)=ALBP2(IBM,IAL,IGR)+WEIGHT*FACTOR
+          ENDDO
+        ENDDO
+   20     CONTINUE
+        DEALLOCATE(ALBP)        
+      ELSE IF(NALBP.GT.0) THEN
+*       GxG albedo matrix
+        CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"ALBEDOGxG",ALBP_ERM)
+        DO 25 IBM=1,NMIX ! mixtures in Macrolib
+        IBMOLD=MIXC(IBM)
+        IF(IBMOLD.EQ.0) GO TO 25
+        WEIGHT=TERP(ICAL,IBM)
+        IF(WEIGHT.EQ.0.0) GO TO 25
+        DO IGR=1,NGRP
+          DO JGR=1,NGRP
+            DO IAL=1,NALBP
+              FACTOR=(1.0-ALBP_ERM(IAL,IGR,JGR))/(1.0+
+     1        ALBP_ERM(IAL,IGR,JGR))
+              ALBP2_E(IBM,IAL,IGR,JGR)=ALBP2_E(IBM,IAL,IGR,JGR)+WEIGHT*
+     1        FACTOR
+            ENDDO
+          ENDDO
+        ENDDO
+   25   CONTINUE
+        DEALLOCATE(ALBP_ERM)        
+      ENDIF
+*----
+*  PROCESS KINF AND KEFF
+*----
+      DO 30 IBM=1,NMIX ! mixtures in Macrolib
+      IBMOLD=MIXC(IBM)
+      IF(IBMOLD.EQ.0) GO TO 30
+      WEIGHT=TERP(ICAL,IBM)
+      IF(WEIGHT.EQ.0.0) GO TO 30
+      WRITE(RECNAM,'(8H/output/,A,9H/statept_,I0,8H/addons/)')
+     & TRIM(HEDIT),ICAL-1
+      CALL hdf5_info(IPMPO,TRIM(RECNAM)//"KINF",RANK,TYPE,NBYTE,DIMSR)
+      IF(TYPE.NE.99) THEN
+        IKINF=1
+        CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"KINF",FACTOR)
+        ZKINF(IBM)=ZKINF(IBM)+WEIGHT*FACTOR
+      ENDIF
+      CALL hdf5_info(IPMPO,TRIM(RECNAM)//"KEFF",RANK,TYPE,NBYTE,DIMSR)
+      IF(TYPE.NE.99) THEN
+        IKEFF=1
+        CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"KEFF",FACTOR)
+        ZKEFF(IBM)=ZKEFF(IBM)+WEIGHT*FACTOR
+      ENDIF
+   30 CONTINUE
+   40 CONTINUE
+*----
+*  SAVE ADF INFORMATION
+*----
+      IF((NSURFD.GT.0).AND.(IDF.EQ.3)) THEN
+        CALL LCMSIX(IPMAC,'ADF',1)
+        CALL LCMPUT(IPMAC,'NTYPE',1,1,NSURFD)
+        CALL LCMPTC(IPMAC,'HADF',8,NSURFD,HADF)
+        DO IBM=1,NMIX
+          IF(MIXC(IBM).EQ.0) CYCLE
+          DO IGR=1,NGRP
+            ADF2(IBM,IGR,:NSURFD)=ADF2(IBM,IGR,:NSURFD)/AVGFL2(IBM,IGR)
+          ENDDO
+          IF(NSURFD.GT.NSURFD_OLD) THEN
+            IF(NSURFD_OLD.GT.2) CALL XABORT('MCRAGF: INVALID NSURFD.')
+*           assign the same ADF to all sides.
+            DO I=2,NSURFD
+              ADF2(IBM,:NGRP,I)=ADF2(IBM,:NGRP,1)
+            ENDDO
+          ENDIF
+        ENDDO
+        IF(LADFM) THEN
+          DO I=1,NSURFD
+            CALL LCMPUT(IPMAC,HADF(I),NMIX*NGRP,2,ADF2(1,1,I))
+          ENDDO
+        ELSE
+*         write non-matrix DF into a matrix DF
+          DO I=1,NSURFD
+            DO IBM=1,NMIX
+              IF(MIXC(IBM).EQ.0) CYCLE
+              ADF2M(IBM,:NGRP,:NGRP,I)=0.0
+              IF(IDF.EQ.3) THEN
+                DO IGR=1,NGRP
+                  ADF2M(IBM,IGR,IGR,I)=ADF2(IBM,IGR,I)
+                ENDDO
+              ELSE IF(IDF.EQ.4) THEN
+                DO IGR=1,NGRP
+                  ADF2M(IBM,IGR,IGR,I)=ADF2(IBM,IGR,I)
+                ENDDO
+              ENDIF
+            ENDDO
+            CALL LCMPUT(IPMAC,HADF(I),NMIX*NGRP*NGRP,2,ADF2M(1,1,1,I))
+          ENDDO
+          IDF=4
+        ENDIF
+        CALL LCMPUT(IPMAC,'AVG_FLUX',NMIX*NGRP,2,AVGFL2)
+        CALL LCMSIX(IPMAC,' ',2)
+        IF(IMPX.GT.1) THEN
+          DO IBM=1,NMIX
+            IF(MIXC(IBM).EQ.0) CYCLE
+            WRITE(6,'(/40H MCRAGF: DISCONTINUITY FACTORS - MIXTURE,I5)')
+     1      IBM
+            DO I=1,NSURFD
+              WRITE(6,'(1X,A,1H:,1P,(5X,10E12.4))') TRIM(HADF(I)),
+     1        (ADF2(IBM,IGR,I)/AVGFL2(IBM,IGR),IGR=1,NGRP)
+            ENDDO
+          ENDDO
+        ENDIF
+      ELSE IF((NSURFD.GT.0).AND.(IDF.EQ.4)) THEN
+        CALL LCMSIX(IPMAC,'ADF',1)
+        CALL LCMPUT(IPMAC,'NTYPE',1,1,NSURFD)
+        CALL LCMPTC(IPMAC,'HADF',8,NSURFD,HADF)
+        DO IBM=1,NMIX
+          IF(MIXC(IBM).EQ.0) CYCLE
+          DO JGR=1,NGRP
+            DO IGR=1,NGRP
+              ADF2M(IBM,IGR,JGR,:NSURFD)=ADF2M(IBM,IGR,JGR,:NSURFD)/
+     1        AVGFL2(IBM,IGR)
+            ENDDO
+          ENDDO
+          IF(NSURFD.GT.NSURFD_OLD) THEN
+            IF(NSURFD_OLD.GT.2) CALL XABORT('MCRAGF: INVALID NSURFD.')
+*           assign the same matrix ADF to all sides.
+            DO I=2,NSURFD
+              ADF2M(IBM,:NGRP,:NGRP,I)=ADF2M(IBM,:NGRP,:NGRP,1)
+            ENDDO
+          ENDIF
+        ENDDO
+        DO I=1,NSURFD
+          CALL LCMPUT(IPMAC,HADF(I),NMIX*NGRP*NGRP,2,ADF2M(1,1,1,I))
+        ENDDO
+        CALL LCMPUT(IPMAC,'AVG_FLUX',NMIX*NGRP,2,AVGFL2)
+        CALL LCMSIX(IPMAC,' ',2)
+        IF(IMPX.GT.1) THEN
+          DO IBM=1,NMIX
+            IF(MIXC(IBM).EQ.0) CYCLE
+            WRITE(6,'(/44H MCRAGF: MATRIX DISCONTINUITY FACTORS - MIXT,
+     1      3HURE,I5)') IBM
+            DO I=1,NSURFD
+              WRITE(6,'(1X,A,1H:,1P,(5X,10E12.4))') TRIM(HADF(I)),
+     1        ((ADF2M(IBM,IGR,JGR,I),IGR=1,NGRP),JGR=1,NGRP)
+            ENDDO
+          ENDDO
+        ENDIF
+      ENDIF
+*----
+*  AVERAGE PHYSICAL ALBEDO INFORMATION
+*----
+      IF((NALBP.GT.0).AND.LALBG) THEN
+*       diagonal albedo matrix
+        ALLOCATE(ALBP(NALBP,NGRP))
+        DO IGR=1,NGRP
+          DO IAL=1,NALBP
+            DGAR1=0.0D0
+            DGAR2=0.0D0
+            DO IBM=1,NMIX
+              IF(VOLMI2(IBM).EQ.0.0) CYCLE
+              DGAR1=DGAR1+ALBP2(IBM,IAL,IGR)*VOLMI2(IBM)
+              DGAR2=DGAR2+VOLMI2(IBM)
+            ENDDO
+            ALBP(IAL,IGR)=REAL((1.D0-DGAR1/DGAR2)/(1.D0+DGAR1/DGAR2))
+          ENDDO
+        ENDDO
+        IF(LADFM) THEN
+          CALL LCMPUT(IPMAC,'ALBEDO',NALBP*NGRP,2,ALBP)
+        ELSE
+*         write non-matrix albedo into a matrix albedo
+          ALLOCATE(ALBP_ERM(NALBP,NGRP,NGRP))
+          ALBP_ERM(:NALBP,:NGRP,:NGRP)=0.0
+          DO IGR=1,NGRP
+            DO IAL=1,NALBP
+              ALBP_ERM(IAL,IGR,IGR)=ALBP(IAL,IGR)
+            ENDDO
+          ENDDO
+          CALL LCMPUT(IPMAC,'ALBEDO',NALBP*NGRP*NGRP,2,ALBP_ERM)
+          DEALLOCATE(ALBP_ERM)
+        ENDIF
+        DEALLOCATE(ALBP)
+      ELSE IF(NALBP.GT.0) THEN
+*       GxG albedo matrix
+        ALLOCATE(ALBP_ERM(NALBP,NGRP,NGRP))
+        DO IGR=1,NGRP
+          DO JGR=1,NGRP
+            DO IAL=1,NALBP
+              DGAR1=0.0D0
+              DGAR2=0.0D0
+              DO IBM=1,NMIX
+                IF(VOLMI2(IBM).EQ.0.0) CYCLE
+                DGAR1=DGAR1+ALBP2_E(IBM,IAL,IGR,JGR)*VOLMI2(IBM)
+                DGAR2=DGAR2+VOLMI2(IBM)
+              ENDDO
+              ALBP_ERM(IAL,IGR,JGR)=REAL((1.D0-DGAR1/DGAR2)/(1.D0+
+     1        DGAR1/DGAR2))
+            ENDDO
+          ENDDO
+        ENDDO
+        CALL LCMPUT(IPMAC,'ALBEDO',NALBP*NGRP*NGRP,2,ALBP_ERM)
+        DEALLOCATE(ALBP_ERM)
+      ENDIF
+*----
+*  AVERAGE KINF
+*----
+      IF(IKINF.EQ.1) THEN
+        DGAR1=0.0D0
+        DGAR2=0.0D0
+        DO IBM=1,NMIX
+          DGAR1=DGAR1+ZKINF(IBM)*VOLMI2(IBM)
+          DGAR2=DGAR2+VOLMI2(IBM)
+        ENDDO
+        FACTOR=REAL(DGAR1/DGAR2)
+        CALL LCMPUT(IPMAC,'K-INFINITY',1,2,FACTOR)
+      ENDIF
+*----
+*  AVERAGE KEFF
+*----
+      IF(IKEFF.EQ.1) THEN
+        DGAR1=0.0D0
+        DGAR2=0.0D0
+        DO IBM=1,NMIX
+          DGAR1=DGAR1+ZKEFF(IBM)*VOLMI2(IBM)
+          DGAR2=DGAR2+VOLMI2(IBM)
+        ENDDO
+        FACTOR=REAL(DGAR1/DGAR2)
+        CALL LCMPUT(IPMAC,'K-EFFECTIVE',1,2,FACTOR)
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(AVGFL2,ADF2M,ADF2,HADF,ZKEFF,ZKINF,ALBP2_E,ALBP2,
+     1 GAR6,GAR4)
+      RETURN
+      END
diff --git a/Donjon/src/MCRCAL.f90 b/Donjon/src/MCRCAL.f90
new file mode 100644
index 0000000..ca0eb30
--- /dev/null
+++ b/Donjon/src/MCRCAL.f90
@@ -0,0 +1,45 @@
+INTEGER FUNCTION MCRCAL(NPAR,NCAL,MUPLET,MUBASE) RESULT(ICAL)
+!
+!-----------------------------------------------------------------------
+!
+!Purpose:
+! find the position of an elementary calculation in a MPO file.
+!
+!Copyright:
+! Copyright (C) 2022 Ecole Polytechnique de Montreal
+!
+!Author(s): A. Hebert
+!
+!Parameters: input
+! NPAR    number of parameters.
+! NCAL    number of elementary calculations in the PMAXS file.
+! MUPLET  tuple used to identify an elementary calculation.
+!
+!Parameters: output
+! ICAL    position of the elementary calculation (=0 if does not exist;
+!         =-1 if more than one exists).
+!
+!-----------------------------------------------------------------------
+!
+  IMPLICIT NONE
+  !----
+  !  FUNCTION ARGUMENTS
+  !----
+  INTEGER NPAR,NCAL,MUPLET(NPAR),MUBASE(NPAR,NCAL)
+  !----
+  !  LOCAL VARIABLES
+  !----
+  INTEGER I,J,NFIND
+  !
+  ICAL=0
+  NFIND=0
+  DO I=1,NCAL
+    DO J=1,NPAR
+      IF(MUPLET(J).NE.MUBASE(J,I)) GO TO 10
+    ENDDO
+    ICAL=I
+    NFIND=NFIND+1
+    10 CONTINUE
+  ENDDO
+  IF(NFIND.GT.1) ICAL=-1
+END FUNCTION MCRCAL
diff --git a/Donjon/src/MCRDRV.f b/Donjon/src/MCRDRV.f
new file mode 100644
index 0000000..d9c4c55
--- /dev/null
+++ b/Donjon/src/MCRDRV.f
@@ -0,0 +1,433 @@
+*DECK MCRDRV
+      SUBROUTINE MCRDRV(IPMPO,LCUBIC,NMIX,IMPX,NMIL,NCAL,NBISO,NPAR,
+     1 HEDIT,ITER,MAXNIS,MIXC,TERP,NISO,LISO,HISO,CONC,ITODO)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute TERP factors for MPO file interpolation. Use user-defined
+* global parameters.
+*
+*Copyright:
+* Copyright (C) 2022 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPMPO   address of the MPO file.
+* LCUBIC  =.TRUE.: cubic Ceschino interpolation; =.FALSE: linear
+*         Lagrange interpolation.
+* NMIX    maximum number of material mixtures in the microlib.
+* IMPX    print parameter (equal to zero for no print).
+* NMIL    number of material mixtures in the MPO file.
+* NCAL    number of elementary calculations in the MPO file.
+* NBISO   number of particularized isotopes in the MPO file.
+* NPAR    number of parameters
+* HEDIT   name of output group for a (multigroup mesh, output geometry)
+*         couple (generally equal to 'output_0').
+*
+*Parameters: output
+* ITER    completion flag (=0: all over; =1: use another MPO file;
+*         =2 use another L_MAP + MPO file).
+* MAXNIS  maximum value of NISO(I) in user data.
+* MIXC    mixture index in the MPO file corresponding to each microlib
+*         mixture.
+* TERP    interpolation factors.
+* NISO    number of user-selected isotopes.
+* LISO    type of treatment (=.true.: ALL; =.false.: ONLY).
+* HISO    name of the user-selected isotopes.
+* CONC    user-defined number density of the user-selected isotopes. A
+*         value of -99.99 is set to indicate that the compo value is
+*         used.
+* ITODO   non-depletion mask (=1 to force a user-selected isotope to be
+*         non-depleting)
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      USE hdf5_wrap
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMPO
+      INTEGER NMIX,IMPX,NMIL,NCAL,NBISO,NPAR,ITER,MAXNIS,MIXC(NMIX),
+     1 NISO(NMIX),ITODO(NMIX,NBISO)
+      REAL TERP(NCAL,NMIX),CONC(NMIX,NBISO)
+      LOGICAL LCUBIC,LISO(NMIX)
+      CHARACTER(LEN=8) HISO(NMIX,NBISO)
+      CHARACTER(LEN=12) HEDIT
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXLIN=132
+      INTEGER, PARAMETER::MAXPAR=50
+      INTEGER, PARAMETER::MAXVAL=200
+      REAL, PARAMETER::REPS=1.0E-4
+      INTEGER I, J, IBM, IBMOLD, ICAL, INDIC, IPAR, ITYPE, JBM, NITMA
+      REAL SUM, FLOTT
+      CHARACTER TEXT72*72,HSMG*131,TEXT132*132,VALH(MAXPAR)*12,
+     1 RECNAM*80,HCUBIC*12
+      INTEGER VALI(MAXPAR)
+      INTEGER RANK,TYPE,NBYTE,DIMSR(5)
+      DOUBLE PRECISION DFLOTT
+      REAL VALR(2*MAXPAR,2)
+      LOGICAL LCUB2(MAXPAR)
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      LOGICAL, ALLOCATABLE, DIMENSION(:) :: LDELTA
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: MUPLET,MUTYPE,NVALUE,VINTE
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: MUBASE
+      REAL, ALLOCATABLE, DIMENSION(:) :: VREAL
+      CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: PARFMT
+      CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: VCHAR
+      CHARACTER(LEN=24), ALLOCATABLE, DIMENSION(:) :: PARTYP,PARKEY
+      CHARACTER(LEN=132), ALLOCATABLE, DIMENSION(:) :: TEXT132V1
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(MUPLET(NPAR),MUTYPE(NPAR),LDELTA(NMIX),MUBASE(NPAR,NCAL))
+*----
+*  RECOVER INFORMATION FOR THE MPO FILE.
+*----
+      CALL hdf5_info(IPMPO,"/info/MPO_CREATION_INFO",RANK,TYPE,NBYTE,
+     1 DIMSR)
+      IF(RANK.GT.MAXLIN) CALL XABORT('MCRDRV: MAXLIN OVERFLOW.')
+      IF(NPAR.GT.MAXPAR) CALL XABORT('MCRDRV: MAXPAR OVERFLOW.')
+      IF((RANK.EQ.1).AND.(DIMSR(1).EQ.1)) THEN
+        CALL hdf5_read_data(IPMPO,"/info/MPO_CREATION_INFO",TEXT132)
+        IF(IMPX.GT.0) WRITE(IOUT,'(1X,A)') TEXT132
+      ELSE IF(RANK.EQ.1) THEN
+        CALL hdf5_read_data(IPMPO,"/info/MPO_CREATION_INFO",TEXT132V1)
+        IF(IMPX.GT.0) THEN
+          DO I=1,DIMSR(1)
+            WRITE(IOUT,'(1X,A)') TEXT132V1(I)
+          ENDDO
+        ENDIF
+        DEALLOCATE(TEXT132V1)
+      ENDIF
+      IF(NPAR.GT.0) THEN
+        CALL hdf5_read_data(IPMPO,"/parameters/info/PARAMTYPE",PARTYP)
+        CALL hdf5_read_data(IPMPO,"/parameters/info/PARAMNAME",PARKEY)
+        CALL hdf5_read_data(IPMPO,"/parameters/info/PARAMFORM",PARFMT)
+        IF(IMPX.GT.1) THEN
+          WRITE(IOUT,*) 'NPAR=',NPAR,SIZE(PARKEY,1)
+          DO I=1,NPAR
+            WRITE(IOUT,*)'PARKEY(',I,')=',PARKEY(I),' PARFMT=',PARFMT(I)
+          ENDDO
+        ENDIF
+      ENDIF
+      TERP(:NCAL,:NMIX)=0.0
+      MIXC(:NMIX)=0
+*----
+*  SCAN THE MPO FILE INFORMATION TO RECOVER THE MUPLET DATABASE
+*----
+      IF(IMPX.GT.5) THEN
+        WRITE(IOUT,'(24H MCRDRV: MUPLET DATABASE/12H CALCULATION,5X,
+     1  10HMUPLET....)')
+      ENDIF
+      IF(NPAR.GT.0) THEN
+        DO ICAL=1,NCAL
+          WRITE(RECNAM,'(8H/output/,A,9H/statept_,I0)') TRIM(HEDIT),
+     1    ICAL-1
+          CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"/PARAMVALUEORD",
+     1    VINTE)
+          IF(SIZE(VINTE).NE.NPAR) THEN
+            WRITE(HSMG,'(41HMCRDRV: INCONSISTENT PARAMVALUEORD LENGTH,
+     1      2H (,I5,3H VS,I5,2H).)') SIZE(VINTE),NPAR
+            CALL XABORT(HSMG)
+          ENDIF
+          DO IPAR=1,NPAR
+            MUBASE(IPAR,ICAL)=VINTE(IPAR)+1
+          ENDDO
+          IF(IMPX.GT.5) THEN
+            WRITE(IOUT,'(I8,6X,20I4/(14X,20I4))') ICAL,
+     1      MUBASE(:,ICAL)
+          ENDIF
+          DEALLOCATE(VINTE)
+        ENDDO
+      ENDIF
+*----
+*  READ (INTERP_DATA) AND SET VALI, VALR AND VALH PARAMETERS
+*  CORRESPONDING TO THE INTERPOLATION POINT. FILL MUPLET FOR
+*  PARAMETERS SET WITHOUT INTERPOLATION.
+*----
+      IBM=0
+      MAXNIS=0
+      NISO(:NMIX)=0
+      LISO(:NMIX)=.TRUE.
+      LDELTA(:NMIX)=.FALSE.
+      ITODO(:NMIX,:NBISO)=0
+   10 CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT)
+      IF(INDIC.NE.3) CALL XABORT('MCRDRV: CHARACTER DATA EXPECTED.')
+   20 IF(TEXT72.EQ.'MIX') THEN
+         MUPLET(:NPAR)=0
+         MUTYPE(:NPAR)=0
+         VALI(:NPAR)=0
+         VALR(:NPAR,1)=0.0
+         VALR(:NPAR,2)=0.0
+         DO 30 I=1,NPAR
+         VALH(I)=' '
+   30    CONTINUE
+         LCUB2(:NPAR)=LCUBIC
+         CALL REDGET(INDIC,IBM,FLOTT,TEXT72,DFLOTT)
+         IF(INDIC.NE.1) CALL XABORT('MCRDRV: INTEGER DATA EXPECTED.')
+         IF(IBM.GT.NMIX) THEN
+            WRITE(HSMG,'(27HMCRDRV: NMIX OVERFLOW (IBM=,I8,6H NMIX=,I8,
+     1      2H).)') IBM,NMIX
+            CALL XABORT(HSMG)
+         ENDIF
+         IBMOLD=1
+         CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('MCRDRV: CHARACTER DATA EXPECTED.')
+         IF(TEXT72.EQ.'FROM') THEN
+            CALL REDGET(INDIC,IBMOLD,FLOTT,TEXT72,DFLOTT)
+            IF(INDIC.NE.1) CALL XABORT('MCRDRV: INTEGER DATA EXPECTED.')
+            IF(IBMOLD.GT.NMIL) CALL XABORT('MCRDRV: MPO MIX OVERFLOW'
+     1      //'(1).')
+            MIXC(IBM)=IBMOLD
+            GO TO 10
+         ELSE IF(TEXT72.EQ.'USE') THEN
+            IF(IBM.GT.NMIL) CALL XABORT('MCRDRV: MPO MIX OVERFLOW(2).')
+            MIXC(IBM)=IBM
+            GO TO 10
+         ENDIF
+         MIXC(IBM)=IBMOLD
+         GO TO 20
+      ELSE IF(TEXT72.EQ.'MICRO') THEN
+         IF(IBM.EQ.0) CALL XABORT('MCRDRV: MIX NOT SET (1).')
+         CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('MCRDRV: CHARACTER DATA EXPECTED.')
+         IF(TEXT72.EQ.'ALL') THEN
+            LISO(IBM)=.TRUE.
+         ELSE IF(TEXT72.EQ.'ONLY') THEN
+            LISO(IBM)=.FALSE.
+         ENDIF
+         CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('MCRDRV: CHARACTER DATA EXPECTED.')
+   40    IF(TEXT72.EQ.'ENDMIX') THEN
+           GO TO 20
+         ELSE IF(TEXT72.EQ.'NOEV') THEN
+           IF(NISO(IBM).EQ.0) CALL XABORT('MCRDRV: MISPLACED NOEV.')
+           ITODO(IBM,NISO(IBM))=1
+         ELSE
+           NISO(IBM)=NISO(IBM)+1
+           IF(NISO(IBM).GT.NBISO) CALL XABORT('MCRDRV: NBISO OVERFLOW.')
+           MAXNIS=MAX(MAXNIS,NISO(IBM))
+           HISO(IBM,NISO(IBM))=TEXT72(:8)
+           CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT)
+           IF(INDIC.EQ.2) THEN
+             CONC(IBM,NISO(IBM))=FLOTT
+           ELSE IF((INDIC.EQ.3).AND.(TEXT72.EQ.'*')) THEN
+             CONC(IBM,NISO(IBM))=-99.99
+           ELSE
+             CALL XABORT('MCRDRV: INVALID HISO DATA.')
+           ENDIF
+         ENDIF
+         CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('MCRDRV: CHARACTER DATA EXPECTED.')
+         GO TO 40
+      ELSE IF((TEXT72.EQ.'SET').OR.(TEXT72.EQ.'DELTA')) THEN
+         IF(IBM.EQ.0) CALL XABORT('MCRDRV: MIX NOT SET (2).')
+         ITYPE=0
+         IF(TEXT72.EQ.'SET') THEN
+            ITYPE=1
+         ELSE IF(TEXT72.EQ.'DELTA') THEN
+            ITYPE=2
+            LDELTA(IBM)=.TRUE.
+         ENDIF
+         CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('MCRDRV: CHARACTER DATA EXPECTED.')
+         IF((TEXT72.EQ.'LINEAR').OR.(TEXT72.EQ.'CUBIC')) THEN
+            HCUBIC=TEXT72(:12)
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT)
+         ELSE
+            HCUBIC=' '
+         ENDIF
+         IF(INDIC.NE.3) CALL XABORT('MCRDRV: CHARACTER DATA EXPECTED.')
+         IPAR=0
+         DO 50 I=1,NPAR
+         IF(TEXT72.EQ.PARKEY(I)) THEN
+            IPAR=I
+            GO TO 60
+         ENDIF
+   50    CONTINUE
+         CALL XABORT('MCRDRV: PARAMETER '//TEXT72//' NOT FOUND.')
+   60    IF(HCUBIC.EQ.'LINEAR') THEN
+            LCUB2(IPAR)=.FALSE.
+         ELSE IF(HCUBIC.EQ.'CUBIC') THEN
+            LCUB2(IPAR)=.TRUE.
+         ENDIF
+         CALL hdf5_read_data(IPMPO,"/parameters/info/NVALUE",NVALUE)
+         IF(NVALUE(IPAR).GT.MAXVAL) CALL XABORT('MCRDRV: MAXVAL OVERFL'
+     1   //'OW.')
+         WRITE(RECNAM,'(25H/parameters/values/PARAM_,I0)') IPAR-1
+         CALL hdf5_info(IPMPO,RECNAM,RANK,TYPE,NBYTE,DIMSR)
+         IF(TYPE.EQ.99) THEN
+            WRITE(HSMG,'(25HMCRDRV: GLOBAL PARAMETER ,A,9H NOT SET.)')
+     1      TRIM(PARKEY(IPAR))
+            CALL XABORT(HSMG)
+         ENDIF
+         IF(PARFMT(IPAR).EQ.'INTEGER') THEN
+            IF(ITYPE.NE.1) CALL XABORT('MCRDRV: SET MANDATORY WITH INT'
+     1      //'EGER PARAMETERS.')
+            CALL REDGET(INDIC,VALI(IPAR),FLOTT,TEXT72,DFLOTT)
+            IF(INDIC.NE.1) CALL XABORT('MCRDRV: INTEGER DATA EXPECTED.')
+            CALL hdf5_read_data(IPMPO,RECNAM,VINTE)
+            DO 70 J=1,NVALUE(IPAR)
+            IF(VALI(IPAR).EQ.VINTE(J)) THEN
+               MUPLET(IPAR)=J
+               MUTYPE(IPAR)=ITYPE
+               DEALLOCATE(NVALUE,VINTE)
+               GO TO 10
+            ENDIF
+   70       CONTINUE
+            WRITE(HSMG,'(26HMCRDRV: INTEGER PARAMETER ,A,11H WITH VALUE,
+     1      I5,32H NOT FOUND IN MPO FILE DATABASE.)') 
+     2      TRIM(PARKEY(IPAR)),VALI(IPAR)
+            CALL XABORT(HSMG)
+         ELSE IF(PARFMT(IPAR).EQ.'FLOAT') THEN
+            CALL REDGET(INDIC,NITMA,VALR(IPAR,1),TEXT72,DFLOTT)
+            IF(INDIC.NE.2) CALL XABORT('MCRDRV: REAL DATA EXPECTED.')
+            VALR(IPAR,2)=VALR(IPAR,1)
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT)
+            IF(INDIC.EQ.2) THEN
+               VALR(IPAR,2)=FLOTT
+               CALL REDGET(INDIC,NITMA,FLOTT,TEXT72,DFLOTT)
+            ENDIF
+            CALL hdf5_read_data(IPMPO,RECNAM,VREAL)
+            IF(VALR(IPAR,1).EQ.VALR(IPAR,2)) THEN
+               DO 80 J=1,NVALUE(IPAR)
+               IF(ABS(VALR(IPAR,1)-VREAL(J)).LE.REPS*ABS(VREAL(J))) THEN
+                  MUPLET(IPAR)=J
+                  IF(ITYPE.NE.1) MUPLET(IPAR)=-1
+                  MUTYPE(IPAR)=ITYPE
+                  DEALLOCATE(NVALUE,VREAL)
+                  GO TO 20
+               ENDIF
+   80          CONTINUE
+            ENDIF
+            IF(VALR(IPAR,1).LT.VREAL(1)) THEN
+               WRITE(HSMG,'(23HMCRDRV: REAL PARAMETER ,A,10H WITH VALU,
+     1         1HE,1P,E12.4,25H IS OUTSIDE THE DOMAIN (<,E12.4,1H))')
+     2         TRIM(PARKEY(IPAR)),VALR(IPAR,1),VREAL(1)
+               CALL XABORT(HSMG)
+            ELSE IF(VALR(IPAR,2).GT.VREAL(NVALUE(IPAR))) THEN
+               WRITE(HSMG,'(23HMCRDRV: REAL PARAMETER ,A,10H WITH VALU,
+     1         1HE,1P,E12.4,25H IS OUTSIDE THE DOMAIN (>,E12.4,1H))')
+     2         TRIM(PARKEY(IPAR)),VALR(IPAR,1),VREAL(NVALUE(IPAR))
+               CALL XABORT(HSMG)
+            ELSE IF(VALR(IPAR,1).GT.VALR(IPAR,2)) THEN
+               WRITE(HSMG,'(23HMCRDRV: REAL PARAMETER ,A,9H IS DEFIN,
+     1         7HED WITH,1P,E12.4,2H >,E12.4,1H.)') TRIM(PARKEY(IPAR)),
+     2         VALR(IPAR,1),VALR(IPAR,2)
+               CALL XABORT(HSMG)
+            ENDIF
+            MUPLET(IPAR)=-1
+            MUTYPE(IPAR)=ITYPE
+            DEALLOCATE(NVALUE,VREAL)
+            GO TO 20
+         ELSE IF(PARFMT(IPAR).EQ.'STRING') THEN
+            IF(ITYPE.NE.1) CALL XABORT('MCRDRV: SET MANDATORY WITH STR'
+     1      //'ING PARAMETERS.')
+            CALL REDGET(INDIC,NITMA,FLOTT,VALH(IPAR),DFLOTT)
+            IF(INDIC.NE.3) CALL XABORT('MCRDRV: STRING DATA EXPECTED.')
+            CALL hdf5_read_data(IPMPO,RECNAM,VCHAR)
+            DO 90 J=1,NVALUE(IPAR)
+            IF(VALH(IPAR).EQ.VCHAR(J)) THEN
+               MUPLET(IPAR)=J
+               MUTYPE(IPAR)=ITYPE
+               DEALLOCATE(NVALUE,VCHAR)
+               GO TO 10
+            ENDIF
+   90       CONTINUE
+            WRITE(HSMG,'(25HMCRDRV: STRING PARAMETER ,A,10H WITH VALU,
+     1      2HE ,A12,32H NOT FOUND IN MPO FILE DATABASE.)')
+     2      TRIM(PARKEY(IPAR)), VALH(IPAR)
+            CALL XABORT(HSMG)
+         ELSE
+            CALL XABORT('MCRDRV: INVALID FORMAT='//PARFMT(IPAR))
+         ENDIF
+      ELSE IF(TEXT72.EQ.'ENDMIX') THEN
+*----
+*  COMPUTE THE TERP FACTORS USING TABLE-OF-CONTENT INFORMATION.
+*----
+         IF(IMPX.GT.0) THEN
+           DO IPAR=1,NPAR
+             IF(PARFMT(IPAR).EQ.'FLOAT')THEN
+               IF(LCUB2(IPAR)) THEN
+                 WRITE(IOUT,'(26H MCRDRV: GLOBAL PARAMETER:,A,7H ->CUBI,
+     1           16HC INTERPOLATION.)') TRIM(PARKEY(IPAR))
+               ELSE
+                 WRITE(IOUT,'(26H MCRDRV: GLOBAL PARAMETER:,A,7H ->LINE,
+     1           17HAR INTERPOLATION.)') TRIM(PARKEY(IPAR))
+               ENDIF
+             ENDIF
+           ENDDO
+         ENDIF
+         IF(IBMOLD.GT.NMIL)CALL XABORT('MCRDRV: MPO MIX OVERFLOW(3).')
+         IF(IBM.GT.NMIX)CALL XABORT('MCRDRV: MIX OVERFLOW (MICROLIB).')
+         IF(NCAL.EQ.1) THEN
+           TERP(1,IBM)=1.0
+         ELSE
+           CALL MCRTRP(IPMPO,LCUB2,IMPX,NPAR,NCAL,MUPLET,MUTYPE,PARTYP,
+     1     VALR,0.0,MUBASE,TERP(1,IBM))
+         ENDIF
+         IBM=0
+      ELSE IF((TEXT72.EQ.'MPO').OR.(TEXT72.EQ.'TABLE').OR.
+     1   (TEXT72.EQ.'CHAIN').OR.(TEXT72.EQ.';')) THEN
+*----
+*  CHECK TERP FACTORS AND RETURN
+*----
+         IF(TEXT72.EQ.';') ITER=0
+         IF(TEXT72.EQ.'MPO') ITER=1
+         IF(TEXT72.EQ.'TABLE') ITER=2
+         IF(TEXT72.EQ.'CHAIN') ITER=3
+         DO 150 IBM=1,NMIX
+         IBMOLD=MIXC(IBM)
+         IF(IBMOLD.EQ.0) GO TO 150
+         IF(NISO(IBM).GT.MAXNIS) CALL XABORT('MCRDRV: MAXNIS OVERFLOW.')
+         IF(LDELTA(IBM)) THEN
+            SUM=0.0
+         ELSE
+            SUM=1.0
+         ENDIF
+         DO 140 ICAL=1,NCAL
+         SUM=SUM-TERP(ICAL,IBM)
+  140    CONTINUE
+         IF(ABS(SUM).GT.1.0E-4) THEN
+            WRITE(HSMG,'(43HMCRDRV: INVALID INTERPOLATION FACTORS IN MI,
+     1      5HXTURE,I4,1H.)') IBM
+            CALL XABORT(HSMG)
+         ENDIF
+  150    CONTINUE
+         GO TO 160
+      ELSE
+         CALL XABORT('MCRDRV: '//TEXT72//' IS AN INVALID KEYWORD.')
+      ENDIF
+      GO TO 10
+*----
+*  PRINT INTERPOLATION (TERP) FACTORS
+*----
+  160 IF(IMPX.GT.2) THEN
+        WRITE(IOUT,'(/30H MCRDRV: INTERPOLATION FACTORS)')
+        DO ICAL=1,NCAL
+          DO IBM=1,NMIX
+            IF(TERP(ICAL,IBM).NE.0.0) THEN
+              WRITE(IOUT,170) ICAL,(TERP(ICAL,JBM),JBM=1,NMIX)
+              EXIT
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      IF(NPAR.GT.0) DEALLOCATE(PARFMT,PARKEY,PARTYP)
+      DEALLOCATE(MUBASE,LDELTA,MUTYPE,MUPLET)
+      RETURN
+  170 FORMAT(6H CALC=,I8,6H TERP=,1P,8E13.5/(20X,8E13.5))
+      END
diff --git a/Donjon/src/MCRISO.f b/Donjon/src/MCRISO.f
new file mode 100644
index 0000000..8d57fe9
--- /dev/null
+++ b/Donjon/src/MCRISO.f
@@ -0,0 +1,259 @@
+*DECK MCRISO
+      SUBROUTINE MCRISO(IPLIB,NREA,NGRP,NL,NPRC,NOMREA,NWT0,XS,SIGS,
+     > SS2D,TAUXFI,LXS,LAMB,CHIRS,BETAR,INVELS,INAME,LSTRD,LPURE,ILUPS,
+     > ITRANC,IFISS)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Store an isotopic data recovered from an MPO file into a Microlib.
+*
+*Copyright:
+* Copyright (C) 2022 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPLIB   address of the output microlib LCM object
+* NREA    number of reactions in the MPO file
+* NGRP    number of energy groups
+* NL      maximum Legendre order (NL=1 is for isotropic scattering)
+* NPRC    number of delayed neutron precursor groups
+* NOMREA  names of reactions in the MPO file
+* NWT0    average flux
+* XS      cross sections per reaction
+* SIGS    scattering cross sections
+* SS2D    complete scattering matrix
+* TAUXFI  interpolated fission rate
+* LXS     existence flag of each reaction
+* LAMB    decay constants of the delayed neutron precursor groups
+* CHIRS   delayed neutron emission spectrums
+* BETAR   delayed neutron fractions
+* INVELS  group-average of the inverse neutron velocity
+* INAME   name of the isotope.
+* LSTRD   flag set to .true. if B2=0.0.
+* LPURE   =.true. if the interpolation is a pure linear interpolation 
+*         with TERP factors.
+* ILUPS   up-scattering removing flag (=1 to remove up-scattering from
+*         output cross-sections).
+*
+*Parameters: output
+* ITRANC  transport correction flag
+* IFISS   fission flag
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPLIB
+      INTEGER NREA,NGRP,NL,NPRC,INAME(2),ILUPS,ITRANC,IFISS
+      REAL NWT0(NGRP),XS(NGRP,NREA),SIGS(NGRP,NL),SS2D(NGRP,NGRP,NL),
+     > TAUXFI,LAMB(NPRC),CHIRS(NGRP,NPRC),BETAR(NPRC),INVELS(NGRP)
+      LOGICAL LXS(NREA),LSTRD,LPURE
+      CHARACTER NOMREA(NREA)*24
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER I0, IGFROM, IGMAX, IGMIN, IGR, JGR, IGTO, ILEG, IPRC,
+     & IREA, NXSCMP, IL, IRENT0
+      LOGICAL LDIFF,LHFACT,LZERO
+      REAL CONVEN,FF,CSCAT
+      CHARACTER TEXT12*12
+      CHARACTER HCM(0:10)*2,NAMLEG*2
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: ITYPRO,NJJ,IJJ
+      REAL, ALLOCATABLE, DIMENSION(:) :: STRD,WRK,XSSCMP,EFACT
+      DATA HCM  /'00','01','02','03','04','05','06','07','08','09','10'/
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(STRD(NGRP),EFACT(NGRP))
+*----
+*  UP-SCATTERING CORRECTION
+*----
+      IF(ILUPS.EQ.1) THEN
+        IRENT0=0
+        DO IREA=1,NREA
+          IF(NOMREA(IREA).EQ.'Total') IRENT0=IREA
+        ENDDO
+        DO JGR=2,NGRP
+          DO IGR=1,JGR-1 ! IGR < JGR
+            FF=NWT0(JGR)/NWT0(IGR)
+            IF(IRENT0.GT.0) THEN
+              CSCAT=SS2D(IGR,JGR,1)
+              FF=NWT0(JGR)/NWT0(IGR)
+              XS(IGR,IRENT0)=XS(IGR,IRENT0)-CSCAT*FF
+              XS(JGR,IRENT0)=XS(JGR,IRENT0)-CSCAT
+            ENDIF
+            DO IL=1,NL
+              CSCAT=SS2D(IGR,JGR,IL)
+              SIGS(IGR,IL)=SIGS(IGR,IL)-CSCAT*FF
+              SIGS(JGR,IL)=SIGS(JGR,IL)-CSCAT
+              SS2D(JGR,IGR,IL)=SS2D(JGR,IGR,IL)-CSCAT*FF
+              SS2D(IGR,JGR,IL)=0.0
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF
+*----
+*  BUILD MICROLIB
+*----
+      WRITE(TEXT12,'(2A4)') (INAME(I0),I0=1,2)
+      CALL LCMPTC(IPLIB,'ALIAS',12,TEXT12)
+      CALL LCMPUT(IPLIB,'NWT0',NGRP,2,NWT0)
+      IF(NPRC.GT.0) THEN
+        CALL LCMPUT(IPLIB,'LAMBDA-D',NPRC,2,LAMB)
+        CALL LCMPUT(IPLIB,'OVERV',NGRP,2,INVELS)
+      ENDIF
+      ITRANC=0
+      IFISS=0
+      LDIFF=.FALSE.
+      LHFACT=.FALSE.
+      STRD(:NGRP)=0.0
+      EFACT(:NGRP)=0.0
+      CONVEN=1.0E6 ! convert MeV to eV
+      DO IREA=1,NREA
+        IF(.NOT.LXS(IREA)) CYCLE
+        LZERO=.TRUE.
+        DO IGR=1,NGRP
+          LZERO=LZERO.AND.(XS(IGR,IREA).EQ.0.0)
+        ENDDO
+        IF(LZERO) CYCLE
+        IF(NOMREA(IREA).EQ.'Total') THEN
+          IF(LSTRD) THEN
+            DO IGR=1,NGRP
+              STRD(IGR)=STRD(IGR)+XS(IGR,IREA)
+            ENDDO
+          ENDIF
+          CALL LCMPUT(IPLIB,'NTOT0',NGRP,2,XS(1,IREA))
+        ELSE IF(NOMREA(IREA).EQ.'Nexess') THEN
+*         correct scattering XS with excess XS
+          DO IGR=1,NGRP
+            SIGS(IGR,1)=SIGS(IGR,1)+XS(IGR,IREA)
+          ENDDO
+          CALL LCMPUT(IPLIB,'N2N',NGRP,2,XS(1,IREA))
+        ELSE IF(NOMREA(IREA).EQ.'Fission') THEN
+          CALL LCMPUT(IPLIB,'NFTOT',NGRP,2,XS(1,IREA))
+        ELSE IF(NOMREA(IREA).EQ.'Absorption') THEN
+          CALL LCMPUT(IPLIB,'NG',NGRP,2,XS(1,IREA))
+        ELSE IF(NOMREA(IREA).EQ.'FissionSpectrum') THEN
+          IF(.NOT.LPURE) THEN
+            DO IGR=1,NGRP
+              IF(XS(IGR,IREA).NE.0.0) THEN
+                XS(IGR,IREA)=XS(IGR,IREA)/TAUXFI
+              ENDIF
+            ENDDO
+          ENDIF
+          CALL LCMPUT(IPLIB,'CHI',NGRP,2,XS(1,IREA))
+          DO IPRC=1,NPRC
+            WRITE(TEXT12,'(A3,I2.2)') 'CHI',IPRC
+            CALL LCMPUT(IPLIB,TEXT12,NGRP,2,CHIRS(1,IPRC))
+          ENDDO
+        ELSE IF(NOMREA(IREA).EQ.'NuFission') THEN
+          IFISS=1
+          CALL LCMPUT(IPLIB,'NUSIGF',NGRP,2,XS(1,IREA))
+          IF(NPRC.GT.0) THEN
+            ALLOCATE(WRK(NGRP))
+            DO IPRC=1,NPRC
+              DO IGR=1,NGRP
+                WRK(IGR)=XS(IGR,IREA)*BETAR(IPRC)
+              ENDDO
+              WRITE(TEXT12,'(A6,I2.2)') 'NUSIGF',IPRC
+              CALL LCMPUT(IPLIB,TEXT12,NGRP,2,WRK)
+            ENDDO
+            DEALLOCATE(WRK)
+          ENDIF
+        ELSE IF(NOMREA(IREA).EQ.'CaptureEnergyCapture') THEN
+          LHFACT=.TRUE.
+          DO IGR=1,NGRP
+            EFACT(IGR)=EFACT(IGR)+XS(IGR,IREA)*CONVEN
+          ENDDO
+        ELSE IF(NOMREA(IREA).EQ.'FissionEnergyFission') THEN
+          LHFACT=.TRUE.
+          DO IGR=1,NGRP
+            EFACT(IGR)=EFACT(IGR)+XS(IGR,IREA)*CONVEN
+          ENDDO
+        ELSE IF(NOMREA(IREA).EQ.'Leakage') THEN
+          LDIFF=LSTRD
+          IF(.NOT.LSTRD) THEN
+            DO IGR=1,NGRP
+              LDIFF=LDIFF.OR.(XS(IGR,IREA).NE.0.0)
+              STRD(IGR)=XS(IGR,IREA)
+            ENDDO
+          ENDIF
+        ELSE IF(NOMREA(IREA).EQ.'Diffusion') THEN
+          CYCLE
+        ELSE IF(NOMREA(IREA).EQ.'Scattering') THEN
+          CYCLE
+        ELSE
+          CALL LCMPUT(IPLIB,NOMREA(IREA),NGRP,2,XS(1,IREA))
+        ENDIF
+      ENDDO
+      IF(LSTRD) THEN
+        IF((ITRANC.EQ.0).AND.(NL.GT.1)) THEN
+*         Apollo-type transport correction
+          DO IGR=1,NGRP
+            STRD(IGR)=STRD(IGR)-SIGS(IGR,2)
+          ENDDO
+        ENDIF
+      ELSE
+        DO IGR=1,NGRP
+          STRD(IGR)=1.0/(3.0*STRD(IGR))
+        ENDDO
+      ENDIF
+      IF((ITRANC.EQ.0).AND.(NL.GT.1)) THEN
+*       Apollo-type transport correction
+        ITRANC=2
+        CALL LCMPUT(IPLIB,'TRANC',NGRP,2,SIGS(1,2))
+      ENDIF
+      IF(LDIFF.OR.LSTRD) CALL LCMPUT(IPLIB,'STRD',NGRP,2,STRD)
+      IF(LHFACT)  CALL LCMPUT(IPLIB,'H-FACTOR',NGRP,2,EFACT)
+*----
+*  SAVE SCATTERING VECTORS AND MATRICES (DO NOT USE XDRLGS TO SAVE CPU
+*  TIME)
+*----
+      ALLOCATE(NJJ(NGRP),IJJ(NGRP),XSSCMP(NGRP*NGRP),ITYPRO(NL))
+      DO ILEG=1,NL
+        IF(ILEG.LE.11) THEN
+          NAMLEG=HCM(ILEG-1)
+        ELSE
+          WRITE(NAMLEG,'(I2.2)') ILEG-1
+        ENDIF
+        CALL LCMPUT(IPLIB,'SIGS'//NAMLEG,NGRP,2,SIGS(1,ILEG))
+        NXSCMP=0
+        DO IGTO=1,NGRP
+          IGMIN=IGTO
+          IGMAX=IGTO
+          DO IGFROM=1,NGRP
+            IF(SS2D(IGTO,IGFROM,ILEG).NE.0.0) THEN
+              IGMIN=MIN(IGMIN,IGFROM)
+              IGMAX=MAX(IGMAX,IGFROM)
+            ENDIF
+          ENDDO
+          IJJ(IGTO)=IGMAX
+          NJJ(IGTO)=IGMAX-IGMIN+1
+          DO IGFROM=IGMAX,IGMIN,-1
+            NXSCMP=NXSCMP+1
+            XSSCMP(NXSCMP)=SS2D(IGTO,IGFROM,ILEG)
+          ENDDO
+        ENDDO
+        CALL LCMPUT(IPLIB,'NJJS'//NAMLEG,NGRP,1,NJJ)
+        CALL LCMPUT(IPLIB,'IJJS'//NAMLEG,NGRP,1,IJJ)
+        CALL LCMPUT(IPLIB,'SCAT'//NAMLEG,NXSCMP,2,XSSCMP)
+        ITYPRO(ILEG)=1
+      ENDDO
+      CALL LCMPUT(IPLIB,'SCAT-SAVED',NL,1,ITYPRO)
+      DEALLOCATE(ITYPRO,XSSCMP,IJJ,NJJ)
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(EFACT,STRD)
+      RETURN
+      END
diff --git a/Donjon/src/MCRLIB.f b/Donjon/src/MCRLIB.f
new file mode 100644
index 0000000..ab94d3f
--- /dev/null
+++ b/Donjon/src/MCRLIB.f
@@ -0,0 +1,856 @@
+*DECK MCRLIB
+      SUBROUTINE MCRLIB(MAXNIS,MAXISO,IPLIB,IPMPO,IACCS,NMIX,NGRP,LADFM,
+     1 IMPX,HEQUI,HMASL,NCAL,HEDIT,ITER,MY1,MY2,NBISO,TERP,NISO,LISO,
+     2 HISO,CONC,ITODO,MIXC,LRES,LPURE,ILUPS,B2,VTOT,YLDS,DECAYC)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Build the Microlib by scanning the NCAL elementary calculations in
+* a MPO file and weighting them with TERP factors.
+*
+*Copyright:
+* Copyright (C) 2022 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* MAXNIS  maximum value of NISO(I) in user data.
+* MAXISO  maximum allocated space for output Microlib TOC information.
+* IPLIB   address of the output Microlib LCM object.
+* IPMPO   pointer to the MPO file.
+* IACCS   =0 Microlib is created; =1 ... is updated.
+* NMIX    maximum number of material mixtures in the Microlib.
+* NGRP    number of energy groups.
+* LADFM   type of discontinuity factors (.true.: diagonal; .false.: GxG).
+* IMPX    print parameter (equal to zero for no print).
+* HEQUI   keyword of SPH-factor set to be recovered.
+* HMASL   keyword of MASL data set to be recovered.
+* NCAL    number of elementary calculations in the MPO file.
+* HEDIT   name of output group for a (multigroup mesh, output geometry)
+*         couple (generally equal to 'output_0').
+* ITER    completion flag (=0: compute the macrolib).
+* MY1     number of fissile isotopes including macroscopic sets.
+* MY2     number of fission fragment.
+* NBISO   number of particularized isotopes in the MPO file.
+* TERP    interpolation factors.
+* NISO    number of user-selected isotopes.
+* LISO    type of treatment (=.true.: ALL; =.false.: ONLY).
+* HISO    name of the user-selected isotopes.
+* CONC    user-defined number density of the user-selected isotopes. A
+*         value of -99.99 is set to indicate that the MPO file value is
+*         used.
+* ITODO   non-depletion mask (=1 to force a user-selected isotope to be
+*         non-depleting)
+* MIXC    mixture index in the MPO file corresponding to each Microlib
+*         mixture. Equal to zero if a Microlib mixture is not updated.
+* LRES    =.true. if the interpolation is done without updating isotopic 
+*         densities
+* LPURE   =.true. if the interpolation is a pure linear interpolation 
+*         with TERP factors.
+* ILUPS   up-scattering removing flag (=1 to remove up-scattering from
+*         output cross-sections).
+* B2      buckling
+* VTOT    volume of updated core.
+* YLDS    fission yields.
+* DECAYC  radioactive decay constants.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      USE hdf5_wrap
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPLIB,IPMPO
+      INTEGER MAXNIS,MAXISO,IACCS,NMIX,NGRP,IMPX,NCAL,ITER,MY1,MY2,
+     > NBISO,NISO(NMIX),ITODO(NMIX,MAXNIS),MIXC(NMIX),ILUPS
+      REAL TERP(NCAL,NMIX),CONC(NMIX,MAXNIS),B2
+      DOUBLE PRECISION VTOT,YLDS(MY1,MY2),DECAYC(NBISO)
+      LOGICAL LADFM,LISO(NMIX),LRES,LPURE
+      CHARACTER(LEN=80) HEQUI,HMASL
+      CHARACTER(LEN=12) HEDIT
+      CHARACTER(LEN=8) HISO(NMIX,NBISO)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXREA=50
+      INTEGER, PARAMETER::NSTATE=40
+      INTEGER, PARAMETER::MAXFRD=4
+      TYPE(C_PTR) JPLIB,KPLIB
+      REAL FACT0, WEIGHT, DEN
+      INTEGER I, J, I0, IBM, IBMOLD, ICAL, IED2, IFISS, IGR, ILONG, IDF,
+     > IPRC, IREA, IREAB, IREAF, ISO, ITRANC, ITSTMP, ITYLCM, IY1, IY2,
+     > JSO, KSO, KSO1, LMY1, LSO, MAXMIX, NBISO2, NBISO2I, NBS1, NCALS,
+     > NED2, NL, NMIL, NPAR, NPRC, NREA, NSURFD, NISOF, NISOP, NISOS,
+     > RANK, NBYTE, TYPE, DIMSR(5), ILOC, NADDRXS, NLOC, NMGF, ID, ID_E,
+     > ID_G, NENERG, NGEOME, ADDRZI, ISOM, NISOM, IGRC, NALBP, NALBP2
+      CHARACTER RECNAM*80,RECNA2*80,TEXT8*8,TEXT12*12,HSMG*131,
+     > HVECT2(MAXREA)*8,HRESID*8
+      INTEGER ISTATE(NSTATE),INAME(2),IHRES(2)
+      REAL TMPDAY(3)
+      LOGICAL LUSER,LSTRD,LSPH,LMASL,LALBG
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IMIX2,ISONA,ISOMI,ITOD2,
+     > ISTY1,ISTY2,IPIFI,IMICR,ITOD1,JJSO,IPYMIX,LOCAD,REACTION,ISOTOPE,
+     > ADDRISO,IGYELD,IADRY,DIMS_MPO
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: HUSE2,HNAM2,OUPUTID
+      INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: ADDRXS
+      REAL, ALLOCATABLE, DIMENSION(:) :: DENS2,DENS3,VOL2,VOLMI2,SPH,
+     > ENER,VOSAP,CONCE,TAUXFI,NWT0,FLUXS,DENIS,GAR1,GAR2,LAMB,BETAR,
+     > INVELS,BETARB,INVELSB,DECAY2,RVALO
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: DENS1,FACT,CHIRS,CHIRSB,
+     > TAUXGF
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: XS,SIGS,DENS0,FLUX,YLDS2
+      REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: SS2D
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: YLDSM
+      LOGICAL, ALLOCATABLE, DIMENSION(:) :: LXS,MASK,MASKL
+      CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: HPYNAM
+      CHARACTER(LEN=24), ALLOCATABLE, DIMENSION(:) :: TEXT24,NOMREA,
+     > NOMISO
+      CHARACTER(LEN=80), ALLOCATABLE, DIMENSION(:) :: LOCTYP,LOCKEY
+*----
+*  RECOVER MPO FILE CHARACTERISTICS
+*----
+      I=0
+      CALL MPOTOC(IPMPO,HEDIT,0,NREA,I0,NMIL,NPAR,NLOC,NISOF,NISOP,
+     > NISOS,NCALS,I,NSURFD,NALBP,NPRC)
+      IF(NBISO.NE.I0) CALL XABORT('MCRLIB: INVALID VALUE OF NBISO.')
+      IF(NGRP.NE.I) CALL XABORT('MCRLIB: INVALID VALUE OF NGRP.')
+      IF(NREA+2.GT.MAXREA) CALL XABORT('MCRLIB: MAXREA OVERFLOW')
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(IMIX2(MAXISO),ITOD2(MAXISO),ISTY1(MAXISO),ISTY2(MAXISO),
+     > HUSE2(3,MAXISO),HNAM2(3,MAXISO))
+      ALLOCATE(DENS2(MAXISO),DENS3(MAXISO),VOL2(MAXISO),VOLMI2(NMIX),
+     > FLUX(NMIX,NGRP,2),SPH(NGRP))
+*----
+*  MICROLIB INITIALIZATION
+*----
+      VOLMI2(:NMIX)=0.0
+      DENS2(:MAXISO)=0.0
+      VOL2(:MAXISO)=0.0
+      IMIX2(:MAXISO)=0
+      ITOD2(:MAXISO)=0
+      ISTY2(:MAXISO)=0
+      IF(IACCS.EQ.0) THEN
+        IF(LRES) CALL XABORT('MCRLIB: RES OPTION IS INVALID.')
+        NBISO2=0
+        NED2=0
+        TEXT12='L_LIBRARY'
+        CALL LCMPTC(IPLIB,'SIGNATURE',12,TEXT12)
+      ELSE
+        CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+        IF(ISTATE(1).NE.NMIX) CALL XABORT('MCRLIB: INVALID NUMBER OF '
+     1  //'MATERIAL MIXTURES IN THE MICROLIB.')
+        IF(ISTATE(3).NE.NGRP) CALL XABORT('MCRLIB: INVALID NUMBER OF '
+     1  //'ENERGY GROUPS IN THE MICROLIB.')
+        NBISO2=ISTATE(2)
+        IF(NBISO2.GT.MAXISO) CALL XABORT('MCRLIB: MAXISO OVERFLOW(1).')
+        NED2=ISTATE(13)
+        IF(NED2.GT.MAXREA) CALL XABORT('MCRLIB: MAXREA OVERFLOW.')
+        CALL LCMLEN(IPLIB,'MIXTURESVOL',ILONG,ITYLCM)
+        IF(ILONG.GT.0) THEN
+          CALL LCMGET(IPLIB,'MIXTURESVOL',VOLMI2)
+        ELSE
+          VOLMI2(:NMIX)=0.0
+        ENDIF
+        CALL LCMGET(IPLIB,'ISOTOPESUSED',HUSE2)
+        CALL LCMGET(IPLIB,'ISOTOPERNAME',HNAM2)
+        CALL LCMGET(IPLIB,'ISOTOPESDENS',DENS2)
+        CALL LCMGET(IPLIB,'ISOTOPESVOL',VOL2)
+        CALL LCMGET(IPLIB,'ISOTOPESMIX',IMIX2)
+        CALL LCMGET(IPLIB,'ISOTOPESTODO',ITOD2)
+        CALL LCMGET(IPLIB,'ISOTOPESTYPE',ISTY2)
+        IF(NED2.GT.0) CALL LCMGTC(IPLIB,'ADDXSNAME-P0',8,NED2,HVECT2)
+      ENDIF
+*----
+*  SET EQUIVALENCE AND HEAVY DENSITY FLAGS.
+*----
+      LSPH=.FALSE.
+      LMASL=.FALSE.
+      NLOC=0
+      IF(hdf5_group_exists(IPMPO,"/local_values/")) THEN
+        CALL hdf5_read_data(IPMPO,"/local_values/LOCVALTYPE",LOCTYP)
+        CALL hdf5_read_data(IPMPO,"/local_values/LOCVALNAME",LOCKEY)
+        NLOC=SIZE(LOCTYP,1)
+        DO ILOC=1,NLOC
+          LSPH=LSPH.OR.((LOCTYP(ILOC).EQ.'EQUI').AND.
+     >                  (LOCKEY(ILOC).EQ.HEQUI))
+          LMASL=LMASL.OR.((LOCTYP(ILOC).EQ.'HEAVY_METAL_DENSITY').AND.
+     >                    (LOCKEY(ILOC).EQ.HMASL))
+        ENDDO
+      ENDIF
+*----
+*  FIND SCATTERING ANISOTROPY.
+*----
+      WRITE(RECNAM,'(8H/output/,A,6H/info/)') TRIM(HEDIT)
+      CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"NADDRXS",NADDRXS)
+      CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"ADDRXS",ADDRXS)
+      NL=0
+      DO I=1,NADDRXS
+        DO ISO=1,NBISO
+          NL=MAX(NL,ADDRXS(NREA+1,ISO,I))
+          NL=MAX(NL,ADDRXS(NREA+2,ISO,I))
+        ENDDO
+      ENDDO
+      IF(IMPX.GT.1) THEN
+        WRITE(6,'(37H MCRLIB: number of legendre orders  =,I4)') NL
+      ENDIF
+*----
+*  SET ENERGY MESH AND ZONE VOLUMES
+*----
+      CALL hdf5_read_data(IPMPO,"/energymesh/NENERGYMESH",NENERG)
+      CALL hdf5_read_data(IPMPO,"/geometry/NGEOMETRY",NGEOME)
+      CALL hdf5_read_data(IPMPO,"/output/OUPUTID",OUPUTID)
+      READ(HEDIT,'(7X,I2)') ID
+      ID_G=0
+      ID_E=0
+      DO I=1,NGEOME
+        DO J=1,NENERG
+          IF(OUPUTID(J,I).EQ.ID) THEN
+            ID_G=I-1
+            ID_E=J-1
+            GO TO 10
+          ENDIF
+        ENDDO
+      ENDDO
+      CALL XABORT('MCRLIB: no ID found in /output/OUPUTID.')
+   10 WRITE(RECNAM,'(23H/energymesh/energymesh_,I0)') ID_E
+      CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"/ENERGY",ENER)
+      IF(SIZE(ENER,1)-1.NE.NGRP) CALL XABORT('MCRLIB: INVALID NGRP VAL'
+     > //'UE.')
+      DO IGR=1,NGRP+1
+        ENER(IGR)=ENER(IGR)/1.0E-6
+      ENDDO
+      WRITE(RECNAM,'(19H/geometry/geometry_,I0,1H/)') ID_G
+      CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"ZONEVOLUME",VOSAP)
+      CALL LCMPUT(IPLIB,'ENERGY',NGRP+1,2,ENER)
+      DO IGR=1,NGRP
+        ENER(IGR)=LOG(ENER(IGR)/ENER(IGR+1))
+      ENDDO
+      CALL LCMPUT(IPLIB,'DELTAU',NGRP,2,ENER)
+      DEALLOCATE(ENER)
+*----
+*  RECOVER INFORMATION ON REACTIONS AND ISOTOPE NAMES
+*----
+      IREAB=0
+      IREAF=0
+      WRITE(RECNAM,'(8H/output/,A,6H/info/)') TRIM(HEDIT)
+      CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"REACTION",REACTION)
+      CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"ISOTOPE",ISOTOPE)
+      CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"ADDRISO",ADDRISO)
+      NBISO=ADDRISO(SIZE(ADDRISO,1))
+      IF(NBISO.EQ.0) CALL XABORT('MCRLIB: NO CROSS SECTIONS.')
+      ALLOCATE(NOMREA(NREA+2),NOMISO(NBISO))
+      IF(NREA.GT.0) THEN
+        CALL hdf5_read_data(IPMPO,"/contents/reactions/REACTIONAME",
+     >  TEXT24)
+        DO I=1,NREA
+          NOMREA(I)=TEXT24(REACTION(I)+1)
+        ENDDO
+        DEALLOCATE(TEXT24,REACTION)
+        DO IREA=1,NREA
+          IF(NOMREA(IREA).EQ.'Absorption') THEN
+            IREAB=IREA
+            EXIT
+          ENDIF
+        ENDDO
+        DO IREA=1,NREA
+          IF(NOMREA(IREA).EQ.'NuFission') THEN
+            IREAF=IREA
+            EXIT
+          ENDIF
+        ENDDO
+      ENDIF
+      NOMREA(NREA+1)='Total'
+      NOMREA(NREA+2)='Leakage'
+      NREA=NREA+2
+      CALL hdf5_read_data(IPMPO,"/contents/isotopes/ISOTOPENAME",TEXT24)
+      DO I=1,NBISO
+        NOMISO(I)=TEXT24(ISOTOPE(I)+1)
+      ENDDO
+      DEALLOCATE(TEXT24,ADDRISO,ISOTOPE)
+      IF(IMPX.GT.1) THEN
+        WRITE(6,'(/24H MCRLIB: reaction names:)')
+        DO I=1,NREA
+          WRITE(6,'(5X,7HNOMREA(,I3,2H)=,A)') I,TRIM(NOMREA(I))
+        ENDDO
+        WRITE(6,'(/23H MCRLIB: isotope names:)')
+        DO I=1,NBISO
+          WRITE(6,'(5X,7HNOMISO(,I3,2H)=,A)') I,TRIM(NOMISO(I))
+        ENDDO
+      ENDIF
+*----
+*  LOOP OVER MPO MIXTURES TO COMPUTE DENS0(NMIL,NCAL,NBISO)
+*----
+      ALLOCATE(DENS0(NMIL,NCAL,NBISO))
+      DENS0(:NMIL,:NCAL,:NBISO)=0.0
+      DO 30 IBMOLD=1,NMIL
+      DO ICAL=1,NCAL
+        DO IBM=1,NMIX
+          IF((TERP(ICAL,IBM).NE.0.0).AND.(MIXC(IBM).EQ.IBMOLD)) GO TO 15
+        ENDDO
+        CYCLE
+   15   WRITE(RECNAM,'(8H/output/,A,9H/statept_,I0,6H/zone_,I0,1H/)')
+     >  TRIM(HEDIT),ICAL-1,IBMOLD-1
+        IF(NBISO.GT.0) THEN
+          CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"CONCENTRATION",CONCE)
+          DO 20 ISO=1,NBISO
+            DENS0(IBMOLD,ICAL,ISO)=CONCE(ISO)
+   20     CONTINUE
+          DEALLOCATE(CONCE)
+        ENDIF
+      ENDDO
+   30 CONTINUE
+*----
+*  LOOP OVER MICROLIB MIXTURES
+*----
+      YLDS(:MY1,:MY2)=0.0D0
+      DECAYC(:NBISO)=0.0D0
+      VTOT=0.0D0
+      DO 40 IBM=1,NMIX
+      IBMOLD=MIXC(IBM)
+      IF(IBMOLD.NE.0) VTOT=VTOT+VOSAP(IBMOLD)
+   40 CONTINUE
+      ALLOCATE(JJSO(NBISO),YLDSM(MY1,MY2),ITOD1(NBISO))
+      ALLOCATE(TAUXFI(NBISO),NWT0(NGRP),SIGS(NGRP,NL,NBISO),
+     > SS2D(NGRP,NGRP,NL,NBISO),XS(NGRP,NREA,NBISO))
+      ALLOCATE(LXS(NREA))
+      ALLOCATE(CHIRS(NGRP,NPRC),BETAR(NPRC),INVELS(NGRP))
+      CHIRS(:NGRP,:NPRC)=0.0
+      BETAR(:NPRC)=0.0
+      INVELS(:NGRP)=0.0
+      ALLOCATE(BETARB(NPRC),INVELSB(NGRP))
+      ALLOCATE(DENS1(NBISO,NCAL),FACT(NBISO,NCAL))
+      JPLIB=LCMLID(IPLIB,'ISOTOPESLIST',NBISO*NMIX)
+*
+      DO 180 IBM=1,NMIX
+      IBMOLD=MIXC(IBM)
+      IF(IBMOLD.EQ.0) GO TO 180
+      IF(NISO(IBM).GT.MAXNIS) CALL XABORT('MCRLIB: MAXNIS OVERFLOW.')
+      VOLMI2(IBM)=VOSAP(IBMOLD)
+*----
+*  RECOVER ITOD1(NBISO) INDICES.
+*----
+      ITOD1(:NBISO)=0
+      DO 50 ISO=1,NBISO ! MPO file isotope
+        DO KSO=1,NISO(IBM) ! user-selected isotope
+          IF(NOMISO(ISO).EQ.HISO(IBM,KSO)) THEN
+            ITOD1(ISO)=ITODO(IBM,KSO)
+            GO TO 50
+          ENDIF
+        ENDDO
+   50 CONTINUE
+*----
+*  COMPUTE THE NUMBER DENSITIES OF EACH ELEMENTARY CALCULATION.
+*----
+      DENS1(:NBISO,:NCAL)=0.0
+      DENS3(:NBISO)=0.0
+      DO ICAL=1,NCAL
+        WEIGHT=TERP(ICAL,IBM)
+        IF(WEIGHT.EQ.0.0) CYCLE
+        DO ISO=1,NBISO
+          LUSER=.FALSE.
+          KSO1=0
+          DO KSO=1,NISO(IBM) ! user-selected isotope
+            IF(NOMISO(ISO).EQ.HISO(IBM,KSO)) THEN
+              KSO1=KSO
+              LUSER=(CONC(IBM,KSO1).NE.-99.99)
+              GO TO 60
+            ENDIF
+          ENDDO
+   60     IF(LUSER) THEN
+            DENS1(ISO,ICAL)=CONC(IBM,KSO1)
+            CYCLE
+          ENDIF
+          IF(.NOT.LISO(IBM)) CYCLE
+          DENS1(ISO,ICAL)=DENS0(IBMOLD,ICAL,ISO)
+        ENDDO
+        DO ISO=1,NBISO
+          DENS3(ISO)=DENS3(ISO)+WEIGHT*DENS1(ISO,ICAL)
+        ENDDO
+      ENDDO
+      FACT(:NBISO,:NCAL)=1.0
+      IF(.NOT.LPURE) THEN
+        DO ICAL=1,NCAL
+          IF(TERP(ICAL,IBM).EQ.0.0) CYCLE
+          DO ISO=1,NBISO
+            IF(DENS3(ISO).GT.DENS1(ISO,ICAL)*1.0E-9) THEN
+              FACT(ISO,ICAL)=DENS1(ISO,ICAL)/DENS3(ISO)
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDIF
+*----
+*  INITIALIZE WORKING ARRAYS.
+*----
+      TAUXFI(:NBISO)=0.0
+      NWT0(:NGRP)=0.0
+      SIGS(:NGRP,:NL,:NBISO)=0.0
+      SS2D(:NGRP,:NGRP,:NL,:NBISO)=0.0
+      XS(:NGRP,:NREA,:NBISO)=0.0
+      LXS(:NREA)=.FALSE.
+      YLDSM(:MY1,:MY2)=0.0D0
+*----
+*  MAIN LOOP OVER ELEMENTARY CALCULATIONS
+*----
+      TEXT12='*MAC*RES'
+      READ(TEXT12,'(2A4)') IHRES(1),IHRES(2)
+      LSTRD=.FALSE.
+      DO 80 ICAL=1,NCAL
+      WEIGHT=TERP(ICAL,IBM)
+      IF(WEIGHT.EQ.0.0) GO TO 80
+*----
+*  SELECT THE HDF5 GROUP CORRESPONDING TO ICAL AND IBMOLD
+*----
+      WRITE(RECNAM,'(8H/output/,A,9H/statept_,I0,6H/zone_,I0,1H/)')
+     > TRIM(HEDIT),ICAL-1,IBMOLD-1
+      NMGF=0
+      IF(hdf5_group_exists(IPMPO,TRIM(RECNAM)//"yields")) THEN
+        CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"yields/NMGF",NMGF)
+        CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"yields/YIELDGROUP",
+     >  IGYELD)
+      ENDIF
+      ALLOCATE(TAUXGF(NMGF,NBISO))
+*----
+*  RECOVER INFORMATION FROM caldir GROUP.
+*----
+      WRITE(RECNA2,'(A,9Hkinetics/)') TRIM(RECNAM)
+      CALL hdf5_info(IPMPO,TRIM(RECNA2)//"LAMBDA",RANK,TYPE,NBYTE,DIMSR)
+      NPRC=0
+      IF(TYPE.NE.99) THEN
+        NPRC=DIMSR(1)
+        CALL hdf5_read_data(IPMPO,TRIM(RECNA2)//"LAMBDA",LAMB)
+        CALL hdf5_read_data(IPMPO,TRIM(RECNA2)//"CHIDA",CHIRSB)
+        CALL hdf5_read_data(IPMPO,TRIM(RECNA2)//"BETADA",BETARB)
+        CALL hdf5_read_data(IPMPO,TRIM(RECNA2)//"INVELA",INVELSB)
+      ENDIF
+*----
+*  RECOVER SPH FACTORS.
+*----
+      SPH(:NGRP)=1.0
+      IF(HEQUI.NE.' ') THEN
+        CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"LOCALVALUE",RVALO)
+        CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"LOCALVALADDR",LOCAD)
+        DO ILOC=1,NLOC
+          IF((LOCTYP(ILOC).EQ.'EQUI').AND.(LOCKEY(ILOC).EQ.HEQUI))
+     >    THEN
+            IF(LOCAD(ILOC+1)-LOCAD(ILOC).NE.NGRP) THEN
+              CALL XABORT('MCRLIB: INVALID NUMBER OF COMPONENTS FOR '
+     >        //'SPH FACTORS')
+            ENDIF
+            DO IGR=1,NGRP
+              SPH(IGR)=RVALO(LOCAD(ILOC)+IGR-1)
+            ENDDO
+          ENDIF
+        ENDDO
+        DEALLOCATE(LOCAD,RVALO)
+      ENDIF
+*----
+*  RECOVER FLUXES.
+*----
+      CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"ZONEFLUX",FLUXS)
+      DO I=1,NGRP
+        NWT0(I)=NWT0(I)+WEIGHT*FLUXS(I)/SPH(I)
+      ENDDO
+*----
+*  RECOVER MICROSCOPIC CROSS SECTIONS.
+*----
+      DO ISO=1,NBISO
+        FACT0=FACT(ISO,ICAL)
+        DEN=DENS0(IBMOLD,ICAL,ISO)
+        CALL MCRSX2(IPMPO,HEDIT,RECNAM,NREA,NGRP,NMGF,NL,ISO,NOMREA,
+     1  NOMISO(ISO),DEN,FACT0,WEIGHT,SPH,FLUXS,IREAB,IREAF,LPURE,IGYELD,
+     2  LXS,XS(1,1,ISO),SIGS(1,1,ISO),SS2D(1,1,1,ISO),TAUXFI(ISO),
+     3  TAUXGF(1,ISO))
+      ENDDO
+      IF(NMGF.GT.0) DEALLOCATE(IGYELD)
+      DEALLOCATE(FLUXS)
+*
+      IF(NPRC.GT.0) THEN
+        DO IGR=1,NGRP
+          INVELS(IGR)=INVELS(IGR)+SPH(IGR)*WEIGHT*INVELSB(IGR)
+          DO IPRC=1,NPRC
+            CHIRS(IGR,IPRC)=CHIRS(IGR,IPRC)+WEIGHT*CHIRSB(IGR,IPRC)
+          ENDDO
+        ENDDO
+        DO IPRC=1,NPRC
+          BETAR(IPRC)=BETAR(IPRC)+WEIGHT*BETARB(IPRC)
+        ENDDO
+      ENDIF
+*----
+*  COMPUTE DEPLETION CHAIN DATA
+*----
+      IF(NISOF*NISOP.GT.0) THEN
+        IF(NMGF.EQ.0) CALL XABORT('MCRLIB: INVALID NMGF.')
+        WRITE(RECNAM,'(8H/output/,A,9H/statept_,I0,6H/zone_,I0,1H/)')
+     >  TRIM(HEDIT),ICAL-1,IBMOLD-1
+        CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"yields/NISF",I0)
+        IF(I0.NE.NISOF) CALL XABORT('MCRLIB: INVALID NISOF.')
+        CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"yields/NISP",I0)
+        IF(I0.NE.NISOP) CALL XABORT('MCRLIB: INVALID NISOP.')
+        CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"yields/YIELD",YLDS2)
+        CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"yields/ADDRY",
+     >  DIMS_MPO)
+        CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"ADDRZI",ADDRZI)
+        WRITE(RECNAM,'(8H/output/,A,6H/info/)') TRIM(HEDIT)
+        CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"ADDRISO",ADDRISO)
+        NISOM=ADDRISO(ADDRZI+2)-ADDRISO(ADDRZI+1)
+        DO IY1=1,NISOF
+          ISO=0
+          DO ISOM=1,NISOM
+            IF(DIMS_MPO(ISOM).EQ.IY1) THEN
+              ISO=ADDRISO(ADDRZI+1)+ISOM
+              EXIT
+            ENDIF
+          ENDDO
+          IF(ISO.EQ.0) CALL XABORT('MCRLIB: UNABLE TO FIND ISO.')
+          DEN=0.0
+          DO IGRC=1,NMGF
+            DEN=DEN+TAUXGF(IGRC,ISO)
+            DO IY2=1,NISOP
+              YLDSM(IY1,IY2)=YLDSM(IY1,IY2)+WEIGHT*TAUXGF(IGRC,ISO)*
+     >        YLDS2(IY1,IY2,IGRC)
+              YLDS(IY1,IY2)=YLDS(IY1,IY2)+WEIGHT*TAUXGF(IGRC,ISO)*
+     >        YLDS2(IY1,IY2,IGRC)*VOLMI2(IBM)/VTOT
+            ENDDO
+          ENDDO
+          IF(DEN.EQ.0.0) CYCLE
+          DO IY2=1,NISOP
+            YLDSM(IY1,IY2)=YLDSM(IY1,IY2)/DEN
+            YLDS(IY1,IY2)=YLDS(IY1,IY2)/DEN
+          ENDDO
+        ENDDO
+        DEALLOCATE(ADDRISO,DIMS_MPO,YLDS2)
+      ENDIF
+      CALL hdf5_info(IPMPO,"/contents/isotopes/DECAYCONST",RANK,TYPE,
+     1 NBYTE,DIMSR)
+      IF(TYPE.NE.99) THEN
+        CALL hdf5_read_data(IPMPO,"/contents/isotopes/DECAYCONST",
+     >  DECAY2)
+        DO ISO=1,NBISO
+          DECAYC(ISO)=DECAYC(ISO)+WEIGHT*DECAY2(ISO)*VOLMI2(IBM)/VTOT
+        ENDDO
+        DEALLOCATE(DECAY2)
+      ENDIF
+      DEALLOCATE(TAUXGF)
+   80 CONTINUE ! end of loop over elementary calculations.
+*----
+*  IDENTIFY SPECIAL FLUX EDITS
+*----
+      DO 100 IREA=1,NREA
+        IF((NOMREA(IREA).EQ.'Total').or.
+     &     (NOMREA(IREA).EQ.'Absorption').or.
+     &     (NOMREA(IREA).EQ.'CaptureEnergyCapture').or.
+     &     (NOMREA(IREA).EQ.'Diffusion').or.
+     &     (NOMREA(IREA).EQ.'FissionEnergyFission').or.
+     &     (NOMREA(IREA).EQ.'FissionSpectrum').or.
+     &     (NOMREA(IREA).EQ.'NuFission').or.
+     &     (NOMREA(IREA).EQ.'Scattering')) CYCLE
+        DO 90 IED2=1,NED2
+        IF(HVECT2(IED2).EQ.NOMREA(IREA)(:8)) GO TO 100
+        IF(HVECT2(IED2).EQ.'NFTOT') GO TO 100
+   90   CONTINUE
+        NED2=NED2+1
+        IF(NED2.GT.MAXREA) CALL XABORT('MCRLIB: MAXREA OVERFLOW.')
+        IF(NOMREA(IREA).EQ.'Fission') THEN
+          HVECT2(NED2)='NFTOT'
+        ELSE
+          HVECT2(NED2)=NOMREA(IREA)(:8)
+        ENDIF
+  100 CONTINUE
+*----
+*  SET FLAG LSTRD
+*----
+      LSTRD=.TRUE.
+      DO IREA=1,NREA
+        IF(NOMREA(IREA).EQ.'Leakage') THEN
+          IF(LXS(IREA)) LSTRD=.FALSE.
+          EXIT
+        ENDIF
+      ENDDO
+*----
+*  SET IADRY FOR MIXTURE IBMOLD
+*----
+      ALLOCATE(IADRY(NBISO))
+      IADRY(:NBISO)=0
+      DO ICAL=NCAL,1,-1
+      IF(TERP(ICAL,IBM).EQ.0.0) CYCLE
+        WRITE(RECNAM,'(8H/output/,A,9H/statept_,I0,6H/zone_,I0,1H/)')
+     1  TRIM(HEDIT),ICAL-1,IBMOLD-1
+        IF((hdf5_group_exists(IPMPO,TRIM(RECNAM)//"yields")).AND.
+     1    (NISOP.GT.0)) THEN
+          CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"yields/ADDRY",
+     1    DIMS_MPO)
+          CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"ADDRZI",ADDRZI)
+          WRITE(RECNAM,'(8H/output/,A,6H/info/)') TRIM(HEDIT)
+          CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"ADDRISO",ADDRISO)
+          NISOM=ADDRISO(ADDRZI+2)-ADDRISO(ADDRZI+1)
+          DO ISOM=1,NISOM
+            ISO=ADDRISO(ADDRZI+1)+ISOM
+            IADRY(ISO)=DIMS_MPO(ISOM)
+          ENDDO
+          DEALLOCATE(ADDRISO,DIMS_MPO)
+        ENDIF
+        EXIT
+      ENDDO
+*----
+*  SAVE CROSS SECTIONS IN MICROLIB FOR MIXTURE IBM
+*----
+      ISTY1(:NBISO)=0
+      JJSO(:NBISO)=0
+      NBISO2I=NBISO2
+      HRESID=' '
+      DO ISO=1,NBISO
+        READ(NOMISO(ISO),'(2A4)') INAME(:2)
+        CALL SCRFND(MAXISO,NBISO2I,NBISO2,INAME,IBM,HRESID,HUSE2,
+     1  HNAM2,IMIX2,JJSO(ISO))
+        KPLIB=LCMDIL(JPLIB,JJSO(ISO)) ! step up isot JJSO(ISO)
+        CALL MCRISO(KPLIB,NREA,NGRP,NL,NPRC,NOMREA,NWT0,XS(1,1,ISO),
+     1  SIGS(1,1,ISO),SS2D(1,1,1,ISO),TAUXFI(ISO),LXS,LAMB,CHIRS,
+     2  BETAR,INVELS,INAME,LSTRD,LPURE,ILUPS,ITRANC,IFISS)
+        IF(MY1*MY2.GT.0) CALL MCRNDF(IMPX,NBISO,ISO,IBM,NOMISO,KPLIB,
+     1  MY1,MY2,YLDSM,IADRY,ISTY1(ISO))
+      ENDDO
+      DEALLOCATE(IADRY)
+*----
+*  SET NUMBER DENSITIES AND VOLUMES IN OUTPUT MICROLIB
+*----
+      IF(LRES) THEN
+*       -- Number densities are left unchanged except if they are
+*       -- listed in HISO array.
+        DO 110 KSO=1,NISO(IBM) ! user-selected isotope
+          DO JSO=1,NBISO2 ! microlib isotope
+            IF(IMIX2(JSO).NE.IBM) CYCLE
+            WRITE(TEXT8,'(2A4)') HUSE2(1,JSO),HUSE2(2,JSO)
+            IF(HISO(IBM,KSO).EQ.TEXT8) THEN
+              ITOD2(JSO)=ITODO(IBM,KSO)
+              IF(CONC(IBM,KSO).EQ.-99.99) THEN
+*               -- Only number densities of isotopes set with "MICR" and
+*               -- "*" keywords are interpolated
+                DENS2(JSO)=0.0
+                DO ISO=1,NBISO ! MPO file isotope
+                  IF(JJSO(ISO).EQ.JSO) DENS2(JSO)=DENS2(JSO)+DENS3(ISO)
+                ENDDO
+              ELSE IF(CONC(IBM,KSO).NE.-99.99) THEN
+*               -- Number densities of isotopes set with "MICR" and
+*               -- fixed value are forced to this value
+                DENS2(JSO)=CONC(IBM,KSO)
+              ENDIF
+              GO TO 110
+            ENDIF
+          ENDDO
+          WRITE(HSMG,'(31HMCRLIB: UNABLE TO FIND ISOTOPE ,A8,6H IN MI,
+     1    5HXTURE,I8,1H.)') HISO(IBM,KSO),IBM
+          CALL XABORT(HSMG)
+  110   CONTINUE
+      ELSE
+*       -- Number densities are interpolated or not according to
+*       -- ALL/ONLY option
+        DO JSO=1,NBISO2 ! microlib isotope
+          WRITE(TEXT8,'(2A4)') HUSE2(1,JSO),HUSE2(2,JSO)
+          IF(IBM.EQ.IMIX2(JSO)) THEN
+            DO ISO=1,NBISO ! MPO file isotope
+              IF(NOMISO(ISO).EQ.TEXT8) THEN
+                DENS2(JSO)=0.0
+                VOL2(JSO)=0.0
+                CYCLE
+              ENDIF
+            ENDDO
+          ENDIF
+        ENDDO
+        DO 130 ISO=1,NBISO ! MPO file isotope
+        IF(.NOT.LISO(IBM)) THEN
+*         --ONLY option
+          DO KSO=1,NISO(IBM) ! user-selected isotope
+            IF(NOMISO(ISO).EQ.HISO(IBM,KSO)) GO TO 120
+          ENDDO
+          GO TO 130
+        ENDIF
+  120   JSO=JJSO(ISO)
+        IF(JSO.GT.0) THEN
+          ITOD2(JSO)=ITOD1(ISO)
+          ISTY2(JSO)=ISTY1(ISO)
+          DENS2(JSO)=DENS2(JSO)+DENS3(ISO)
+          VOL2(JSO)=VOL2(JSO)+VOSAP(IBMOLD)
+        ENDIF
+  130   CONTINUE
+      ENDIF
+*----
+*  SET PIFI INFORMATION
+*----
+      ALLOCATE(IMICR(NBISO))
+      IMICR(:NBISO)=0
+      NBS1=0
+      DO 140 JSO=1,NBISO2 ! microlib isotope
+      IF(IMIX2(JSO).EQ.IBM) THEN
+        NBS1=NBS1+1
+        IF(NBS1.GT.NBISO) CALL XABORT('MCRLIB: NBISO OVERFLOW.')
+        IMICR(NBS1)=JSO
+      ENDIF
+  140 CONTINUE
+      DO 170 ISO=1,NBS1 ! MPO file isotope
+      JSO=IMICR(ISO)
+      KPLIB=LCMDIL(JPLIB,JSO) ! step up isot JSO
+      CALL LCMLEN(KPLIB,'PYIELD',LMY1,ITYLCM)
+      IF(LMY1.GT.0) THEN
+        ALLOCATE(HPYNAM(LMY1),IPYMIX(LMY1),IPIFI(LMY1))
+        IPIFI(:LMY1)=0
+        CALL LCMGTC(KPLIB,'PYNAM',8,LMY1,HPYNAM)
+        CALL LCMGET(KPLIB,'PYMIX',IPYMIX)
+        DO 160 IY1=1,LMY1
+        IF(HPYNAM(IY1).NE.' ') THEN
+          DO 150 KSO=1,NBS1
+          LSO=IMICR(KSO)
+          WRITE(TEXT8,'(2A4)') HUSE2(:2,LSO)
+          IF((HPYNAM(IY1).EQ.TEXT8).AND.(IPYMIX(IY1).EQ.IMIX2(LSO)))
+     >    THEN
+            IPIFI(IY1)=LSO
+            GO TO 160
+          ENDIF
+  150     CONTINUE
+          IF(IPIFI(IY1).EQ.0) THEN
+            WRITE(HSMG,'(40HMCRLIB: FAILURE TO FIND FISSILE ISOTOPE ,
+     1      A12,25H AMONG MICROLIB ISOTOPES.)') HPYNAM(IY1)
+            CALL XABORT(HSMG)
+          ENDIF
+        ENDIF
+  160   CONTINUE
+        CALL LCMPUT(KPLIB,'PIFI',LMY1,1,IPIFI)
+        DEALLOCATE(IPIFI,IPYMIX,HPYNAM)
+      ENDIF
+  170 CONTINUE
+      DEALLOCATE(IMICR)
+  180 CONTINUE ! end of loop over microlib mixtures.
+*----
+*  RELEASE MEMORY
+*----
+      DEALLOCATE(FACT,DENS1)
+      IF(NPRC.GT.0) DEALLOCATE(INVELSB,BETARB,CHIRSB,INVELS,BETAR,
+     > CHIRS,LAMB)
+      DEALLOCATE(LXS,XS,SS2D,SIGS,NWT0,TAUXFI)
+      DEALLOCATE(ITOD1,YLDSM)
+      DEALLOCATE(JJSO,DENS0,NOMISO)
+*----
+*  MICROLIB FINALIZATION
+*----
+      IF(.NOT.LRES) THEN
+        ISTATE(:NSTATE)=0
+        ISTATE(1)=NMIX
+        ISTATE(2)=NBISO2
+        ISTATE(3)=NGRP
+        ISTATE(4)=NL
+        ISTATE(5)=ITRANC
+        ISTATE(7)=1
+        IF(ITER.EQ.3) ISTATE(12)=NMIX
+        ISTATE(13)=NED2
+        ISTATE(14)=NMIX
+        ISTATE(18)=1
+        ISTATE(19)=NPRC
+        ISTATE(20)=MY1
+        ISTATE(22)=MAXISO/NMIX
+        IF(NBISO2.EQ.0) CALL XABORT('MCRLIB: NBISO2=0.')
+        CALL LCMPUT(IPLIB,'STATE-VECTOR',NSTATE,1,ISTATE)
+        CALL LCMPUT(IPLIB,'MIXTURESVOL',NMIX,2,VOLMI2)
+        CALL LCMPUT(IPLIB,'ISOTOPESUSED',3*NBISO2,3,HUSE2)
+        CALL LCMPUT(IPLIB,'ISOTOPERNAME',3*NBISO2,3,HNAM2)
+        CALL LCMPUT(IPLIB,'ISOTOPESDENS',NBISO2,2,DENS2)
+        CALL LCMPUT(IPLIB,'ISOTOPESMIX',NBISO2,1,IMIX2)
+        CALL LCMPUT(IPLIB,'ISOTOPESVOL',NBISO2,2,VOL2)
+        IF(NED2.GT.0) CALL LCMPTC(IPLIB,'ADDXSNAME-P0',8,NED2,HVECT2)
+        CALL LCMPUT(IPLIB,'ISOTOPESTODO',NBISO2,1,ITOD2)
+        CALL LCMPUT(IPLIB,'ISOTOPESTYPE',NBISO2,1,ISTY2)
+      ELSE IF(LRES.AND.(NBISO.GT.0)) THEN
+        CALL LCMPUT(IPLIB,'ISOTOPESDENS',NBISO2,2,DENS2)
+        CALL LCMPUT(IPLIB,'ISOTOPESVOL',NBISO2,2,VOL2)
+      ENDIF
+      IF(IMPX.GT.5) CALL LCMLIB(IPLIB)
+*----
+*  COMPUTE THE MACROSCOPIC X-SECTIONS
+*----
+      IF((ITER.NE.0).AND.(ITER.NE.3)) GO TO 280
+      CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+      MAXMIX=ISTATE(1)
+      IF(MAXMIX.NE.NMIX) CALL XABORT('MCRLIB: INVALID NMIX.')
+      NBISO=ISTATE(2)
+      ALLOCATE(MASK(MAXMIX),MASKL(NGRP))
+      ALLOCATE(ISONA(3*NBISO),ISOMI(NBISO),DENIS(NBISO))
+      CALL LCMGET(IPLIB,'ISOTOPESUSED',ISONA)
+      CALL LCMGET(IPLIB,'ISOTOPESMIX',ISOMI)
+      CALL LCMGET(IPLIB,'ISOTOPESDENS',DENIS)
+      MASK(:MAXMIX)=.TRUE.
+      MASKL(:NGRP)=.TRUE.
+      ITSTMP=0
+      TMPDAY(1)=0.0
+      TMPDAY(2)=0.0
+      TMPDAY(3)=0.0
+      CALL LCMLEN(IPLIB,'MACROLIB',ILONG,ITYLCM)
+      IF(ILONG.NE.0) CALL LCMDEL(IPLIB,'MACROLIB')
+      CALL LIBMIX(IPLIB,MAXMIX,NGRP,NBISO,ISONA,ISOMI,DENIS,MASK,MASKL,
+     > ITSTMP,TMPDAY)
+      DEALLOCATE(MASKL,MASK)
+      DEALLOCATE(DENIS,ISOMI,ISONA)
+*----
+*  INCLUDE LEAKAGE IN THE MACROLIB (USED ONLY FOR NON-REGRESSION TESTS)
+*----
+      IF(B2.NE.0.0) THEN
+        IF(IMPX.GT.0) WRITE(IOUT,'(/31H MCRLIB: INCLUDE LEAKAGE IN THE,
+     >  14H MACROLIB (B2=,1P,E12.5,2H).)') B2
+        CALL LCMSIX(IPLIB,'MACROLIB',1)
+        JPLIB=LCMGID(IPLIB,'GROUP')
+        ALLOCATE(GAR1(NMIX),GAR2(NMIX))
+        DO 270 IGR=1,NGRP
+          KPLIB=LCMGIL(JPLIB,IGR)
+          CALL LCMGET(KPLIB,'NTOT0',GAR1)
+          CALL LCMGET(KPLIB,'DIFF',GAR2)
+          DO 260 IBM=1,NMIX
+            IF(MIXC(IBM).NE.0) GAR1(IBM)=GAR1(IBM)+B2*GAR2(IBM)
+  260     CONTINUE
+          CALL LCMPUT(KPLIB,'NTOT0',NMIX,2,GAR1)
+  270   CONTINUE
+        DEALLOCATE(GAR2,GAR1)
+        CALL LCMSIX(IPLIB,' ',2)
+      ENDIF
+*----
+*  PROCESS ADF and physical albedos (if required)
+*----
+  280 LALBG=.TRUE.
+      IDF=0
+      IF(NALBP.GT.0) THEN
+        WRITE(RECNAM,'(8H/output/,A,16H/statept_0/flux/)') TRIM(HEDIT)
+        CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"NALBP",NALBP2)
+        IF(NALBP2.NE.NALBP) CALL XABORT('MCRLIB: INVALID NALBP.')
+        CALL hdf5_info(IPMPO,TRIM(RECNAM)//"ALBEDOGxG",RANK,TYPE,NBYTE,
+     &  DIMSR)
+        IF(TYPE.NE.99) LALBG=.FALSE.
+      ENDIF
+      CALL LCMSIX(IPLIB,'MACROLIB',1)
+      CALL MCRAGF(IPLIB,IPMPO,IACCS,NMIL,NMIX,NGRP,NALBP,LALBG,LADFM,
+     1 IMPX,NCAL,TERP,MIXC,NSURFD,HEDIT,VOSAP,VOLMI2,IDF)
+      IF(NSURFD.GT.0) THEN
+        CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+        ISTATE(12)=IDF ! ADF information
+        CALL LCMPUT(IPLIB,'STATE-VECTOR',NSTATE,1,ISTATE)
+      ENDIF
+      CALL LCMSIX(IPLIB,' ',2)
+      IF(NSURFD.GT.0) THEN
+        CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+        ISTATE(24)=IDF ! ADF information
+        CALL LCMPUT(IPLIB,'STATE-VECTOR',NSTATE,1,ISTATE)
+      ENDIF
+      IACCS=1
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(VOSAP)
+      DEALLOCATE(SPH,FLUX,VOLMI2,VOL2,DENS3,DENS2)
+      DEALLOCATE(HNAM2,HUSE2,ISTY2,ISTY1,ITOD2,IMIX2)
+      RETURN
+      END
diff --git a/Donjon/src/MCRMAC.f b/Donjon/src/MCRMAC.f
new file mode 100644
index 0000000..5c819da
--- /dev/null
+++ b/Donjon/src/MCRMAC.f
@@ -0,0 +1,525 @@
+*DECK MCRMAC
+      SUBROUTINE MCRMAC(IPMAC,IPMPO,IACCS,NMIL,NMIX,NGRP,LADFM,IMPX,
+     1 HEQUI,HMASL,NCAL,HEDIT,NSURFD,NALBP,ILUPS,MIXC,TERP,LPURE,B2)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Build the Macrolib by scanning the NCAL elementary calculations of
+* a HDF5 file and weighting them with TERP factors.
+*
+*Copyright:
+* Copyright (C) 2022 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPMAC   address of the output Macrolib LCM object.
+* IPMPO   pointer to the MPO file.
+* IACCS   =0 macrolib is created; =1 ... is updated.
+* NMIL    number of material mixtures in the MPO file.
+* NMIX    maximum number of material mixtures in the Macrolib.
+* NGRP    number of energy groups.
+* LADFM   type of discontinuity factors (.true.: diagonal; .false.: GxG).
+* IMPX    print parameter (equal to zero for no print).
+* HEQUI   keyword of SPH-factor set to be recovered.
+* HMASL   keyword of MASL data set to be recovered.
+* NCAL    number of elementary calculations in the MPO file.
+* HEDIT   name of output group for a (multigroup mesh, output geometry)
+*         couple (generally equal to 'output_0').
+* NSURFD  number of discontinuity factors.
+* NALBP   number of physical albedos per energy group.
+* ILUPS   up-scattering removing flag (=1 to remove up-scattering from
+*         output cross-sections).
+* MIXC    mixture index in the MPO file corresponding to each Microlib.
+*         mixture. Equal to zero if a Microlib mixture is not updated.
+* TERP    interpolation factors.
+* LPURE   =.true. if the interpolation is a pure linear interpolation 
+*         with TERP factors.
+* B2      buckling.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      USE hdf5_wrap
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAC,IPMPO
+      INTEGER IACCS,NMIL,NMIX,NGRP,IMPX,NCAL,NSURFD,NALBP,ILUPS,
+     1 MIXC(NMIX)
+      REAL TERP(NCAL,NMIX),B2
+      LOGICAL LADFM,LPURE
+      CHARACTER(LEN=80) HEQUI,HMASL
+      CHARACTER(LEN=12) HEDIT
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAX1D=40
+      INTEGER, PARAMETER::MAX2D=20
+      INTEGER, PARAMETER::MAXED=30
+      INTEGER, PARAMETER::MAXNFI=1
+      INTEGER, PARAMETER::MAXNL=6
+      INTEGER, PARAMETER::NSTATE=40
+      INTEGER, PARAMETER::MAXRES=MAX1D-8
+      INTEGER I, J, I1D, I2D, IBM, IBMOLD, ICAL, IDEL, IDF, IED, IGMAX,
+     & IGMIN, IGR, JGR, IL, ILONG, IOF, IPOSDE, ITRANC, ITYLCM, LENGTH,
+     & N1D, N2D, NDEL, NED, NEDTMP, NF, NFTMP, NL, NLTMP, IMC, ID, ID_E,
+     & ID_G, NENERG, NGEOME, IACCOLD, NALBP2, RANK, NBYTE, TYPE,
+     & DIMSR(5)
+      REAL FLOTVA, WEIGHT, B2R
+      TYPE(C_PTR) JPMAC,KPMAC,IPTMP,JPTMP,KPTMP
+      INTEGER ISTATE(NSTATE)
+      LOGICAL LMAKE1(MAX1D),LMAKE2(MAX2D),LWD,LALBG
+      CHARACTER TEXT8*8,TEXT12*12,CM*2,HMAK1(MAX1D)*12,HMAK2(MAX2D)*12,
+     1 HVECT(MAXED)*8,RECNAM*80
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IJJ,NJJ,IPOS,IJJB,NJJB,IPOSB
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: OUPUTID
+      REAL, ALLOCATABLE, DIMENSION(:) :: GAR4,GAR4B,WORK1,WORK2,VOLMI2,
+     1 ENERG,VOSAP,WDLA
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: SPH
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: GAR1
+      REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: GAR2,GAR3
+      REAL, POINTER, DIMENSION(:) :: FLOT
+      TYPE(C_PTR) FLOT_PTR
+*----
+*  DATA STATEMENTS
+*----
+      DATA HMAK1 / 'FLUX-INTG','NTOT0','OVERV','DIFF','FLUX-INTG-P1',
+     1 'NTOT1','H-FACTOR','TRANC',MAXRES*' '/
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(IJJ(NMIX),NJJ(NMIX),IPOS(NMIX),IJJB(NMIL),NJJB(NMIL),
+     1 IPOSB(NMIL))
+      ALLOCATE(GAR1(NMIX,NGRP,MAX1D),GAR2(NMIX,MAXNFI,NGRP,MAX2D),
+     1 GAR3(NMIX,NGRP,NGRP,MAXNL),GAR4(NMIX*NGRP),GAR4B(NMIL*NGRP),
+     2 VOLMI2(NMIX))
+      IACCOLD=IACCS ! for ADF
+*----
+*  MACROLIB INITIALIZATION
+*----
+      LMAKE1(:MAX1D)=.FALSE.
+      LMAKE2(:MAX2D)=.FALSE.
+      GAR1(:NMIX,:NGRP,:MAX1D)=0.0
+      GAR2(:NMIX,:MAXNFI,:NGRP,:MAX2D)=0.0
+      GAR3(:NMIX,:NGRP,:NGRP,:MAXNL)=0.0
+      VOLMI2(:NMIX)=0.0
+      IBMOLD=0
+      N1D=0
+      N2D=0
+      NDEL=0
+      NL=0
+      NF=0
+      NED=0
+      ITRANC=0
+      IDF=0
+      N1D=0
+      N2D=0
+*----
+*  READ EXISTING MACROLIB INFORMATION
+*----
+      IF(IACCS.EQ.0) THEN
+        TEXT12='L_MACROLIB'
+        CALL LCMPTC(IPMAC,'SIGNATURE',12,TEXT12)
+      ELSE
+        CALL LCMGTC(IPMAC,'SIGNATURE',12,TEXT12)
+        IF(TEXT12.NE.'L_MACROLIB') THEN
+          CALL XABORT('MCRMAC: SIGNATURE OF INPUT MACROLIB IS '//TEXT12
+     1    //'. L_MACROLIB EXPECTED.')
+        ENDIF
+        CALL LCMGET(IPMAC,'STATE-VECTOR',ISTATE)
+        IF(ISTATE(1).NE.NGRP) THEN
+          CALL XABORT('MCRMAC: INVALID NUMBER OF ENERGY GROUPS(2).')
+        ELSE IF(ISTATE(2).NE.NMIX) THEN
+          CALL XABORT('MCRMAC: INVALID NUMBER OF MIXTURES(2).')
+        ENDIF
+        NL=ISTATE(3)
+        NF=ISTATE(4)
+        IF(NF.GT.MAXNFI) CALL XABORT('MCRMAC: MAXNFI OVERFLOW(1).')
+        NED=ISTATE(5)
+        ITRANC=ISTATE(6)
+        NDEL=ISTATE(7)
+        IDF=ISTATE(12)
+        IF(NED.GT.MAXED) CALL XABORT('MCRMAC: MAXED OVERFLOW(1).')
+        CALL LCMGTC(IPMAC,'ADDXSNAME-P0',8,NED,HVECT)
+        N1D=8+NED+NL
+        N2D=2*(NDEL+1)
+        IF(NL.GT.MAXNL) CALL XABORT('MCRMAC: MAXNL OVERFLOW(1).')
+        IF(N1D.GT.MAX1D) CALL XABORT('MCRMAC: MAX1D OVERFLOW(1).')
+        IF(N2D.GT.MAX2D) CALL XABORT('MCRMAC: MAX2D OVERFLOW(1).')
+        DO 10 IED=1,NED
+        HMAK1(8+IED)=HVECT(IED)
+   10   CONTINUE
+        DO 20 IL=1,NL
+        WRITE(CM,'(I2.2)') IL-1
+        HMAK1(8+NED+IL)='SIGS'//CM
+   20   CONTINUE
+        HMAK2(1)='NUSIGF'
+        HMAK2(2)='CHI'
+        DO 30 IDEL=1,NDEL
+        WRITE(TEXT8,'(6HNUSIGF,I2.2)') IDEL
+        HMAK2(2+2*(IDEL-1)+1)=TEXT8
+        WRITE(TEXT8,'(3HCHI,I2.2)') IDEL
+        HMAK2(2+2*(IDEL-1)+2)=TEXT8
+   30   CONTINUE
+        CALL LCMGET(IPMAC,'STATE-VECTOR',ISTATE)
+        JPMAC=LCMGID(IPMAC,'GROUP')
+        DO 150 IGR=1,NGRP
+        KPMAC=LCMGIL(JPMAC,IGR)
+        DO 60 I1D=1,N1D
+        CALL LCMLEN(KPMAC,HMAK1(I1D),ILONG,ITYLCM)
+        IF(ILONG.NE.0) THEN
+          CALL LCMGET(KPMAC,HMAK1(I1D),GAR1(1,IGR,I1D))
+          DO 50 IBM=1,NMIX
+          DO 40 IBMOLD=1,NMIL
+          IF(MIXC(IBM).EQ.IBMOLD) GAR1(IBM,IGR,I1D)=0.0
+   40     CONTINUE
+   50     CONTINUE
+        ENDIF
+   60   CONTINUE
+        DO 100 I2D=1,N2D
+        CALL LCMLEN(KPMAC,HMAK2(I2D),ILONG,ITYLCM)
+        IF(ILONG.NE.0) THEN
+          CALL LCMGET(KPMAC,HMAK2(I2D),GAR2(1,1,IGR,I2D))
+          DO 90 I=1,NF
+          DO 80 IBM=1,NMIX
+          DO 70 IBMOLD=1,NMIL
+          IF(MIXC(IBM).EQ.IBMOLD) GAR2(IBM,I,IGR,I2D)=0.0
+   70     CONTINUE
+   80     CONTINUE
+   90     CONTINUE
+        ENDIF
+  100   CONTINUE
+        DO 140 IL=1,NL
+        WRITE(CM,'(I2.2)') IL-1
+        ILONG=1
+        IF(IL.GT.1) CALL LCMLEN(KPMAC,'SCAT'//CM,ILONG,ITYLCM)
+        IF(ILONG.NE.0) THEN
+          CALL LCMGET(KPMAC,'SCAT'//CM,GAR4)
+          CALL LCMGET(KPMAC,'NJJS'//CM,NJJ)
+          CALL LCMGET(KPMAC,'IJJS'//CM,IJJ)
+          CALL LCMGET(KPMAC,'IPOS'//CM,IPOS)
+          DO 130 IBM=1,NMIX
+          IPOSDE=IPOS(IBM)
+          DO 120 JGR=IJJ(IBM),IJJ(IBM)-NJJ(IBM)+1,-1
+          GAR3(IBM,JGR,IGR,IL)=GAR4(IPOSDE)
+          DO 110 IBMOLD=1,NMIL
+          IF(MIXC(IBM).EQ.IBMOLD) GAR3(IBM,JGR,IGR,IL)=0.0
+  110     CONTINUE
+          IPOSDE=IPOSDE+1
+  120     CONTINUE
+  130     CONTINUE
+        ENDIF
+  140   CONTINUE
+  150   CONTINUE
+      ENDIF
+*----
+*  SET ENERGY MESH AND ZONE VOLUMES
+*----
+      CALL hdf5_read_data(IPMPO,"/energymesh/NENERGYMESH",NENERG)
+      CALL hdf5_read_data(IPMPO,"/geometry/NGEOMETRY",NGEOME)
+      CALL hdf5_read_data(IPMPO,"/output/OUPUTID",OUPUTID)
+      READ(HEDIT,'(7X,I2)') ID
+      ID_G=0
+      ID_E=0
+      DO I=1,NGEOME
+        DO J=1,NENERG
+          IF(OUPUTID(J,I).EQ.ID) THEN
+            ID_G=I-1
+            ID_E=J-1
+            GO TO 160
+          ENDIF
+        ENDDO
+      ENDDO
+      CALL XABORT('MCRMAC: no ID found in /output/OUPUTID.')
+  160 WRITE(RECNAM,'(23H/energymesh/energymesh_,I0)') ID_E
+      CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"/ENERGY",ENERG)
+      IF(SIZE(ENERG,1)-1.NE.NGRP) CALL XABORT('MCRMAC: INVALID NGRP VA'
+     1 //'LUE.')
+      DO IGR=1,NGRP+1
+        ENERG(IGR)=ENERG(IGR)/1.0E-6
+      ENDDO
+      WRITE(RECNAM,'(19H/geometry/geometry_,I0,1H/)') ID_G
+      CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"ZONEVOLUME",VOSAP)
+*----
+*  OVERALL ELEMENTARY CALCULATION LOOP
+*----
+      DO 300 ICAL=1,NCAL
+      DO 170 IBM=1,NMIX ! mixtures in Macrolib
+      WEIGHT=TERP(ICAL,IBM)
+      IF(WEIGHT.NE.0.0) GO TO 180
+  170 CONTINUE
+      GO TO 300
+*----
+*  PRODUCE AN ELEMENTARY MACROLIB
+*----
+  180 CALL LCMOP(IPTMP,'*ELEMENTARY*',0,1,0)
+      ALLOCATE(SPH(NMIL+NALBP,NGRP))
+      CALL LCMPUT(IPTMP,'ENERGY',NGRP+1,2,ENERG)
+      B2R=B2
+      CALL SPHMPO(IPMPO,IPTMP,ICAL,IMPX,HEQUI,HMASL,NMIL,NALBP,NGRP,
+     1 HEDIT,VOSAP,ILUPS,SPH,B2R)
+*----
+*  RECOVER MACROLIB PARAMETERS
+*----
+      CALL LCMGET(IPTMP,'STATE-VECTOR',ISTATE)
+      NLTMP=ISTATE(3)
+      NFTMP=ISTATE(4)
+      NEDTMP=ISTATE(5)
+      IF(NLTMP.GT.MAXNL) CALL XABORT('MCRMAC: MAXNL OVERFLOW(2).')
+      IF(NFTMP.GT.MAXNFI) CALL XABORT('MCRMAC: MAXNFI OVERFLOW(2).')
+      IF(NEDTMP.GT.MAXED) CALL XABORT('MCRMAC: MAXED OVERFLOW(2).')
+      IF(IACCS.EQ.0) THEN
+        IF(ISTATE(1).NE.NGRP) THEN
+          CALL XABORT('MCRMAC: INVALID NUMBER OF ENERGY GROUPS(3).')
+        ELSE IF(ISTATE(2).NE.NMIL) THEN
+          CALL XABORT('MCRMAC: INVALID NUMBER OF MIXTURES(3).')
+        ENDIF
+        NL=NLTMP
+        NF=NFTMP
+        NED=NEDTMP
+        ITRANC=ISTATE(6)
+        NDEL=ISTATE(7)
+        IDF=ISTATE(12)
+        CALL LCMGTC(IPTMP,'ADDXSNAME-P0',8,NED,HVECT)
+        N1D=8+NED+NL
+        N2D=2*(NDEL+1)
+        IF(N1D.GT.MAX1D) CALL XABORT('MCRMAC: MAX1D OVERFLOW(2).')
+        IF(N2D.GT.MAX2D) CALL XABORT('MCRMAC: MAX2D OVERFLOW(2).')
+        DO 190 IED=1,NED
+        HMAK1(8+IED)=HVECT(IED)
+  190   CONTINUE
+        DO 200 IL=1,NL
+        WRITE(CM,'(I2.2)') IL-1
+        HMAK1(8+NED+IL)='SIGS'//CM
+  200   CONTINUE
+        HMAK2(1)='NUSIGF'
+        HMAK2(2)='CHI'
+        DO 210 IDEL=1,NDEL
+        WRITE(TEXT8,'(6HNUSIGF,I2.2)') IDEL
+        HMAK2(2+2*(IDEL-1)+1)=TEXT8
+        WRITE(TEXT8,'(3HCHI,I2.2)') IDEL
+        HMAK2(2+2*(IDEL-1)+2)=TEXT8
+  210   CONTINUE
+      ELSE
+        IF(NLTMP.GT.NL) CALL XABORT('MCRMAC: NL OVERFLOW.')
+        ITRANC=MAX(ITRANC,ISTATE(6))
+        IF(ISTATE(1).NE.NGRP) THEN
+          CALL XABORT('MCRMAC: INVALID NUMBER OF ENERGY GROUPS(3).')
+        ELSE IF(ISTATE(2).NE.NMIL)THEN
+          CALL XABORT('MCRMAC: INVALID NUMBER OF MIXTURES(3).')
+        ELSE IF((NFTMP.NE.0).AND.(NFTMP.NE.NF)) THEN
+          CALL XABORT('MCRMAC: INVALID NUMBER OF FISSILE ISOTOPES(3).')
+        ELSE IF(ISTATE(7).NE.NDEL) THEN
+          CALL XABORT('MCRMAC: INVALID NUMBER OF PRECURSOR GROUPS(3).')
+        ELSE IF(LADFM.AND.(ISTATE(12).NE.IDF)) THEN
+          CALL XABORT('MCRMAC: INVALID TYPE OF ADF DIRECTORY.')
+        ENDIF
+      ENDIF
+*----
+*  SPH CORRECTION OF MACROLIB INFORMATION
+*----
+      IMC=1 ! SPH correction for SPN macro-calculation
+      CALL SPHCMA(IPTMP,IMPX,IMC,NMIL,NGRP,NFTMP,NEDTMP,NALBP,SPH)
+      DEALLOCATE(SPH)
+*----
+*  RECOVER VOLUMES, ENERGY GROUPS, EDIT NAMES, AND LAMBDA-D.
+*----
+      CALL LCMLEN(IPTMP,'VOLUME',ILONG,ITYLCM)
+      IF(ILONG.EQ.NMIL) THEN
+        DO 220 IBM=1,NMIX ! mixtures in Macrolib
+        IBMOLD=MIXC(IBM) ! mixture in MPO file
+        IF(IBMOLD.NE.0) VOLMI2(IBM)=VOSAP(IBMOLD)
+  220   CONTINUE
+      ENDIF
+      CALL LCMLEN(IPTMP,'ENERGY',ILONG,ITYLCM)
+      IF(ILONG.EQ.NGRP+1) CALL LCMGET(IPTMP,'ENERGY',ENERG)
+      CALL LCMLEN(IPTMP,'LAMBDA-D',LENGTH,ITYLCM)
+      LWD=(LENGTH.EQ.NDEL).AND.(NDEL.GT.0)
+      IF(LWD) THEN
+        ALLOCATE(WDLA(NDEL))
+        CALL LCMGET(IPTMP,'LAMBDA-D',WDLA)
+        CALL LCMPUT(IPMAC,'LAMBDA-D',NDEL,2,WDLA)
+        DEALLOCATE(WDLA)
+      ENDIF
+*----
+*  PERFORM INTERPOLATION
+*----
+      JPTMP=LCMGID(IPTMP,'GROUP')
+      DO 290 IBM=1,NMIX ! mixtures in Macrolib
+      WEIGHT=TERP(ICAL,IBM)
+      IF(WEIGHT.EQ.0.0) GO TO 290
+      IBMOLD=MIXC(IBM) ! mixture in MPO file
+      IF(IBMOLD.EQ.0) GO TO 290
+*
+      DO 280 IGR=1,NGRP
+      KPTMP=LCMGIL(JPTMP,IGR)
+      DO 230 I1D=1,N1D
+      CALL LCMLEN(KPTMP,HMAK1(I1D),ILONG,ITYLCM)
+      IF(ILONG.NE.0) THEN
+        CALL LCMGPD(KPTMP,HMAK1(I1D),FLOT_PTR)
+        CALL C_F_POINTER(FLOT_PTR,FLOT,(/ ILONG /))
+        FLOTVA=FLOT(IBMOLD)
+        IF(FLOTVA.NE.0.0) LMAKE1(I1D)=.TRUE.
+        IF((.NOT.LPURE).AND.(I1D.EQ.4)) FLOTVA=1.0/FLOTVA
+        GAR1(IBM,IGR,I1D)=GAR1(IBM,IGR,I1D)+WEIGHT*FLOTVA
+      ENDIF
+  230 CONTINUE
+      IF(ISTATE(4).GT.0) THEN
+        DO 250 I2D=1,N2D
+        CALL LCMLEN(KPTMP,HMAK2(I2D),ILONG,ITYLCM)
+        IF(ILONG.NE.0) THEN
+          CALL LCMGPD(KPTMP,HMAK2(I2D),FLOT_PTR)
+          CALL C_F_POINTER(FLOT_PTR,FLOT,(/ ILONG /))
+          DO 240 I=1,NF
+          IOF=(IBMOLD-1)*NF+I
+          IF(FLOT(IOF).NE.0.0) LMAKE2(I2D)=.TRUE.
+          GAR2(IBM,I,IGR,I2D)=GAR2(IBM,I,IGR,I2D)+WEIGHT*FLOT(IOF)
+  240     CONTINUE
+        ENDIF
+  250   CONTINUE
+      ENDIF
+      DO 270 IL=1,NLTMP
+      WRITE(CM,'(I2.2)') IL-1
+      CALL LCMLEN(KPTMP,'SCAT'//CM,ILONG,ITYLCM)
+      IF(ILONG.NE.0) THEN
+        CALL LCMGET(KPTMP,'SCAT'//CM,GAR4B)
+        CALL LCMGET(KPTMP,'NJJS'//CM,NJJB)
+        CALL LCMGET(KPTMP,'IJJS'//CM,IJJB)
+        CALL LCMGET(KPTMP,'IPOS'//CM,IPOSB)
+        IPOSDE=IPOSB(IBMOLD)
+        DO 260 JGR=IJJB(IBMOLD),IJJB(IBMOLD)-NJJB(IBMOLD)+1,-1
+        GAR3(IBM,JGR,IGR,IL)=GAR3(IBM,JGR,IGR,IL)+WEIGHT*GAR4B(IPOSDE)
+        IPOSDE=IPOSDE+1
+  260   CONTINUE
+      ENDIF
+  270 CONTINUE
+  280 CONTINUE
+  290 CONTINUE
+      CALL LCMCL(IPTMP,2)
+  300 CONTINUE
+*----
+*  WRITE INTERPOLATED MACROLIB INFORMATION
+*----
+      CALL LCMPUT(IPMAC,'VOLUME',NMIX,2,VOLMI2)
+      CALL LCMPUT(IPMAC,'ENERGY',NGRP+1,2,ENERG)
+      IF(NED.GT.0) CALL LCMPTC(IPMAC,'ADDXSNAME-P0',8,NED,HVECT)
+      JPMAC=LCMLID(IPMAC,'GROUP',NGRP)
+      DO 410 IGR=1,NGRP
+      KPMAC=LCMDIL(JPMAC,IGR)
+      DO 350 I1D=1,N1D
+      IF(LMAKE1(I1D)) THEN
+        IF((.NOT.LPURE).AND.(I1D.EQ.4)) THEN
+          DO 320 IBM=1,NMIX
+          DO 310 IBMOLD=1,NMIL
+          IF(MIXC(IBM).EQ.IBMOLD) GAR1(IBM,IGR,I1D)=1./GAR1(IBM,IGR,I1D)
+  310     CONTINUE
+  320     CONTINUE
+        ELSE IF(I1D.EQ.7) THEN
+          DO 340 IBM=1,NMIX
+          DO 330 IBMOLD=1,NMIL
+          IF(MIXC(IBM).EQ.IBMOLD) GAR1(IBM,IGR,I1D)=GAR1(IBM,IGR,I1D)*
+     1    1.0E6 ! convert MeV to eV
+  330     CONTINUE
+  340     CONTINUE
+        ENDIF
+        CALL LCMPUT(KPMAC,HMAK1(I1D),NMIX,2,GAR1(1,IGR,I1D))
+      ENDIF
+  350 CONTINUE
+      DO 360 I2D=1,N2D
+      IF(LMAKE2(I2D).AND.(NF.GT.0)) THEN
+        CALL LCMPUT(KPMAC,HMAK2(I2D),NMIX*NF,2,GAR2(1,1,IGR,I2D))
+      ENDIF
+  360 CONTINUE
+      DO 400 IL=1,NL
+      WRITE(CM,'(I2.2)') IL-1
+      IPOSDE=0
+      DO 390 IBM=1,NMIX
+      IPOS(IBM)=IPOSDE+1
+      IGMIN=IGR
+      IGMAX=IGR
+      DO 370 JGR=1,NGRP
+      IF(GAR3(IBM,JGR,IGR,IL).NE.0.0) THEN
+        IGMIN=MIN(IGMIN,JGR)
+        IGMAX=MAX(IGMAX,JGR)
+      ENDIF
+  370 CONTINUE
+      IJJ(IBM)=IGMAX
+      NJJ(IBM)=IGMAX-IGMIN+1
+      DO 380 JGR=IGMAX,IGMIN,-1
+      IPOSDE=IPOSDE+1
+      GAR4(IPOSDE)=GAR3(IBM,JGR,IGR,IL)
+  380 CONTINUE
+  390 CONTINUE
+      IF(IPOSDE.GT.0) THEN
+        CALL LCMPUT(KPMAC,'SCAT'//CM,IPOSDE,2,GAR4)
+        CALL LCMPUT(KPMAC,'NJJS'//CM,NMIX,1,NJJ)
+        CALL LCMPUT(KPMAC,'IJJS'//CM,NMIX,1,IJJ)
+        CALL LCMPUT(KPMAC,'IPOS'//CM,NMIX,1,IPOS)
+        CALL LCMPUT(KPMAC,'SIGW'//CM,NMIX,2,GAR3(1,IGR,IGR,IL))
+      ENDIF
+  400 CONTINUE
+  410 CONTINUE
+      IACCS=1
+*----
+*  UPDATE STATE-VECTOR
+*----
+      ISTATE(2)=NMIX
+      ISTATE(3)=NL
+      ISTATE(4)=NF
+      ISTATE(5)=NED
+      ISTATE(6)=ITRANC
+      CALL LCMPUT(IPMAC,'STATE-VECTOR',NSTATE,1,ISTATE)
+*----
+*  INCLUDE LEAKAGE IN THE MACROLIB (USED ONLY FOR NON-REGRESSION TESTS)
+*----
+      IF(B2.NE.0.0) THEN
+        IF(IMPX.GT.0) WRITE(IOUT,'(/31H MCRMAC: INCLUDE LEAKAGE IN THE,
+     1  14H MACROLIB (B2=,1P,E12.5,2H).)') B2
+        JPMAC=LCMGID(IPMAC,'GROUP')
+        ALLOCATE(WORK1(NMIX),WORK2(NMIX))
+        DO 430 IGR=1,NGRP
+          KPMAC=LCMGIL(JPMAC,IGR)
+          CALL LCMGET(KPMAC,'NTOT0',WORK1)
+          CALL LCMGET(KPMAC,'DIFF',WORK2)
+          DO 420 IBM=1,NMIX
+            IF(MIXC(IBM).NE.0) WORK1(IBM)=WORK1(IBM)+B2*WORK2(IBM)
+  420     CONTINUE
+          CALL LCMPUT(KPMAC,'NTOT0',NMIX,2,WORK1)
+  430   CONTINUE
+        DEALLOCATE(WORK2,WORK1)
+      ENDIF
+*----
+*  PROCESS ADF and physical albedos (if required)
+*----
+      LALBG=.TRUE.
+      IF(NALBP.GT.0) THEN
+        WRITE(RECNAM,'(8H/output/,A,16H/statept_0/flux/)') TRIM(HEDIT)
+        CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"NALBP",NALBP2)
+        IF(NALBP2.NE.NALBP) CALL XABORT('MCRMAC: INVALID NALBP.')
+        CALL hdf5_info(IPMPO,TRIM(RECNAM)//"ALBEDOGxG",RANK,TYPE,NBYTE,
+     &  DIMSR)
+        IF(TYPE.NE.99) LALBG=.FALSE.
+      ENDIF
+      CALL MCRAGF(IPMAC,IPMPO,IACCOLD,NMIL,NMIX,NGRP,NALBP,LALBG,LADFM,
+     1 IMPX,NCAL,TERP,MIXC,NSURFD,HEDIT,VOSAP,VOLMI2,IDF)
+      IF(NSURFD.GT.0) THEN
+        CALL LCMGET(IPMAC,'STATE-VECTOR',ISTATE)
+        ISTATE(12)=IDF ! ADF information
+        CALL LCMPUT(IPMAC,'STATE-VECTOR',NSTATE,1,ISTATE)
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(VOSAP,ENERG)
+      DEALLOCATE(VOLMI2,GAR4B,GAR4,GAR3,GAR2,GAR1)
+      DEALLOCATE(IPOSB,NJJB,IJJB,IPOS,NJJ,IJJ)
+      RETURN
+      END
diff --git a/Donjon/src/MCRNDF.f b/Donjon/src/MCRNDF.f
new file mode 100644
index 0000000..9676347
--- /dev/null
+++ b/Donjon/src/MCRNDF.f
@@ -0,0 +1,97 @@
+*DECK MCRNDF
+      SUBROUTINE MCRNDF(IMPX,NBISO,ISO,IBM,HNOMIS,IPLIB,MY1,MY2,YLDS,
+     1 IADRY,ISTYP)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Store records PYNAM, PYMIX and PYIELD into a Microlib.
+*
+*Copyright:
+* Copyright (C) 2022 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IMPX    print parameter (equal to zero for no print).
+* NBISO  number of particularized isotopes.
+* ISO     particularized isotope index.
+* IBM     material mixture.
+* HNOMIS  array containing the names of the particularized isotopes.
+* IPLIB   address of the output microlib LCM object.
+* MY1     number of fissile isotopes including macroscopic sets.
+* MY2     number of fission fragment.
+* YLDS    fission yields.
+* IADRY   index in YLDS (<0: fission product; >0: fissile isotope).
+*
+*Parameters: output
+* ISTYP   type of isotope ISO (=1: stable;=2: fissile; =3: fission
+*         product).
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPLIB
+      INTEGER IMPX,NBISO,ISO,IBM,MY1,MY2,ISTYP,IADRY(NBISO)
+      DOUBLE PRECISION YLDS(MY1,MY2)
+      CHARACTER(LEN=24) HNOMIS(NBISO)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER I,IY1,IY2,JSO
+*----
+*  ALLOCATABLE AYYAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IPYMIX
+      REAL, ALLOCATABLE, DIMENSION(:) :: PYIELD
+      CHARACTER(LEN=24), ALLOCATABLE, DIMENSION(:) :: HPYNAM
+*
+      IF(IADRY(ISO).GT.0) THEN
+*       ISO is a fissile isotope
+        ISTYP=2
+      ELSE IF(IADRY(ISO).LT.0) THEN
+*       ISO is a fission product
+        ISTYP=3
+        IY2=-IADRY(ISO)
+        IF(IY2.GT.MY2) CALL XABORT('MCRNDF: MY2 OVERFLOW.')
+        ALLOCATE(HPYNAM(MY1),IPYMIX(MY1),PYIELD(MY1))
+        HPYNAM(:MY1)=' '
+        IPYMIX(:MY1)=0
+        PYIELD(:MY1)=0.0
+        IF(IMPX.GT.2) THEN
+          WRITE(6,'(25H MCRNDF: fission product=,A24,9H mixture=,I8)')
+     1    HNOMIS(ISO),IBM
+        ENDIF
+        DO JSO=1,NBISO
+          IF(IADRY(JSO).GT.0) THEN
+            IY1=IADRY(JSO)
+            IF(IY1.GT.MY1) CALL XABORT('MCRNDF: MY1 OVERFLOW.')
+            HPYNAM(IY1)=HNOMIS(JSO)
+            IPYMIX(IY1)=IBM
+            PYIELD(IY1)=REAL(YLDS(IY1,IY2))
+            IF(IMPX.GT.2) THEN
+              WRITE(6,'(9X,16Hfissile isotope(,I4,2H)=,A24,9H mixture=,
+     1        I8)') IY1,HPYNAM(IY1),IPYMIX(IY1)
+            ENDIF
+          ENDIF
+        ENDDO
+        CALL LCMPTC(IPLIB,'PYNAM',8,MY1,HPYNAM(:8))
+        CALL LCMPUT(IPLIB,'PYMIX',MY1,1,IPYMIX)
+        CALL LCMPUT(IPLIB,'PYIELD',MY1,2,PYIELD)
+        IF(IMPX.GT.2) THEN
+          WRITE(6,'(3X,7HPYIELD=,1P,8E12.4/(8X,10E12.4))') (PYIELD(I),
+     1    I=1,MY1)
+        ENDIF
+        DEALLOCATE(PYIELD,IPYMIX,HPYNAM)
+      ENDIF
+      RETURN
+      END
diff --git a/Donjon/src/MCRRGR.f b/Donjon/src/MCRRGR.f
new file mode 100644
index 0000000..c9c8af8
--- /dev/null
+++ b/Donjon/src/MCRRGR.f
@@ -0,0 +1,923 @@
+*DECK MCRRGR
+      SUBROUTINE MCRRGR(IPMPO,IPMAP,LCUBIC,NMIX,IMPX,NMIL,NCAL,NBISO,
+     1 NCH,NB,NFUEL,NPARM,NPAR,HEDIT,ITER,MAXNIS,MIXC,TERP,NISO,LISO,
+     2 HISO,CONC,ITODO)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute TERP factors for MPO file interpolation. Use global
+* parameters from a fuel-map object and optional user-defined values.
+*
+*Copyright:
+* Copyright (C) 2022 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPMPO   address of the MPO file.
+* IPMAP   address of the fuel-map object.
+* LCUBIC  =.TRUE.: cubic Ceschino interpolation; =.FALSE: linear
+*         Lagrange interpolation.
+* NMIX    number of material mixtures in the fuel-map macrolib.
+* IMPX    print parameter (equal to zero for no print).
+* NMIL    number of material mixtures in the MPO file.
+* NCAL    number of elementary calculations in the MPO file.
+* NBISO     number of particularized and macro isotopes in the MPO file.
+* NCH     number of reactor channels.
+* NB      number of fuel bundles per channel.
+* NFUEL   number of fuel types.
+* NPARM   number of additional parameters (other than burnup) defined
+*         in FMAP object
+* NPAR    number of parameters
+* HEDIT   name of output group for a (multigroup mesh, output geometry)
+*         couple (generally equal to 'output_0').
+*
+*Parameters: output
+* ITER    completion flag (=0: all over; =1: use another MPO file;
+*         =2 use another L_MAP + MPO file).
+* MAXNIS  maximum value of NISO(I) in user data.
+* MIXC    mixture index in the MPO file corresponding to each microlib
+*         mixture.
+* TERP    interpolation factors.
+* NISO    number of user-selected isotopes.
+* LISO    type of treatment (=.true.: ALL; =.false.: ONLY).
+* HISO    name of the user-selected isotopes.
+* CONC    user-defined number density of the user-selected isotopes. A
+*         value of -99.99 is set to indicate that the compo value is
+*         used.
+* ITODO   non-depletion mask (=1 to force a user-selected isotope to be
+*         non-depleting)
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      USE hdf5_wrap
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMPO,IPMAP
+      INTEGER NMIX,IMPX,NMIL,NCAL,NBISO,NFUEL,NCH,NB,ITER,MAXNIS,
+     1        MIXC(NMIX),NPARM,NPAR,NISO(NMIX),ITODO(NMIX,NBISO)
+      REAL TERP(NCAL,NMIX),CONC(NMIX,NBISO)
+      LOGICAL LCUBIC,LISO(NMIX)
+      CHARACTER(LEN=8) HISO(NMIX,NBISO)
+      CHARACTER(LEN=12) HEDIT
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXADD=10
+      INTEGER, PARAMETER::MAXPAR=50
+      INTEGER, PARAMETER::MAXLIN=50
+      REAL, PARAMETER::REPS=1.0E-4
+      INTEGER IBMOLD, IBM, IBTYP, IB, ICAL, ICH, IFUEL, ILONG, IMIX,
+     & IMPY, INDIC, IPAR, ISO, ITYPE, ITYP, IVARTY, I, JBM, JB, JCAL,
+     & JPARM, JPAR, J, NISOMI, NITMA, NPARMP, NTOT, N, RANK, TYPE,
+     & NBYTE, DIMSR(5)
+      REAL BURN0, BURN1, FLOTT, SUM, VALR1, VALR2, VARVAL
+      CHARACTER TEXT12*12,HSMG*131,TEXT132*132, VALH(MAXPAR)*12,
+     1 RECNAM*12,HPARNA*12,HCUBIC*12,HNAVAL*12
+      INTEGER VALI(MAXPAR),MAPLET(2*MAXPAR,MAXADD),
+     1 MATYPE(2*MAXPAR,MAXADD),IDLTA(2*MAXPAR,MAXADD),NDLTA(2*MAXPAR),
+     2 IDLTA1,MUPLT2(2*MAXPAR),MUTYP2(2*MAXPAR)
+      DOUBLE PRECISION DFLOTT
+      REAL VALR(2*MAXPAR,2),VALRA(2*MAXPAR,2,MAXADD),CONCMI(NBISO)
+      LOGICAL LDELT(2*MAXPAR),LDELT1,LSET(2*MAXPAR),LADD(2*MAXPAR),
+     1 LSET1,LADD1,LDMAP(2*MAXPAR,2),LAMAP(2*MAXPAR,2,MAXADD),
+     2 LCUB2(MAXPAR),LTST,LISOMI
+      TYPE(C_PTR) JPMAP,KPMAP
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: MUPLET,MUTYPE,NVALUE,FMIX,
+     1 ZONEC,VINTE
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ZONEDP,MUBASE
+      REAL, ALLOCATABLE, DIMENSION(:) :: BRN0,BRN1,VARC,TERPA,VREAL
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: WPAR
+      LOGICAL, ALLOCATABLE, DIMENSION(:) :: LPARM,LDELTA
+      CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: HISOMI, PARFMT
+      CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: HPAR, VCHAR
+      CHARACTER(LEN=24), ALLOCATABLE, DIMENSION(:) :: PARTYP,PARKEY
+      CHARACTER(LEN=132), ALLOCATABLE, DIMENSION(:) :: TEXT132V1
+*----
+*  SCRATCH STORAGE ALLOCATION
+*   FMIX    fuel mixture indices per fuel bundle.
+*   BRN0    contains either low burnup integration limits or
+*           instantaneous burnups per fuel bundle.
+*   BRN1    upper burnup integration limits per fuel bundle.
+*   WPAR    other parameter distributions.
+*   HPAR    'PARKEY' name of the other parameters.
+*----
+      ALLOCATE(MUPLET(NPAR),MUTYPE(NPAR))
+      ALLOCATE(LPARM(NPARM+1),FMIX(NCH*NB),ZONEDP(NCH,NB),ZONEC(NCH),
+     1 BRN0(NCH*NB),BRN1(NCH*NB),WPAR(NCH*NB,NPARM),LDELTA(NMIX),
+     2 HPAR(NPARM+1),HISOMI(NBISO))
+*----
+*  RECOVER INFORMATION FOR THE MPO FILE.
+*----
+      CALL hdf5_info(IPMPO,"/info/MPO_CREATION_INFO",RANK,TYPE,NBYTE,
+     1 DIMSR)
+      IF(RANK.GT.MAXLIN) CALL XABORT('MCRRGR: MAXLIN OVERFLOW.')
+      IF(NPAR.GT.MAXPAR) CALL XABORT('MCRRGR: MAXPAR OVERFLOW.')
+      CALL hdf5_read_data(IPMPO,"/info/MPO_CREATION_INFO",TEXT132)
+      IF((RANK.EQ.1).AND.(DIMSR(1).EQ.1)) THEN
+        CALL hdf5_read_data(IPMPO,"/info/MPO_CREATION_INFO",TEXT132)
+        IF(IMPX.GT.0) WRITE(IOUT,'(1X,A)') TEXT132
+      ELSE IF(RANK.EQ.1) THEN
+        CALL hdf5_read_data(IPMPO,"/info/MPO_CREATION_INFO",TEXT132V1)
+        IF(IMPX.GT.0) THEN
+          DO I=1,DIMSR(1)
+            WRITE(IOUT,'(1X,A)') TEXT132V1(I)
+          ENDDO
+        ENDIF
+        DEALLOCATE(TEXT132V1)
+      ENDIF
+      IF(NPAR.GT.0) THEN
+        CALL hdf5_read_data(IPMPO,"/parameters/info/PARAMTYPE",PARTYP)
+        CALL hdf5_read_data(IPMPO,"/parameters/info/PARAMNAME",PARKEY)
+        CALL hdf5_read_data(IPMPO,"/parameters/info/PARAMFORM",PARFMT)
+        IF(IMPX.GT.1) THEN
+          WRITE(IOUT,*) 'NPAR=',NPAR,SIZE(PARKEY,1)
+          DO I=1,NPAR
+            WRITE(IOUT,*)'PARKEY(',I,')=',PARKEY(I),' PARFMT=',PARFMT(I)
+          ENDDO
+        ENDIF
+      ENDIF
+      TERP(:NCAL,:NMIX)=0.0
+      MIXC(:NMIX)=0
+*----
+*  SCAN THE MPO FILE INFORMATION TO RECOVER THE MUPLET DATABASE
+*----
+      IF(IMPX.GT.5) THEN
+        WRITE(IOUT,'(24H MCRRGR: MUPLET DATABASE/12H CALCULATION,5X,
+     1  10HMUPLET....)')
+      ENDIF
+      ALLOCATE(MUBASE(NPAR,NCAL))
+      DO ICAL=1,NCAL
+        WRITE(RECNAM,'(8H/output/,A,9H/statept_,I0)') TRIM(HEDIT),ICAL-1
+        CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"/PARAMVALUEORD",VINTE)
+        IF(SIZE(VINTE).NE.NPAR) THEN
+          WRITE(HSMG,'(43HMCRRGR: INCONSISTENT PARAMVALUEORD LENGTH (,
+     1    I5,3H VS,I5,2H).)') SIZE(VINTE),NPAR
+          CALL XABORT(HSMG)
+        ENDIF
+        DO IPAR=1,NPAR
+          MUBASE(IPAR,ICAL)=VINTE(IPAR)+1
+        ENDDO
+        IF(IMPX.GT.5) THEN
+          WRITE(IOUT,'(I8,6X,20I4/(14X,20I4))') ICAL,
+     1    MUBASE(:,ICAL)
+        ENDIF
+        DEALLOCATE(VINTE)
+      ENDDO
+*----
+*  READ (INTERP_DATA) AND SET VALI, VALR AND VALH PARAMETERS
+*  CORRESPONDING TO THE INTERPOLATION POINT. FILL MUPLET FOR
+*  PARAMETERS SET WITHOUT INTERPOLATION.
+*----
+      IBM=0
+      MAXNIS=0
+      NISOMI=0
+      LISOMI=.TRUE.
+      LDELT1=.FALSE.
+      LADD1=.FALSE.
+      NISO(:NMIX)=0
+      LISO(:NMIX)=.TRUE.
+      LDELTA(:NMIX)=.FALSE.
+      ITODO(:NMIX,:NBISO)=0
+      IDLTA1=0
+      DO I=1,2*MAXPAR
+         LSET(I)=.FALSE.
+         LDELT(I)=.FALSE.
+         LADD(I)=.FALSE.
+         LDMAP(I,:2)=.FALSE.
+         LAMAP(I,:2,:MAXADD)=.FALSE.
+         NDLTA(I)=0
+      ENDDO
+*----
+*  READ THE PARKEY NAME OF THE BURNUP FOR THIS MPO FILE.
+*----
+      CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+      IF(INDIC.NE.3)CALL XABORT('MCRRGR: CHARACTER DATA EXPECTED(1).')
+      IF((TEXT12.EQ.'MIX').OR.(TEXT12.EQ.';')) THEN
+        NPARMP=NPARM
+        GO TO 30
+      ELSE
+*       add burnup to parameters
+        NPARMP=NPARM+1
+        HPAR(NPARMP)=TEXT12
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3)CALL XABORT('MCRRGR: CHARACTER DATA EXPECTED(2).')
+        IF((TEXT12.EQ.'MIX').OR.(TEXT12.EQ.';')) GO TO 30
+        HNAVAL=TEXT12
+      ENDIF
+*----
+*  MAIN LOOP OF THE SUBROUTINE (UNTIL THE END)
+*----
+   20 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+      IF(INDIC.NE.3)CALL XABORT('MCRRGR: CHARACTER DATA EXPECTED(3).')
+   30 IF(TEXT12.EQ.'MIX')THEN
+        NISOMI=0
+        LISOMI=.TRUE.
+        IVARTY=0
+        IBTYP=0
+        HNAVAL=' '
+        MUPLET(:NPAR)=0
+        MUTYPE(:NPAR)=0
+        VALI(:NPAR)=0
+        VALR(:NPAR,1)=0.0
+        VALR(:NPAR,2)=0.0
+        DO 35 I=1,MAXADD
+          MAPLET(:NPAR,I)=0
+          MATYPE(:NPAR,I)=0
+          VALRA(:NPAR,1,I)=0.0
+          VALRA(:NPAR,2,I)=0.0
+   35   CONTINUE
+        DO I=1,2*MAXPAR
+          LSET(I)=.FALSE.
+          LDELT(I)=.FALSE.
+          LADD(I)=.FALSE.
+          LDMAP(I,:2)=.FALSE.
+          LAMAP(I,:2,:MAXADD)=.FALSE.
+        ENDDO
+        DO 40 I=1,NPAR
+        VALH(I)=' '
+   40   CONTINUE
+        LCUB2(:NPAR)=LCUBIC
+        CALL REDGET(INDIC,IBM,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1)CALL XABORT('MCRRGR: INTEGER DATA EXPECTED.')
+*       CHECK FUEL MIXTURE
+        JPMAP=LCMGID(IPMAP,'FUEL')
+        DO IFUEL=1,NFUEL
+          KPMAP=LCMGIL(JPMAP,IFUEL)
+          CALL LCMGET(KPMAP,'MIX',IMIX)
+          IF(IMIX.EQ.IBM)GOTO 50
+        ENDDO
+        WRITE(IOUT,*)'MCRRGR: UNABLE TO FIND FUEL MIXTURE ',IBM
+        CALL XABORT('MCRRGR: WRONG MIXTURE NUMBER.')
+   50   IBMOLD=1
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3)CALL XABORT('MCRRGR: CHARACTER DATA EXPECTED(4).')
+        IF(TEXT12.EQ.'FROM')THEN
+          CALL REDGET(INDIC,IBMOLD,FLOTT,TEXT12,DFLOTT)
+          IF(INDIC.NE.1)CALL XABORT('MCRRGR: INTEGER DATA EXPECTED.')
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          IF(INDIC.NE.3)CALL XABORT('MCRRGR: CHARACTER DATA EXPECTE'
+     1     //'D(5).')
+        ELSE IF(TEXT12.EQ.'USE') THEN
+          IBMOLD=IBM
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          IF(INDIC.NE.3)CALL XABORT('MCRRGR: CHARACTER DATA EXPECTE'
+     1     //'D(6).')
+        ENDIF
+        GOTO 30
+      ELSEIF(TEXT12.EQ.'MICRO')THEN
+        IF(IBM.EQ.0) CALL XABORT('MCRRGR: MIX NOT SET (1).')
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3)CALL XABORT('MCRRGR: CHARACTER DATA EXPECTED(7).')
+        IF(TEXT12.EQ.'ALL')THEN
+          LISOMI=.TRUE.
+        ELSEIF(TEXT12.EQ.'ONLY')THEN
+          LISOMI=.FALSE.
+        ENDIF
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3)CALL XABORT('MCRRGR: CHARACTER DATA EXPECTED(8).')
+   60   IF(TEXT12.EQ.'ENDMIX')THEN
+          GOTO 30
+        ELSE IF(TEXT12.EQ.'NOEV') THEN
+          IF(NISOMI.EQ.0) CALL XABORT('MCRRGR: MISPLACED NOEV.')
+          ITODO(IBM,NISOMI)=1
+        ELSE
+          NISOMI=NISOMI+1
+          IF(NISOMI.GT.NBISO) CALL XABORT('MCRRGR: NBISO OVERFLOW.')
+          MAXNIS=MAX(MAXNIS,NISOMI)
+          HISOMI(NISOMI)=TEXT12(:8)
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          IF(INDIC.EQ.2)THEN
+            CONCMI(NISOMI)=FLOTT
+          ELSEIF((INDIC.EQ.3).AND.(TEXT12.EQ.'*'))THEN
+            CONCMI(NISOMI)=-99.99
+          ELSE
+            CALL XABORT('MCRRGR: INVALID HISO DATA.')
+          ENDIF
+        ENDIF
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3)CALL XABORT('MCRRGR: CHARACTER DATA EXPECTED(9).')
+        GOTO 60
+      ELSEIF((TEXT12.EQ.'SET').OR.(TEXT12.EQ.'DELTA').OR.
+     1       (TEXT12.EQ.'ADD'))THEN
+        IF(IBM.EQ.0) CALL XABORT('MCRRGR: MIX NOT SET (2).')
+        LSET1=.FALSE.
+        LDELT1=.FALSE.
+        LADD1=.FALSE.
+        ITYPE=0
+        IF(TEXT12.EQ.'SET')THEN
+          ITYPE=1
+          LSET1=.TRUE.
+        ELSEIF(TEXT12.EQ.'DELTA')THEN
+          ITYPE=2
+          LDELT1=.TRUE.
+        ELSEIF(TEXT12.EQ.'ADD')THEN
+          ITYPE=2
+          LADD1=.TRUE.
+          IDLTA1=IDLTA1+1
+          DO 65 JPAR=1,NPAR
+            MAPLET(JPAR,IDLTA1)=MUPLET(JPAR)
+            MATYPE(JPAR,IDLTA1)=MUTYPE(JPAR)
+   65     CONTINUE
+        ENDIF
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3)CALL XABORT('MCRRGR: CHARACTER DATA EXPECTED(10)'
+     1  //'.')
+        IF((TEXT12.EQ.'LINEAR').OR.(TEXT12.EQ.'CUBIC')) THEN
+          HCUBIC=TEXT12
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        ELSE
+          HCUBIC=' '
+        ENDIF
+        IF(INDIC.NE.3)CALL XABORT('MCRRGR: CHARACTER DATA EXPECTED(11)'
+     1  //'.')
+        IPAR=0
+        DO I=1,NPAR
+          IF(TEXT12.EQ.PARKEY(I))THEN
+            IPAR=I
+            HPARNA=TEXT12
+            GOTO 70
+          ENDIF
+        ENDDO
+        WRITE(HSMG,'(18HMCRRGR: PARAMETER ,A,14H NOT FOUND(1).)') TEXT12
+        CALL XABORT(HSMG)
+*
+   70   IF(HCUBIC.EQ.'LINEAR') THEN
+          LCUB2(IPAR)=.FALSE.
+        ELSE IF(HCUBIC.EQ.'CUBIC') THEN
+          LCUB2(IPAR)=.TRUE.
+        ENDIF
+        CALL hdf5_read_data(IPMPO,"/parameters/info/NVALUE",NVALUE)
+        WRITE(RECNAM,'(25H/parameters/values/PARAM_,I0)') IPAR-1
+        CALL hdf5_info(IPMPO,RECNAM,RANK,TYPE,NBYTE,DIMSR)
+        IF(TYPE.EQ.99) THEN
+          WRITE(HSMG,'(25HMCRRGR: GLOBAL PARAMETER ,A,12H NOT SET(1).)')
+     1    TRIM(PARKEY(IPAR))
+          CALL XABORT(HSMG)
+        ENDIF
+        IF((IPAR.GT.NPAR).OR.
+     1   ((IPAR.LE.NPAR).AND.(PARFMT(IPAR).EQ.'FLOAT')))THEN
+          CALL hdf5_read_data(IPMPO,RECNAM,VREAL)
+          CALL REDGET(INDIC,NITMA,VALR1,TEXT12,DFLOTT)
+          IF(INDIC.EQ.2)THEN
+            VALR2=VALR1
+            IF(LSET1) THEN
+              LSET(IPAR)=.TRUE.
+              VALR(IPAR,1)=VALR1
+              VALR(IPAR,2)=VALR1
+            ENDIF
+            IF(LDELT1) THEN
+              LDELT(IPAR)=.TRUE.
+              VALR(IPAR,1)=VALR1
+              VALR(IPAR,2)=VALR1
+            ELSEIF(LADD1) THEN
+              LADD(IPAR)=.TRUE.
+              VALRA(IPAR,1,IDLTA1)=VALR1
+              VALRA(IPAR,2,IDLTA1)=VALR1
+              NDLTA(IPAR)=NDLTA(IPAR)+1
+              IF(NDLTA(IPAR).GT.MAXADD) CALL XABORT('MCRRGR: MAXADD OV'
+     1        //'ERFLOW.')
+              IDLTA(IPAR,NDLTA(IPAR))=IDLTA1
+            ENDIF
+          ELSEIF(TEXT12.EQ.'MAP')THEN
+            IF(LDELT1)THEN
+              LDELT(IPAR)=.TRUE.
+              LDMAP(IPAR,1)=.TRUE.
+            ELSEIF(LADD1)THEN
+              LADD(IPAR)=.TRUE.
+              NDLTA(IPAR)=NDLTA(IPAR)+1
+              IF(NDLTA(IPAR).GT.MAXADD) CALL XABORT('MCRRGR: MAXADD OV'
+     1        //'ERFLOW.')
+              LAMAP(IPAR,1,NDLTA(IPAR))=.TRUE.
+              IDLTA(IPAR,NDLTA(IPAR))=IDLTA1
+            ENDIF
+            IF(LSET1.AND.(.NOT.LSET(IPAR))) GO TO 20
+          ELSE
+            CALL XABORT('MCRRGR: real value or "MAP" expected(1).')
+          ENDIF
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          IF(ITYPE.GE.2)THEN
+            IF(INDIC.EQ.2)THEN
+              VALR2=FLOTT
+              IF(LDELT1)THEN
+                VALR(IPAR,2)=VALR2
+              ELSEIF(LADD1)THEN
+                VALRA(IPAR,2,IDLTA1)=VALR2
+              ENDIF
+            ELSEIF(TEXT12.EQ.'MAP')THEN
+              IF(LDELT1)THEN
+                LDMAP(IPAR,2)=.TRUE.
+              ELSEIF(LADD1)THEN
+                LAMAP(IPAR,2,IDLTA1)=.TRUE.
+              ENDIF
+            ELSE
+              CALL XABORT('MCRRGR: real value or "MAP" expected(2).')
+            ENDIF
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          ENDIF
+          LTST=.FALSE.
+          IF(.NOT.LADD1)THEN
+            IF(VALR(IPAR,1).EQ.VALR(IPAR,2)) LTST=.TRUE.
+            MUPLET(IPAR)=-1
+            MUTYPE(IPAR)=ITYPE
+          ELSE
+            MAPLET(IPAR,IDLTA1)=-1
+            MATYPE(IPAR,IDLTA1)=2
+          ENDIF
+          IF((LTST).AND.(ITYPE.EQ.1))THEN
+            DO J=1,NVALUE(IPAR)
+              IF(ABS(VALR(IPAR,1)-VREAL(J)).LE.REPS*ABS(VREAL(J)))THEN
+                MUPLET(IPAR)=J
+                GOTO 30
+              ENDIF
+            ENDDO
+          ENDIF
+*----
+*  ERRORS HANDLING
+*----
+          IF(VALR1.LT.VREAL(1))THEN
+*           OUTSIDE OF THE DOMAIN (1)
+            WRITE(HSMG,'(23HMCRRGR: REAL PARAMETER ,A,10H WITH VALU,
+     1       1HE,1P,E12.4,26H IS OUTSIDE THE DOMAIN.(1))') HPARNA,VALR1
+             WRITE(6,*)'Domain:',VREAL(1),' <-> ',VREAL(NVALUE(IPAR))
+            CALL XABORT(HSMG)
+          ELSEIF(VALR2.GT.VREAL(NVALUE(IPAR)))THEN
+*           OUTSIDE OF THE DOMAIN (2)
+            WRITE(HSMG,'(23HMCRRGR: REAL PARAMETER ,A,10H WITH VALU,
+     1       1HE,1P,E12.4,26H IS OUTSIDE THE DOMAIN.(2))') HPARNA,VALR2
+             WRITE(6,*)'Domain:',VREAL(1),' <-> ',VREAL(NVALUE(IPAR))
+            CALL XABORT(HSMG)
+          ELSEIF((VALR1.GT.VALR2).AND.(ITYPE.EQ.1))THEN
+*           ITYPE=1 correspond to an integral between VALR1 and VALR2
+*           otherwise it is a simple difference
+            WRITE(HSMG,'(23HMCRRGR: REAL PARAMETER ,A,9H IS DEFIN,
+     1       7HED WITH,1P,E12.4,2H >,E12.4,4H.(1))') HPARNA,
+     2       VALR1,VALR2
+            CALL XABORT(HSMG)
+          ENDIF
+          IF((LADD1).AND.(TEXT12.EQ.'REF'))THEN
+  120       DEALLOCATE(VREAL)
+            IPAR=-99
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+            IF(TEXT12.EQ.'ENDREF') GOTO 140
+            DO I=1,NPAR
+              IF(TEXT12.EQ.PARKEY(I))THEN
+                IPAR=I
+                GOTO 130
+              ENDIF
+            ENDDO
+            CALL XABORT('MCRRGR: PARAMETER '//TEXT12//' NOT FOUND(2).')
+  130       CONTINUE
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+            IF(INDIC.EQ.2)THEN
+              VALRA(IPAR,1,IDLTA1)=FLOTT
+              VALRA(IPAR,2,IDLTA1)=FLOTT
+              WRITE(RECNAM,'(25H/parameters/values/PARAM_,I0)') IPAR-1
+              CALL hdf5_info(IPMPO,RECNAM,RANK,TYPE,NBYTE,DIMSR)
+              IF(TYPE.EQ.99) THEN
+                 WRITE(HSMG,'(25HMCRRGR: GLOBAL PARAMETER ,A,
+     1           12H NOT SET(2).)') TRIM(PARKEY(IPAR))
+                 CALL XABORT(HSMG)
+              ENDIF
+              CALL hdf5_read_data(IPMPO,RECNAM,VREAL)
+              MAPLET(IPAR,IDLTA1)=-1
+              MATYPE(IPAR,IDLTA1)=1
+              DO J=1,NVALUE(IPAR)
+                IF(ABS(VALRA(IPAR,1,IDLTA1)-VREAL(J)).LE.
+     1             REPS*ABS(VREAL(J)))THEN
+                  MAPLET(IPAR,IDLTA1)=J
+                  GOTO 120
+                ENDIF
+              ENDDO
+            ELSEIF(TEXT12.EQ.'SAMEASREF')THEN
+              MAPLET(IPAR,IDLTA1)=-1
+              MATYPE(IPAR,IDLTA1)=-1
+            ELSE
+              CALL XABORT('MCRRGR: REAL or "SAMEASREF" expected')
+            ENDIF
+            GOTO 120
+  140       CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          ELSE IF((LDELT1).AND.(TEXT12.EQ.'REF'))THEN
+  150       DEALLOCATE(VREAL)
+            IPAR=-99
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+            IF(TEXT12.EQ.'ENDREF') GOTO 170
+            DO I=1,NPAR
+              IF(TEXT12.EQ.PARKEY(I))THEN
+                IPAR=I
+                GOTO 160
+              ENDIF
+            ENDDO
+            CALL XABORT('MCRRGR: PARAMETER '//TEXT12//' NOT FOUND(3).')
+  160       CONTINUE
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+            IF(INDIC.EQ.2)THEN
+              VALR(IPAR,1)=FLOTT
+              VALR(IPAR,2)=FLOTT
+              WRITE(RECNAM,'(25H/parameters/values/PARAM_,I0)') IPAR-1
+              CALL hdf5_info(IPMPO,RECNAM,RANK,TYPE,NBYTE,DIMSR)
+              IF(TYPE.EQ.99) THEN
+                 WRITE(HSMG,'(25HMCRRGR: GLOBAL PARAMETER ,A,
+     1           12H NOT SET(3).)') TRIM(PARKEY(IPAR))
+                 CALL XABORT(HSMG)
+              ENDIF
+              CALL hdf5_read_data(IPMPO,RECNAM,VREAL)
+              MUPLET(IPAR)=-1
+              MUTYPE(IPAR)=1
+              DO J=1,NVALUE(IPAR)
+                IF(ABS(VALR(IPAR,1)-VREAL(J)).LE.REPS*ABS(VREAL(J)))THEN
+                  MUPLET(IPAR)=J
+                  GOTO 150
+                ENDIF
+              ENDDO
+            ELSEIF(TEXT12.EQ.'SAMEASREF')THEN
+              MUPLET(IPAR)=-1
+              MUTYPE(IPAR)=-1
+            ELSE
+              CALL XABORT('MCRRGR: REAL or "SAMEASREF" expected')
+            ENDIF
+            GOTO 150
+  170       CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          ENDIF
+          DEALLOCATE(VREAL)
+          GOTO 30
+        ELSEIF(PARFMT(IPAR).EQ.'INTEGER')THEN
+          IF(ITYPE.NE.1)CALL XABORT('MCRRGR: SET MANDATORY WITH INT'
+     1     //'EGER PARAMETERS.')
+          CALL REDGET(INDIC,VALI(IPAR),FLOTT,TEXT12,DFLOTT)
+          IF(INDIC.NE.1)CALL XABORT('MCRRGR: INTEGER DATA EXPECTED.')
+          CALL hdf5_read_data(IPMPO,RECNAM,VINTE)
+          DO 175 J=1,NVALUE(IPAR)
+            IF(VALI(IPAR).EQ.VINTE(J))THEN
+              MUPLET(IPAR)=J
+              MUTYPE(IPAR)=ITYPE
+              GOTO 20
+            ENDIF
+  175      CONTINUE
+          WRITE(HSMG,'(26HMCRRGR: INTEGER PARAMETER ,A,9H WITH VAL,
+     1     2HUE,I5,27H NOT FOUND IN MPO DATABASE.)') TRIM(PARKEY(IPAR)),
+     2     VALI(IPAR)
+           CALL XABORT(HSMG)
+        ELSEIF(PARFMT(IPAR).EQ.'STRING')THEN
+          IF(ITYPE.NE.1)CALL XABORT('MCRRGR: SET MANDATORY WITH STR'
+     1     //'ING PARAMETERS.')
+          CALL REDGET(INDIC,NITMA,FLOTT,VALH(IPAR),DFLOTT)
+          IF(INDIC.NE.3)CALL XABORT('MCRRGR: STRING DATA EXPECTED.')
+          CALL hdf5_read_data(IPMPO,RECNAM,VCHAR)
+          DO 180 J=1,NVALUE(IPAR)
+            IF(VALH(IPAR).EQ.VCHAR(J))THEN
+              MUPLET(IPAR)=J
+              MUTYPE(IPAR)=ITYPE
+              GOTO 20
+            ENDIF
+  180     CONTINUE
+          WRITE(HSMG,'(25HMCRRGR: STRING PARAMETER ,A,10H WITH VALU,
+     1     1HE,A12,27H NOT FOUND IN MPO DATABASE.)') TRIM(PARKEY(IPAR)),
+     2     VALH(IPAR)
+          CALL XABORT(HSMG)
+        ELSE
+          CALL XABORT('MCRRGR: INVALID FORMAT='//PARFMT(IPAR))
+        ENDIF
+      ELSEIF(TEXT12.EQ.'TIMAV-BURN')THEN
+        IF(IBM.EQ.0) CALL XABORT('MCRRGR: MIX NOT SET (3).')
+        IBTYP=1
+      ELSEIF(TEXT12.EQ.'INST-BURN')THEN
+        IF(IBM.EQ.0) CALL XABORT('MCRRGR: MIX NOT SET (4).')
+        IBTYP=2
+      ELSEIF(TEXT12.EQ.'AVG-EX-BURN')THEN
+        IF(IBM.EQ.0) CALL XABORT('MCRRGR: MIX NOT SET (5).')
+        IBTYP=3
+        CALL REDGET(INDIC,IVARTY,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1)CALL XABORT('MCRRGR: INTEGER DATA EXPECTED.')
+      ELSEIF(TEXT12.EQ.'ENDMIX')THEN
+*----
+*  RECOVER FUEL-MAP INFORMATION.
+*----
+        IF(IMPX.GT.0) THEN
+          DO IPAR=1,NPAR
+            IF(PARFMT(IPAR).EQ.'FLOAT')THEN
+              IF(LCUB2(IPAR)) THEN
+                WRITE(IOUT,'(26H MCRRGR: GLOBAL PARAMETER:,A,5H ->CU,
+     1          18HBIC INTERPOLATION.)') TRIM(PARKEY(IPAR))
+              ELSE
+                WRITE(IOUT,'(26H MCRRGR: GLOBAL PARAMETER:,A,5H ->LI,
+     1          19HNEAR INTERPOLATION.)') TRIM(PARKEY(IPAR))
+              ENDIF
+            ENDIF
+          ENDDO
+        ENDIF
+        FMIX(:NCH*NB)=0
+        CALL LCMGET(IPMAP,'FLMIX',FMIX)
+        CALL NCRMAP(IPMAP,NPARM,HPAR,NCH,NB,IBTYP,HNAVAL,IMPX,BRN0,BRN1,
+     1              WPAR,LPARM)
+        IF(IBTYP.EQ.3) THEN
+          IF(IVARTY.EQ.0) CALL XABORT('MCRRGR: IVARTY NOT SET.')
+          CALL LCMGET(IPMAP,'B-ZONE',ZONEC)
+          DO ICH=1,NCH
+            DO J=1,NB
+              IF(ZONEC(ICH).EQ.IVARTY) THEN
+                ZONEDP(ICH,J)=1
+              ELSE
+                ZONEDP(ICH,J)=0
+              ENDIF
+            ENDDO
+          ENDDO
+          CALL LCMLEN(IPMAP,'B-VALUE',ILONG,ITYP)
+          IF (ILONG.EQ.0) CALL XABORT('MCRRGR: NO SAVED VALUES FOR '
+     1    //'THIS TYPE OF VARIABLE IN L_MAP')
+          ALLOCATE(VARC(ILONG))
+          CALL LCMGET(IPMAP,'B-VALUE',VARC)
+          VARVAL=VARC(IVARTY)
+          DEALLOCATE(VARC)
+        ENDIF
+*----
+*  PERFORM INTERPOLATION OVER THE FUEL MAP.
+*----
+        DO 185 JPARM=1,NPARMP
+          IPAR=0
+          DO I=1,NPAR
+            IF(HPAR(JPARM).EQ.PARKEY(I))THEN
+              IPAR=I
+              IF(LSET(IPAR)) THEN
+                IF(IMPX.GT.0) WRITE(6,*) 'L_MAP values overwritten by '
+     1          // 'the SET option for parameter '//HPAR(JPARM)
+                IF(.NOT.LADD(IPAR)) LPARM(JPARM)=.FALSE.
+              ENDIF
+              GOTO 185
+            ENDIF
+          ENDDO
+          LPARM(JPARM)=.FALSE.
+  185   CONTINUE
+*----
+*  COMPUTE ALL THE MUPLETS FOR EACH BUNDLE
+*----
+        IMPY=MAX(0,IMPX-1)
+        NTOT=0
+        DO 285 JB=1,NB
+        DO 280 ICH=1,NCH
+        IB=(JB-1)*NCH+ICH
+        IF(FMIX(IB).EQ.0) GO TO 280
+        NTOT=NTOT+1
+        IF(FMIX(IB).EQ.IBM)THEN
+          IF(NTOT.GT.NMIX) CALL XABORT('MCRRGR: NMIX OVERFLOW.')
+          DO 260 JPARM=1,NPARMP
+          IF(.NOT.LPARM(JPARM))GOTO 260
+        IPAR=0
+        DO I=1,NPAR
+          IF(HPAR(JPARM).EQ.PARKEY(I))THEN
+            IPAR=I
+            HPARNA=HPAR(JPARM)
+            GOTO 190
+          ENDIF
+        ENDDO
+        WRITE(HSMG,'(18HMCRRGR: PARAMETER ,A,14H NOT FOUND(4).)')
+     1  HPAR(JPARM)
+        CALL XABORT(HSMG)
+  190   CONTINUE
+        WRITE(RECNAM,'(25H/parameters/values/PARAM_,I0)') IPAR-1
+        CALL hdf5_info(IPMPO,RECNAM,RANK,TYPE,NBYTE,DIMSR)
+        IF(TYPE.EQ.99) THEN
+          WRITE(HSMG,'(25HMCRRGR: GLOBAL PARAMETER ,A,12H NOT SET(4).)')
+     1    TRIM(PARKEY(IPAR))
+          CALL XABORT(HSMG)
+        ENDIF
+        ITYPE=0
+        IF((JPARM.EQ.NPARMP).AND.(NPARMP.EQ.NPARM+1))THEN
+*         parameter JPARAM is burnup
+          IF(.NOT.LSET(IPAR))THEN
+            MUTYPE(IPAR)=1
+            MUPLET(IPAR)=-1
+            BURN0=0.0
+            BURN1=0.0
+            IF(IBTYP.EQ.1)THEN
+*             TIME-AVERAGE
+              BURN0=BRN0(IB)
+              BURN1=BRN1(IB)
+            ELSEIF(IBTYP.EQ.2)THEN
+*             INSTANTANEOUS
+              BURN0=BRN0(IB)
+              BURN1=BURN0
+            ELSEIF(IBTYP.EQ.3)THEN
+*             DIFFERENCIATION RELATIVE TO EXIT BURNUP
+              ITYPE=3
+              BURN0=BRN0(IB)
+              BURN1=BRN1(IB)
+            ENDIF
+            VALR(IPAR,1)=BURN0
+            VALR(IPAR,2)=BURN1
+            VALR1=VALR(IPAR,1)
+            VALR2=VALR(IPAR,2)
+            ITYPE=1
+          ENDIF
+        ELSE
+          IF(.NOT.LSET(IPAR))THEN
+            VALR(IPAR,1)=WPAR(IB,JPARM)
+            VALR(IPAR,2)=WPAR(IB,JPARM)
+            MUPLET(IPAR)=-1
+            MUTYPE(IPAR)=1
+            VALR1=VALR(IPAR,1)
+            VALR2=VALR(IPAR,2)
+            ITYPE=1
+          ENDIF
+          IF(LDMAP(IPAR,1).OR.LDMAP(IPAR,2))THEN
+            IF(LDMAP(IPAR,1)) VALR(IPAR,1)=WPAR(IB,JPARM)
+            IF(LDMAP(IPAR,2)) VALR(IPAR,2)=WPAR(IB,JPARM)
+            MUPLET(IPAR)=-1
+            MUTYPE(IPAR)=2
+            VALR1=VALR(IPAR,1)
+            VALR2=VALR(IPAR,2)
+            ITYPE=2
+          ELSE IF(LADD(IPAR))THEN
+            DO N=1,NDLTA(IPAR)
+              IDLTA1=IDLTA(IPAR,N)
+              IF(LAMAP(IPAR,1,IDLTA1)) THEN
+                VALRA(IPAR,1,IDLTA1)=WPAR(IB,JPARM)
+                MAPLET(IPAR,IDLTA1)=-1
+                MATYPE(IPAR,IDLTA1)=2
+              ENDIF
+              IF(LAMAP(IPAR,2,IDLTA1)) THEN
+                VALRA(IPAR,2,IDLTA1)=WPAR(IB,JPARM)
+                MAPLET(IPAR,IDLTA1)=-1
+                MATYPE(IPAR,IDLTA1)=2
+              ENDIF
+            ENDDO
+            VALR1=VALRA(IPAR,1,IDLTA(IPAR,1))
+            VALR2=VALRA(IPAR,2,IDLTA(IPAR,1))
+            ITYPE=2
+          ENDIF
+        ENDIF
+        WRITE(RECNAM,'(25H/parameters/values/PARAM_,I0)') IPAR-1
+        CALL hdf5_info(IPMPO,RECNAM,RANK,TYPE,NBYTE,DIMSR)
+        IF(TYPE.EQ.99) THEN
+          WRITE(HSMG,'(25HMCRRGR: GLOBAL PARAMETER ,A,12H NOT SET(5).)')
+     1    TRIM(PARKEY(IPAR))
+          CALL XABORT(HSMG)
+        ENDIF
+        CALL hdf5_read_data(IPMPO,RECNAM,VREAL)
+        IF(ITYPE.EQ.1)THEN
+          IF(VALR1.EQ.VALR2)THEN
+            DO J=1,NVALUE(IPAR)
+              IF(ABS(VALR1-VREAL(J)).LE.REPS*ABS(VREAL(J)))THEN
+                MUPLET(IPAR)=J
+                MUTYPE(IPAR)=ITYPE
+                GOTO 260
+              ENDIF
+            ENDDO
+          ENDIF
+        ENDIF
+*----
+*  ERRORS HANDLING
+*----
+        IF(VALR1.LT.VREAL(1))THEN
+*         OUTSIDE OF THE DOMAIN (1)
+          WRITE(HSMG,'(23HMCRRGR: REAL PARAMETER ,A,10H WITH VALU,
+     1    1HE,1P,E12.4,26H IS OUTSIDE THE DOMAIN(3).)') HPARNA,VALR1
+          WRITE(6,*)'Domain:',VREAL(1),' <-> ',VREAL(NVALUE(IPAR))
+          CALL XABORT(HSMG)
+        ELSEIF(VALR2.GT.VREAL(NVALUE(IPAR)))THEN
+*         OUTSIDE OF THE DOMAIN (2)
+          WRITE(HSMG,'(23HMCRRGR: REAL PARAMETER ,A,10H WITH VALU,
+     1    1HE,1P,E12.4,26H IS OUTSIDE THE DOMAIN(4).)') HPARNA,VALR2
+          WRITE(6,*)'Domain:',VREAL(1),' <-> ',VREAL(NVALUE(IPAR))
+          CALL XABORT(HSMG)
+        ELSEIF((ITYPE.EQ.1).AND.(VALR1.GT.VALR2))THEN
+*         VALR1 > VALR2
+          WRITE(HSMG,'(23HMCRRGR: REAL PARAMETER ,A,9H IS DEFIN,
+     1    7HED WITH,1P,E12.4,2H >,E12.4,4H.(2))') HPARNA,
+     2    VALR1,VALR2
+          CALL XABORT(HSMG)
+        ENDIF
+        DEALLOCATE(VREAL)
+*----
+*  COMPUTE THE TERP FACTORS USING TABLE-OF-CONTENT INFORMATION.
+*----
+  260     CONTINUE
+          MIXC(NTOT)=IBMOLD
+          IF(IBMOLD.GT.NMIL)
+     1       CALL XABORT('MCRRGR: MIX OVERFLOW (MPO).')
+          IF(IMPY.GT.2) WRITE(6,'(32H MCRRGR: COMPUTE TERP FACTORS IN,
+     1    12H NEW MIXTURE,I5,1H.)') NTOT
+          NISO(NTOT)=NISOMI
+          LISO(NTOT)=LISOMI
+          LDELTA(NTOT)=LDELT1
+          DO ISO=1,NISOMI
+            HISO(NTOT,ISO)=HISOMI(ISO)
+            CONC(NTOT,ISO)=CONCMI(ISO)
+          ENDDO
+          DO JPAR=1,NPAR
+            MUPLT2(JPAR)=MUPLET(JPAR)
+          ENDDO
+          IF(IBTYP.EQ.3)THEN
+             IF(ZONEDP(ICH,JB).NE.0) THEN
+                CALL MCRTRP(IPMPO,LCUB2,IMPY,NPAR,NCAL,MUPLT2,MUTYPE(1),
+     1                      PARTYP,VALR(1,1),VARVAL,MUBASE,TERP(1,NTOT))
+             ELSE
+                TERP(:NCAL,NTOT)=0.0
+             ENDIF
+          ELSE
+             CALL MCRTRP(IPMPO,LCUB2,IMPY,NPAR,NCAL,MUPLT2,MUTYPE(1),
+     1                   PARTYP,VALR(1,1),VARVAL,MUBASE,TERP(1,NTOT))
+          ENDIF
+*         DELTA-ADD
+          DO 270 IPAR=1,NPAR
+            IF(LADD(IPAR))THEN
+              DO N=1,NDLTA(IPAR)
+                IDLTA1=IDLTA(IPAR,N)
+                DO JPAR=1,NPAR
+                  MUPLT2(JPAR)=MAPLET(JPAR,IDLTA1)
+                  MUTYP2(JPAR)=MATYPE(JPAR,IDLTA1)
+                ENDDO
+                DO JPAR=1,NPAR
+                  IF(MUTYP2(JPAR).LT.0)THEN
+                    MUPLT2(JPAR)=MUPLET(JPAR)
+                    MUTYP2(JPAR)=MUTYPE(JPAR)
+                    VALRA(JPAR,1,IDLTA1)=VALR(JPAR,1)
+                    VALRA(JPAR,2,IDLTA1)=VALR(JPAR,2)
+                  ENDIF
+                ENDDO
+                ALLOCATE(TERPA(NCAL))
+                CALL MCRTRP(IPMPO,LCUB2,IMPY,NPAR,NCAL,MUPLT2,MUTYP2(1),
+     1          PARTYP,VALRA(1,1,IDLTA1),VARVAL,MUBASE,TERPA(1))
+                DO 275 JCAL=1,NCAL
+                TERP(JCAL,NTOT)=TERP(JCAL,NTOT)+TERPA(JCAL)
+  275           CONTINUE
+                DEALLOCATE(TERPA)
+              ENDDO
+            ENDIF
+  270     CONTINUE
+        ENDIF
+  280   CONTINUE
+  285   CONTINUE
+        IF(NTOT.NE.NMIX) CALL XABORT('MCRRGR: ALGORITHM FAILURE.')
+        IBM=0
+      ELSEIF((TEXT12.EQ.'MPO').OR.(TEXT12.EQ.'TABLE').OR.
+     1   (TEXT12.EQ.'CHAIN').OR.(TEXT12.EQ.';')) THEN
+*----
+*  CHECK TERP FACTORS AND RETURN
+*----
+        IF(TEXT12.EQ.';') ITER=0
+        IF(TEXT12.EQ.'MPO') ITER=1
+        IF(TEXT12.EQ.'TABLE') ITER=2
+        IF(TEXT12.EQ.'CHAIN') ITER=3
+        DO 300 IBM=1,NMIX
+        IBMOLD=MIXC(IBM)
+        IF(IBMOLD.EQ.0) GO TO 300
+        IF(NISO(IBM).GT.MAXNIS) CALL XABORT('MCRRGR: MAXNIS OVERFLOW.')
+        IF(LDELTA(IBM)) THEN
+          SUM=0.0
+        ELSE
+          SUM=1.0
+        ENDIF
+        DO 290 ICAL=1,NCAL
+        SUM=SUM-TERP(ICAL,IBM)
+  290   CONTINUE
+        IF(ABS(SUM).GT.1.0E-4) THEN
+           WRITE(HSMG,'(43HMCRRGR: INVALID INTERPOLATION FACTORS IN MI,
+     1     5HXTURE,I4,1H.)') IBM
+           CALL XABORT(HSMG)
+        ENDIF
+  300   CONTINUE
+        DEALLOCATE(NVALUE)
+*----
+*  EXIT MAIN LOOP OF THE SUBROUTINE
+*----
+        GO TO 310
+      ELSE
+        CALL XABORT('MCRRGR: '//TEXT12//' IS AN INVALID KEYWORD.')
+      ENDIF
+      GOTO 20
+*----
+*  PRINT INTERPOLATION (TERP) FACTORS
+*----
+  310 IF(IMPX.GT.2) THEN
+        WRITE(IOUT,'(/30H MCRRGR: INTERPOLATION FACTORS)')
+        DO ICAL=1,NCAL
+          DO IBM=1,NMIX
+            IF(TERP(ICAL,IBM).NE.0.0) THEN
+              WRITE(IOUT,320) ICAL,(TERP(ICAL,JBM),JBM=1,NMIX)
+              EXIT
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      IF(NPAR.GT.0) DEALLOCATE(PARFMT,PARKEY,PARTYP)
+      DEALLOCATE(MUBASE)
+      DEALLOCATE(HISOMI,HPAR,LDELTA,WPAR,BRN1,BRN0,ZONEC,ZONEDP,FMIX,
+     1 LPARM)
+      DEALLOCATE(MUTYPE,MUPLET)
+      RETURN
+*
+  320 FORMAT(6H CALC=,I8,6H TERP=,1P,8E13.5/(20X,8E13.5))
+      END
diff --git a/Donjon/src/MCRSX2.f b/Donjon/src/MCRSX2.f
new file mode 100644
index 0000000..b0e9ba9
--- /dev/null
+++ b/Donjon/src/MCRSX2.f
@@ -0,0 +1,241 @@
+*DECK MCRSX2
+      SUBROUTINE MCRSX2(IPMPO,HEDIT,RECNAM,NREA,NGRP,NMGF,NL,ISO,
+     1 NOMREA,NOMISO,DEN,FACT,WEIGHT,SPH,FLUXS,IREAB,IREAF,LPURE,
+     2 IGYELD,LXS,XS,SIGS,SS2D,TAUXFI,TAUXGF)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover the cross sections of an elementary calculation and single
+* mixture in an MPO file and perform multiparameter interpolation.
+*
+*Copyright:
+* Copyright (C) 2022 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): A. Hebert
+*
+*Parameters: input
+* IPMPO   pointer to the MPO file.
+* HEDIT   name of output group for a (multigroup mesh, output geometry)
+*         couple (generally equal to 'output_0').
+* RECNAM  character identification of calculation.
+* NREA    number of reactions in the MPO file.
+* NGRP    number of energy groups.
+* NMGF    number of macrogroups for the fission yields.
+* NL      maximum Legendre order (NL=1 is for isotropic scattering).
+* ISO     isotope index.
+* NOMREA  names of reactions in the MPO file.
+* NOMISO  name of isotope ISO.
+* DEN     number density of isotope.
+* FACT    number density ratio for the isotope.
+* WEIGHT  interpolation weight.
+* SPH     SPH factors.
+* FLUXS   averaged flux.
+* IREAB   position of 'Absorption' reaction in NOMREA array.
+* IREAF   position of 'NuFission' reaction in NOMREA array.
+* LPURE   =.true. if the interpolation is a pure linear interpolation 
+*         with TERP factors.
+* IGYELD  yield macrogroup limits.
+*
+*Parameters: input/output
+* LXS     existence flag of each reaction.
+* XS      interpolated cross sections per reaction
+* SIGS    interpolated scattering cross sections
+* SS2D    interpolated scattering matrix
+* TAUXFI  interpolated fission rate
+* TAUXGF  interpolated fission rate in macrogroups
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      USE hdf5_wrap
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMPO
+      CHARACTER(LEN=12) HEDIT
+      CHARACTER(LEN=80) RECNAM
+      INTEGER NREA,NGRP,NMGF,NL,ISO,IREAB,IREAF,IGYELD(NMGF)
+      REAL DEN,FACT,WEIGHT,SPH(NGRP),FLUXS(NGRP),SS2D(NGRP,NGRP,NL),
+     1 SIGS(NGRP,NL),XS(NGRP,NREA),TAUXFI,TAUXGF(NMGF)
+      LOGICAL LXS(NREA),LPURE
+      CHARACTER NOMREA(NREA)*24,NOMISO*24
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER IREA,IOF,IL,IGR,JGR,IGRC,IGRDEB,IGRFIN,ADDRZX,ADDRZI,
+     1 IPROF,ISOM,JOFS,NISO,NL1,NL2,RANK,TYPE,NBYTE,DIMSR(5)
+      REAL FLOTT,TAUXF,ZIL,B2
+      CHARACTER RECNAM2*80
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IDATAP,FAG,ADR,ADDRISO
+      INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: ADDRXS
+      REAL, ALLOCATABLE, DIMENSION(:) :: RDATAX,DIFF
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: SIGSB,XSB
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: SS2DB
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(SIGSB(NGRP,NL),SS2DB(NGRP,NGRP,NL),XSB(NGRP,NREA),
+     1 FAG(NGRP),ADR(NGRP))
+*----
+*  FIND THE ISOTOPE INDEX IN ADDRXS
+*----
+      WRITE(RECNAM2,'(8H/output/,A,6H/info/)') TRIM(HEDIT)
+      CALL hdf5_read_data(IPMPO,TRIM(RECNAM2)//"NISO",NISO)
+      CALL hdf5_read_data(IPMPO,TRIM(RECNAM2)//"ADDRXS",ADDRXS)
+      CALL hdf5_read_data(IPMPO,TRIM(RECNAM2)//"ADDRISO",ADDRISO)
+      CALL hdf5_read_data(IPMPO,TRIM(RECNAM2)//"TRANSPROFILE",IDATAP)
+      CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"ADDRZI",ADDRZI)
+      CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"ADDRZX",ADDRZX)
+      CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"CROSSECTION",RDATAX)
+      ISOM=ISO-ADDRISO(ADDRZI+1)
+      IF((ISOM.LE.0).OR.(ISOM.GT.NISO)) CALL XABORT('MCRSX2: ADDRXS OV'
+     1 //'ERFLOW.')
+      NL1=ADDRXS(NREA-1,ISOM,ADDRZX+1)
+      NL2=ADDRXS(NREA,ISOM,ADDRZX+1)
+      IF((NL1.GT.NL).OR.(NL2.GT.NL)) CALL XABORT('MCRSX2: NL OVERFLOW.')
+*----
+*  LOOP OVER REACTIONS
+*----
+      SIGSB(:NGRP,:NL)=0.0
+      SS2DB(:NGRP,:NGRP,:NL)=0.0
+      XSB(:NGRP,:NREA)=0.0
+      DO IREA=1,NREA-2
+        IOF=ADDRXS(IREA,ISOM,ADDRZX+1)
+        IF(IOF.LT.0) CYCLE
+        LXS(IREA)=.TRUE.
+        IF(NOMREA(IREA).EQ.'Diffusion') THEN
+          DO IL=1,NL1
+            DO IGR=1,NGRP
+              FLOTT=RDATAX(IOF+(IL-1)*NGRP+IGR)
+              SIGSB(IGR,IL)=SIGSB(IGR,IL)+FLOTT
+            ENDDO
+          ENDDO
+        ELSE IF(NOMREA(IREA).EQ.'Scattering') THEN
+          IPROF=ADDRXS(NREA+1,ISOM,ADDRZX+1)
+          DO IGR=1,NGRP
+            FAG(IGR)=IDATAP(IPROF+IGR)+1
+            ADR(IGR)=IDATAP(IPROF+NGRP+IGR)
+          ENDDO
+          ADR(NGRP+1)=IDATAP(IPROF+1+2*NGRP)
+          JOFS=0
+          DO IL=1,NL2
+            ZIL=REAL(2*IL-1)
+            DO IGR=1,NGRP
+              DO JGR=FAG(IGR),FAG(IGR)+(ADR(IGR+1)-ADR(IGR))-1
+                IF(JGR.GT.NGRP) CALL XABORT('MCRSX2: SS2D OVERFLOW.')
+                FLOTT=RDATAX(IOF+JOFS+1)/ZIL
+                SS2DB(JGR,IGR,IL)=SS2DB(JGR,IGR,IL)+FLOTT ! JGR <-- IGR
+                JOFS=JOFS+1
+              ENDDO
+            ENDDO
+          ENDDO
+        ELSE
+          XSB(:NGRP,IREA)=RDATAX(IOF+1:IOF+NGRP)
+        ENDIF
+      ENDDO ! end of loop over reactions
+      DEALLOCATE(IDATAP,RDATAX,ADDRISO,ADDRXS)
+      LXS(NREA-1)=.TRUE.
+*----
+*  RECOVER DIFFUSION COEFFICIENT INFORMATION
+*----
+      IF(NOMISO.EQ.'TotalResidual_mix') THEN
+        IF(hdf5_group_exists(IPMPO,TRIM(RECNAM)//"leakage")) THEN
+          CALL hdf5_info(IPMPO,TRIM(RECNAM)//"leakage/DIFFCOEF",RANK,
+     1    TYPE,NBYTE,DIMSR)
+          IF(TYPE.NE.99) THEN
+            LXS(NREA)=.TRUE.
+            CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"leakage/DIFFCOEF",
+     1      DIFF)
+            XSB(:NGRP,NREA)=DIFF(:NGRP)*DEN
+            DEALLOCATE(DIFF)
+            GO TO 10
+          ENDIF
+          CALL hdf5_info(IPMPO,TRIM(RECNAM)//"leakage/DB2",RANK,TYPE,
+     1    NBYTE,DIMSR)
+          IF(TYPE.NE.99) THEN
+            LXS(NREA)=.TRUE.
+            CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"leakage/BUCKLING",
+     1      B2)
+            CALL hdf5_read_data(IPMPO,TRIM(RECNAM)//"leakage/DB2",DIFF)
+            DO IGR=1,NGRP
+              XSB(IGR,NREA)=DIFF(IGR)*DEN/B2
+            ENDDO
+            DEALLOCATE(DIFF)
+          ENDIF
+        ENDIF
+      ENDIF
+*----
+*  COMPUTE FISSION RATE FOR AN ELEMENTARY CALCULATION
+*----
+   10 TAUXF=0.0
+      TAUXGF(:NMGF)=0.0
+      IF(IREAF.GT.0) THEN
+        DO IGR=1,NGRP
+          TAUXF=TAUXF+XSB(IGR,IREAF)*FLUXS(IGR)
+        ENDDO
+        TAUXFI=TAUXFI+WEIGHT*FACT*TAUXF
+        IGRFIN=0
+        DO IGRC=1,NMGF
+          IGRDEB=IGRFIN+1
+          IGRFIN=IGYELD(IGRC)
+          DO IGR=IGRDEB,IGRFIN
+            TAUXGF(IGRC)=TAUXGF(IGRC)+XSB(IGR,IREAF)*FLUXS(IGR)
+          ENDDO
+          TAUXGF(:NMGF)=WEIGHT*FACT*TAUXGF(:NMGF)
+        ENDDO
+      ENDIF
+*----
+*  WEIGHT MICROSCOPIC CROSS SECTION DATA IN AN INTERPOLATED MICROLIB
+*----
+      DO IGR=1,NGRP
+        DO IREA=1,NREA
+          IF(.NOT.LXS(IREA)) CYCLE
+          IF(NOMREA(IREA).EQ.'Total') THEN
+            XS(IGR,IREA)=XS(IGR,IREA)+FACT*SPH(IGR)*WEIGHT*
+     1      (XSB(IGR,IREAB)+SIGSB(IGR,1))
+          ELSE IF(LPURE.AND.NOMREA(IREA).EQ.'FissionSpectrum') THEN
+            XS(IGR,IREA)=XS(IGR,IREA)+WEIGHT*XSB(IGR,IREA)
+          ELSE IF(NOMREA(IREA).EQ.'FissionSpectrum') THEN
+            IF(IREAF.EQ.0) CALL XABORT('MCRSX2: IREAF=0.')
+            XS(IGR,IREA)=XS(IGR,IREA)+WEIGHT*FACT*TAUXF*XSB(IGR,IREA)
+          ELSE
+            XS(IGR,IREA)=XS(IGR,IREA)+FACT*SPH(IGR)*WEIGHT*XSB(IGR,IREA)
+          ENDIF
+        ENDDO
+        DO IL=1,NL
+          IF(MOD(IL,2).EQ.1) THEN
+            SIGS(IGR,IL)=SIGS(IGR,IL)+FACT*SPH(IGR)*WEIGHT*SIGSB(IGR,IL)
+          ELSE
+            DO JGR=1,NGRP
+              SIGS(IGR,IL)=SIGS(IGR,IL)+FACT*WEIGHT*SS2DB(JGR,IGR,IL)
+     1        /SPH(JGR)
+            ENDDO
+          ENDIF
+        ENDDO
+        DO JGR=1,NGRP
+          DO IL=1,NL
+            IF(MOD(IL,2).EQ.1) THEN
+              SS2D(IGR,JGR,IL)=SS2D(IGR,JGR,IL)+FACT*SPH(JGR)*WEIGHT*
+     1        SS2DB(IGR,JGR,IL)
+            ELSE
+              SS2D(IGR,JGR,IL)=SS2D(IGR,JGR,IL)+FACT*WEIGHT*
+     1        SS2DB(IGR,JGR,IL)/SPH(IGR)
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDDO
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(ADR,FAG,XSB,SS2DB,SIGSB)
+      RETURN
+      END
diff --git a/Donjon/src/MCRTRP.f b/Donjon/src/MCRTRP.f
new file mode 100644
index 0000000..204120d
--- /dev/null
+++ b/Donjon/src/MCRTRP.f
@@ -0,0 +1,233 @@
+*DECK MCRTRP
+      SUBROUTINE MCRTRP(IPMPO,LCUB2,IMPX,NPAR,NCAL,MUPLET,MUTYPE,PARTYP,
+     1 VALR,VARVAL,MUBASE,TERP)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute the TERP interpolation/derivation/integration factors using
+* table-of-content information of the MPO file.
+*
+*Copyright:
+* Copyright (C) 2022 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPMPO   address of the multidimensional MPO file.
+* LCUB2   interpolation type for each parameter (=.TRUE.: cubic Ceschino
+*         interpolation; =.FALSE: linear Lagrange interpolation).
+* IMPX    print parameter (equal to zero for no print).
+* NPAR    number of global parameters.
+* NCAL    number of elementary calculations in the MPO file.
+* MUPLET  tuple used to identify an elementary calculation.
+* MUTYPE  type of interpolation (=1: interpolation; =2: delta-sigma).
+* PARTYP  parameter types.
+* VALR    real values of the interpolated point.
+* VARVAL  exit burnup used if MUTYPE(IPAR(ID))=3.
+* MUBASE  muplet database.
+*
+*Parameters: output
+* TERP    interpolation factors.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      USE hdf5_wrap
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER, PARAMETER::MAXPAR=50
+      TYPE(C_PTR) IPMPO
+      INTEGER IMPX,NPAR,NCAL,MUPLET(NPAR),MUTYPE(NPAR),MUBASE(NPAR,NCAL)
+      REAL VALR(2*MAXPAR,2),VARVAL,TERP(NCAL)
+      LOGICAL LCUB2(NPAR)
+      CHARACTER(LEN=24) PARTYP(NPAR)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXDIM=10
+      INTEGER, PARAMETER::MAXVAL=200
+      INTEGER IPAR(MAXDIM),NVAL(MAXDIM),IDDIV(MAXDIM)
+      REAL BURN0, BURN1, DENOM, TERTMP
+      INTEGER I, ICAL, ID, IDTMP, IDTOT, JD, NDELTA, NDIM, NID, NTOT,
+     1 MCRCAL, IBURN, ITIME
+      REAL T1D(MAXVAL,MAXDIM),WORK(MAXVAL)
+      CHARACTER HSMG*131,RECNAM*80
+      LOGICAL LCUBIC,LSINGL
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: NVALUE,MUPLE2
+      REAL, ALLOCATABLE, DIMENSION(:) :: TERPA,VREAL
+      CHARACTER(LEN=80), ALLOCATABLE, DIMENSION(:) :: PARNAM
+*----
+*  RECOVER TREE INFORMATION
+*----
+      IBURN=0
+      ITIME=0
+      IF(NPAR.GT.0) THEN
+        CALL hdf5_read_data(IPMPO,"/parameters/info/NVALUE",NVALUE)
+        DO I=1,NPAR
+          IF(PARTYP(I).EQ.'BURNUP') IBURN=I
+          IF(PARTYP(I).EQ.'TIME') ITIME=I
+        ENDDO
+      ENDIF
+*----
+*  COMPUTE TERP FACTORS
+*----
+      TERP(:NCAL)=0.0
+      IPAR(:MAXDIM)=0
+      NDIM=0
+      NDELTA=0
+      DO 10 I=1,NPAR
+        IF(MUPLET(I).EQ.-1) THEN
+          NDIM=NDIM+1
+          IF(MUTYPE(I).NE.1) NDELTA=NDELTA+1
+          IF(NDIM.GT.MAXDIM) THEN
+            WRITE(HSMG,'(7HMCRTRP:,I4,29H-DIMENSIONAL INTERPOLATION NO,
+     1      14HT IMPLEMENTED.)') NDIM
+            CALL XABORT(HSMG)
+          ENDIF
+          IPAR(NDIM)=I
+        ELSE IF((MUPLET(I).EQ.0).AND.(NVALUE(I).EQ.1)) THEN
+          MUPLET(I)=1
+        ENDIF
+   10 CONTINUE
+      IF(IMPX.GT.2) THEN
+        WRITE(IOUT,'(16H MCRTRP: MUPLET=,10I4/(16X,10I4))')
+     1  (MUPLET(I),I=1,NPAR)
+        WRITE(IOUT,'(8H MCRTRP:,I4,31H-DIMENSIONAL INTERPOLATION IN M,
+     1  3HPO.)') NDIM
+      ENDIF
+      ALLOCATE(MUPLE2(NPAR))
+      IF(NDIM.EQ.0) THEN
+        MUPLE2(:NPAR)=MUPLET(:NPAR)
+        IF((MUPLET(IBURN).NE.0).AND.(MUPLET(ITIME).EQ.0)) THEN
+          MUPLE2(ITIME)=MUPLE2(IBURN)
+        ELSE IF((MUPLET(IBURN).EQ.0).AND.(MUPLET(ITIME).NE.0)) THEN
+          MUPLE2(IBURN)=MUPLE2(ITIME)
+        ENDIF
+        ICAL=0
+        IF(NPAR.GT.0) ICAL=MCRCAL(NPAR,NCAL,MUPLE2,MUBASE)
+        IF(ICAL.GT.NCAL) CALL XABORT('MCRTRP: TERP OVERFLOW(1).')
+        IF(ICAL.EQ.0) GO TO 200
+        IF(ICAL.EQ.-1) GO TO 210
+        TERP(ICAL)=1.0
+      ELSE
+        NTOT=1
+        IDDIV(:MAXDIM)=1
+        DO 70 ID=1,NDIM
+        IF(IPAR(ID).LE.NPAR) THEN
+          WRITE(RECNAM,'(25H/parameters/values/PARAM_,I0)') IPAR(ID)-1
+          NID=NVALUE(IPAR(ID))
+        ELSE
+          CALL XABORT('MCRTRP: PARAMETER INDEX OVERFLOW.')
+        ENDIF
+        NTOT=NTOT*NID
+        DO 15 IDTMP=1,NDIM-ID
+        IDDIV(IDTMP)=IDDIV(IDTMP)*NID
+   15   CONTINUE
+        CALL hdf5_read_data(IPMPO,RECNAM,VREAL)
+        BURN0=VALR(IPAR(ID),1)
+        BURN1=VALR(IPAR(ID),2)
+        LSINGL=(BURN0.EQ.BURN1)
+        LCUBIC=LCUB2(IPAR(ID))
+        IF((MUTYPE(IPAR(ID)).EQ.1).AND.LSINGL) THEN
+          CALL ALTERP(LCUBIC,NID,VREAL,BURN0,.FALSE.,T1D(1,ID))
+        ELSE IF(MUTYPE(IPAR(ID)).EQ.1) THEN
+          IF(BURN0.GE.BURN1) CALL XABORT('MCRTRP: INVALID BURNUP'
+     1     //' LIMITS(1).')
+          CALL ALTERI(LCUBIC,NID,VREAL,BURN0,BURN1,T1D(1,ID))
+          DO 20 I=1,NID
+          T1D(I,ID)=T1D(I,ID)/(BURN1-BURN0)
+   20     CONTINUE
+        ELSE IF((MUTYPE(IPAR(ID)).EQ.2).AND.(.NOT.LSINGL)) THEN
+          CALL ALTERP(LCUBIC,NID,VREAL,BURN0,.FALSE.,WORK(1))
+          CALL ALTERP(LCUBIC,NID,VREAL,BURN1,.FALSE.,T1D(1,ID))
+          DO 30 I=1,NID
+          T1D(I,ID)=T1D(I,ID)-WORK(I)
+   30     CONTINUE
+        ELSE IF((MUTYPE(IPAR(ID)).EQ.2).AND.(LSINGL)) THEN
+          T1D(:NID,ID)=0.0
+        ELSE IF(MUTYPE(IPAR(ID)).EQ.3) THEN
+*          DERIVATIVE WITH RESPECT TO A SINGLE EXIT BURNUP. USE
+*          EQ.(3.3) OF RICHARD CHAMBON'S THESIS.
+          IF(BURN0.GE.BURN1) CALL XABORT('MCRTRP: INVALID BURNUP'
+     1    //' LIMITS(2).')
+          CALL hdf5_read_data(IPMPO,"/paramdescrip/PARNAM",PARNAM)
+          IF(PARNAM(IPAR(ID)).NE.'Burnup') THEN
+            CALL XABORT('MCRTRP: Burnup EXPECTED.')
+          ENDIF
+          DEALLOCATE(PARNAM)
+          ALLOCATE(TERPA(NID))
+          CALL ALTERI(LCUBIC,NID,VREAL,BURN0,BURN1,TERPA(1))
+          DO 40 I=1,NID
+          T1D(I,ID)=-TERPA(I)
+   40     CONTINUE
+          CALL ALTERP(LCUBIC,NID,VREAL,BURN0,.FALSE.,TERPA(1))
+          DO 50 I=1,NID
+          T1D(I,ID)=T1D(I,ID)-TERPA(I)*BURN0
+   50     CONTINUE
+          CALL ALTERP(LCUBIC,NID,VREAL,BURN1,.FALSE.,TERPA(1))
+          DENOM=VARVAL*(BURN1-BURN0)
+          DO 60 I=1,NID
+          T1D(I,ID)=(T1D(I,ID)+TERPA(I)*BURN1)/DENOM
+   60     CONTINUE
+          DEALLOCATE(TERPA)
+        ELSE
+          CALL XABORT('MCRTRP: INVALID OPTION.')
+        ENDIF
+        DEALLOCATE(VREAL)
+        NVAL(ID)=NID
+   70   CONTINUE
+
+* Example: NDIM=3, NVALUE=(3,2,2)
+* IDTOT 1  2  3  4  5  6  7  8  9 10 11 12
+* ID(1) 1  2  3  1  2  3  1  2  3  1  2  3
+* ID(2) 1  1  1  2  2  2  1  1  1  2  2  2
+* ID(3) 1  1  1  1  1  1  2  2  2  2  2  2
+* (NTOT=12, IDDIV=(6,3,1))
+        DO 100 IDTOT=1,NTOT               ! Ex.: IDTOT       = 9
+          TERTMP=1.0
+          IDTMP=IDTOT
+          DO 80 JD=1,NDIM                 ! Ex.: JD          = 1,2,3
+            ID=(IDTMP-1)/IDDIV(JD)+1      ! Ex.: ID(NDIM...1)= 2,1,3
+            IDTMP=IDTMP-(ID-1)*IDDIV(JD)  ! Ex.: IDTMP       = 3,3,1
+            MUPLET(IPAR(NDIM-JD+1))=ID
+            TERTMP=TERTMP*T1D(ID,NDIM-JD+1)
+   80     CONTINUE
+          MUPLE2(:NPAR)=MUPLET(:NPAR)
+          IF((MUPLET(IBURN).NE.0).AND.(MUPLET(ITIME).EQ.0)) THEN
+            MUPLE2(ITIME)=MUPLE2(IBURN)
+          ELSE IF((MUPLET(IBURN).EQ.0).AND.(MUPLET(ITIME).NE.0)) THEN
+            MUPLE2(IBURN)=MUPLE2(ITIME)
+          ENDIF
+          ICAL=MCRCAL(NPAR,NCAL,MUPLE2,MUBASE)
+          IF(ICAL.GT.NCAL) CALL XABORT('MCRTRP: TERP OVERFLOW(2).')
+          IF(ICAL.EQ.0) GO TO 200
+          IF(ICAL.EQ.-1) GO TO 210
+          TERP(ICAL)=TERP(ICAL)+TERTMP
+  100   CONTINUE
+      ENDIF
+      IF(IMPX.GT.3) THEN
+        WRITE(IOUT,'(25H MCRTRP: TERP PARAMETERS:/(1X,1P,10E12.4))')
+     1  (TERP(I),I=1,NCAL)
+      ENDIF
+      DEALLOCATE(MUPLE2)
+      IF(NPAR.GT.0) DEALLOCATE(NVALUE)
+      RETURN
+*----
+*  MISSING ELEMENTARY CALCULATION EXCEPTION.
+*----
+  200 WRITE(IOUT,'(16H MCRTRP: MUPLET=,10I4/(16X,10I4))')
+     1 (MUPLET(I),I=1,NPAR)
+      CALL XABORT('MCRTRP: MISSING ELEMENTARY CALCULATION.')
+  210 WRITE(IOUT,'(16H MCRTRP: MUPLET=,10I4/(16X,10I4))')
+     1 (MUPLET(I),I=1,NPAR)
+      WRITE(IOUT,'(9X,7HNVALUE=,10I4/(16X,10I4))') (NVALUE(I),I=1,NPAR)
+      CALL XABORT('MCRTRP: DEGENERATE ELEMENTARY CALCULATION.')
+      END
diff --git a/Donjon/src/MOVCHK.f b/Donjon/src/MOVCHK.f
new file mode 100644
index 0000000..cc7d274
--- /dev/null
+++ b/Donjon/src/MOVCHK.f
@@ -0,0 +1,137 @@
+*DECK MOVCHK
+      SUBROUTINE MOVCHK(IMPX,IMODE,NPART,IAXIS,ITOP,DELH,LENG,RODPOS)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute and set the new rod position and insertion level for the
+* fading or moving rod.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki and A. Hebert
+*
+*Parameters: input
+* IMPX    printing index (=0 for no print).
+* IMODE   type of displacement: =1 for FADE; =2 for MOVE (DONJON3-type
+*         movement).
+* NPART   number of parts in the control rod.
+* IAXIS   axis of rod movement: =1 for X; =2 for Y; =3 for Z.
+* ITOP    rod insertion: = +1 from the top; = -1 from the bottom.
+* DELH    rod displacement along the IAXIS of movement if FADE; position
+*         of moving end in core if MOVE.
+* LENG    fully-inserted complete rod position.
+* RODPOS  fully inserted rod position.
+*
+*Parameters: output
+* RODPOS  new rod position.
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER IMPX,IMODE,NPART,IAXIS,ITOP
+      REAL DELH,RODPOS(6,NPART),LENG(2),LIMINF
+*
+      PARAMETER(IOUT=6)
+*----
+*  X-AXIS MOVEMENT
+*----
+      IF(IMPX.GT.1) WRITE(IOUT,1000) DELH
+      SUP=DELH
+      DO 10 IPART=1,NPART
+      IF(IAXIS.EQ.1) THEN
+        IF((ITOP.EQ.1).AND.(IMODE.EQ.1)) THEN
+          RODPOS(1,IPART)=MAX(RODPOS(1,IPART),LENG(2)-DELH)
+          RODPOS(1,IPART)=MIN(RODPOS(1,IPART),RODPOS(2,IPART))
+        ELSE IF((ITOP.EQ.-1).AND.(IMODE.EQ.1)) THEN
+          RODPOS(2,IPART)=MIN(RODPOS(2,IPART),LENG(1)+DELH)
+          RODPOS(2,IPART)=MAX(RODPOS(1,IPART),RODPOS(2,IPART))
+        ELSE IF((ITOP.EQ.1).AND.(IMODE.EQ.2)) THEN
+          DELTA=RODPOS(2,IPART)-RODPOS(1,IPART)
+          RODPOS(1,IPART)=SUP
+          RODPOS(2,IPART)=SUP+DELTA
+          SUP=RODPOS(2,IPART)
+        ELSE IF((ITOP.EQ.-1).AND.(IMODE.EQ.2)) THEN
+          DELTA=RODPOS(2,IPART)-RODPOS(1,IPART)
+          RODPOS(2,IPART)=SUP
+          RODPOS(1,IPART)=SUP-DELTA
+          SUP=RODPOS(1,IPART)
+        ENDIF
+*----
+*  Y-AXIS MOVEMENT
+*----
+      ELSE IF(IAXIS.EQ.2) THEN
+        IF((ITOP.EQ.1).AND.(IMODE.EQ.1)) THEN
+          RODPOS(3,IPART)=MAX(RODPOS(3,IPART),LENG(2)-DELH)
+          RODPOS(3,IPART)=MIN(RODPOS(3,IPART),RODPOS(4,IPART))
+        ELSE IF((ITOP.EQ.-1).AND.(IMODE.EQ.1)) THEN
+          RODPOS(4,IPART)=MIN(RODPOS(4,IPART),LENG(1)+DELH)
+          RODPOS(4,IPART)=MAX(RODPOS(3,IPART),RODPOS(4,IPART))
+        ELSE IF((ITOP.EQ.1).AND.(IMODE.EQ.2)) THEN
+          DELTA=RODPOS(4,IPART)-RODPOS(3,IPART)
+          RODPOS(3,IPART)=SUP
+          RODPOS(4,IPART)=SUP+DELTA
+          SUP=RODPOS(4,IPART)
+        ELSE IF((ITOP.EQ.-1).AND.(IMODE.EQ.2)) THEN
+          DELTA=RODPOS(4,IPART)-RODPOS(3,IPART)
+          RODPOS(4,IPART)=SUP
+          RODPOS(3,IPART)=SUP-DELTA
+          SUP=RODPOS(3,IPART)
+        ENDIF
+*----
+*  Z-AXIS MOVEMENT
+*----
+      ELSE IF(IAXIS.EQ.3) THEN
+        IF((ITOP.EQ.1).AND.(IMODE.EQ.1)) THEN
+          RODPOS(5,IPART)=MAX(RODPOS(5,IPART),LENG(2)-DELH)
+          RODPOS(5,IPART)=MIN(RODPOS(5,IPART),RODPOS(6,IPART))
+        ELSE IF((ITOP.EQ.-1).AND.(IMODE.EQ.1)) THEN
+          RODPOS(6,IPART)=MIN(RODPOS(6,IPART),LENG(1)+DELH)
+          RODPOS(6,IPART)=MAX(RODPOS(5,IPART),RODPOS(6,IPART))
+        ELSE IF((ITOP.EQ.1).AND.(IMODE.EQ.2)) THEN
+          DELTA=RODPOS(6,IPART)-RODPOS(5,IPART)
+          RODPOS(5,IPART)=SUP
+          RODPOS(6,IPART)=SUP+DELTA
+          SUP=RODPOS(6,IPART)
+        ELSE IF((ITOP.EQ.-1).AND.(IMODE.EQ.2)) THEN
+          DELTA=RODPOS(6,IPART)-RODPOS(5,IPART)
+          RODPOS(6,IPART)=SUP
+          RODPOS(5,IPART)=SUP-DELTA
+          SUP=RODPOS(5,IPART)
+        ENDIF
+      ENDIF
+*----
+*  PRINT NEW POSITION
+*----
+      IF(IMPX.GT.1) THEN
+        WRITE(IOUT,1001) IPART,RODPOS(1,IPART),RODPOS(3,IPART),
+     1         RODPOS(5,IPART),RODPOS(2,IPART),RODPOS(4,IPART),
+     2         RODPOS(6,IPART)
+        ENDIF
+   10 CONTINUE
+*----
+*  CONSISTENCY CHECK
+*----
+      LIMINF=0
+      IF(IMODE.EQ.2) THEN
+        IF(ITOP.EQ.-1) THEN
+          LIMINF=DELH-(LENG(2)-LENG(1))
+        ELSE IF(ITOP.EQ.1) THEN
+          LIMINF=DELH+(LENG(2)-LENG(1))
+        ENDIF
+        IF(ABS(SUP-LIMINF).GT.1.E-3) CALL XABORT('@MOVCHK: WRONG LENG'
+     1  //'TH OF ADJUSTER')
+      ENDIF
+      RETURN
+*
+ 1000 FORMAT(/5X,'MOVCHK: MOVE A ROD BY',F10.4)
+ 1001 FORMAT(
+     1 /5X,'MOVCHK: PART =',I5/
+     2  5X,'NEW ROD POSITION :'/
+     3  5X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4/
+     4  5X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4)
+      END
diff --git a/Donjon/src/MOVDEV.f b/Donjon/src/MOVDEV.f
new file mode 100644
index 0000000..ba36253
--- /dev/null
+++ b/Donjon/src/MOVDEV.f
@@ -0,0 +1,145 @@
+*DECK MOVDEV
+      SUBROUTINE MOVDEV(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Simulate the time-dependent displacement of individual devices
+* and/or of groups of devices in the reactor core.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The MOVDEV: module specification is:
+* DEVICE := MOVDEV: DEVICE :: (descmove) ;
+* where
+*   DEVICE : name of the \emph{device} object that will be modified by the 
+*     module. The rods positions are updated according to the current time step
+*     of movement.
+*   (descmove) : structure describing the input data to the MOVDEV: module.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(NSTATE=40,IOUT=6)
+      CHARACTER TEXT*12,HSIGN*12
+      INTEGER ISTATE(NSTATE),DGRP
+      DOUBLE PRECISION DFLOT
+*----
+*  PARAMETER VALIDATION
+*----
+      IF(NENTRY.GT.1)CALL XABORT('@MOVDEV: ONE PARAMETER EXPECTED.')
+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2))CALL XABORT('@MOV'
+     1 //'DEV: LCM OBJECT EXPECTED AT LHS.')
+      CALL LCMGTC(KENTRY(1),'SIGNATURE',12,HSIGN)
+      IF(HSIGN.NE.'L_DEVICE')THEN
+        TEXT=HENTRY(1)
+        CALL XABORT('@MOVDEV: SIGNATURE OF '//TEXT//' IS '//HSIGN//
+     1  '. L_DEVICE EXPECTED.')
+      ENDIF
+      IF(JENTRY(1).NE.1)CALL XABORT('@MOVDEV: MODIFICATION MODE EX'
+     1 //'PECTED FOR L_DEVICE.')
+*
+      CALL LCMGET(KENTRY(1),'STATE-VECTOR',ISTATE)
+      IGEO=ISTATE(1)
+      IF(IGEO.NE.7)CALL XABORT('@MOVDEV: ONLY 3D-CARTESIAN GEOMETR'
+     1 //'Y  ALLOWED.')
+      NDEV=ISTATE(2)
+      DGRP=ISTATE(3)
+      IMODE=ISTATE(6)
+      IF(IMODE.EQ.0)CALL XABORT('@MOVDEV: IMODE NOT SET.')
+*----
+*  RECOVER INFORMATION
+*----
+      IMPX=1
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('@MOVDEV: CHARACTER DATA EXPECTED.')
+      IF(TEXT.NE.'EDIT')GOTO 10
+*     PRINTING INDEX
+      CALL REDGET(ITYP,IMPX,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.1)CALL XABORT('@MOVDEV: INTEGER FOR EDIT EXPECTED.')
+*     TIME STEP INCREMENT
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+   10 IF(TEXT.NE.'DELT')CALL XABORT('@MOVDEV: KEYWORD DELT EXPECTED.')
+      CALL REDGET(ITYP,NITMA,DELT,TEXT,DFLOT)
+      IF(ITYP.NE.2)CALL XABORT('@MOVDEV: REAL FOR DELT EXPECTED.')
+      IF(DELT.LE.0.)CALL XABORT('@MOVDEV: VALUE OF DELT SHOULD B'
+     1 //'E POSITIVE.')
+      ND=0
+      NG=0
+   20 ND=ND+1
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(TEXT.EQ.'ROD')THEN
+*----
+*  ROD OPTION
+*----
+        CALL REDGET(ITYP,ID,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@MOVDEV: INTEGER ROD-ID NUMB'
+     1   //'ER EXPECTED.')
+        IF((ID.GT.NDEV).OR.(ID.EQ.0))THEN
+          WRITE(IOUT,*)'@MOVDEV: READ CURRENT ROD-ID #',ID
+          CALL XABORT('@MOVDEV: WRONG ROD-ID NUMBER.')
+        ENDIF
+        IF(IMPX.GT.0)WRITE(IOUT,1000)ID
+        CALL MOVPOS(KENTRY(1),IMODE,ID,DELT,IMPX)
+      ELSEIF(TEXT.EQ.'GROUP')THEN
+*----
+*  GROUP OPTION
+*----
+        CALL REDGET(ITYP,IGRP,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@MOVDEV: INTEGER GROUP-ID NUM'
+     1   //'BER EXPECTED.')
+        IF((IGRP.GT.DGRP).OR.(IGRP.EQ.0))THEN
+          WRITE(IOUT,*)'@MOVDEV: READ CURRENT GROUP-ID #',IGRP
+          CALL XABORT('@MOVDEV: WRONG GROUP-ID NUMBER.')
+        ENDIF
+        IF(IMPX.GT.0)WRITE(IOUT,1001)IGRP
+        CALL MOVGRP(KENTRY(1),IMODE,IGRP,NDGR,DELT,IMPX)
+        ND=ND+NDGR-1
+        NG=NG+1
+*
+      ELSEIF(TEXT.EQ.';')THEN
+        GOTO 30
+      ELSE
+        WRITE(IOUT,*)'@MOVDEV: WRONG KEYWORD : ',TEXT
+        CALL XABORT('@MOVDEV: KEYWORD ROD OR GROUP EXPECTED.')
+      ENDIF
+      GOTO 20
+   30 IF(IMPX.GT.0)WRITE(IOUT,1002)NG,ND-1
+      IF(IMPX.GT.4)CALL LCMLIB(KENTRY(1))
+      RETURN
+*
+ 1000 FORMAT(/5X,'MOVING ROD #',I3.3)
+ 1001 FORMAT(/5X,'MOVING GROUP #',I2.2)
+ 1002 FORMAT(
+     1 /5X,'-------------------------------------'/
+     2  5X,'TOTAL NUMBER OF DISPLACED GROUPS : ',I2/
+     3  5X,'TOTAL NUMBER OF DISPLACED RODS : ',I3/)
+      END
diff --git a/Donjon/src/MOVGRP.f b/Donjon/src/MOVGRP.f
new file mode 100644
index 0000000..2722369
--- /dev/null
+++ b/Donjon/src/MOVGRP.f
@@ -0,0 +1,194 @@
+*DECK MOVGRP
+      SUBROUTINE MOVGRP(IPDEV,IMODE,IGRP,NDGR,DELT,IMPX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Move a group of rod-devices to a new position in the reactor core.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki
+*
+*Parameters: input
+* IPDEV  pointer to device information.
+* IMODE  type of displacement: =1 for FADE; =2 for MOVE (DONJON3-type
+*        movement).
+* IGRP   current group number.
+* DELT   time step increment.
+* IMPX   printing index (=0 for no print).
+*
+*Parameters: output
+* NDGR   number of rods in the current group.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPDEV
+      INTEGER IMODE,IGRP,NDGR,IMPX
+      REAL DELT
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(IOUT=6,MAXPRT=10)
+      REAL MAXPOS(6,MAXPRT),RODPOS(6,MAXPRT),LENG(2),LVOLD,LVNEW,
+     1 LIMIT(6)
+      CHARACTER TEXT*12
+      DOUBLE PRECISION DFLOT
+      TYPE(C_PTR) JPDEV,KPDEV
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IDEV
+*----
+*  READ MOVEMENT DIRECTION
+*----
+      MOVE=0
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(TEXT.EQ.'INSR')THEN
+        MOVE=1
+      ELSEIF(TEXT.EQ.'EXTR')THEN
+        MOVE=-1
+      ELSE
+        CALL XABORT('@MOVGRP: KEYWORD INSR OR EXTR EXPECTED.')
+      ENDIF
+*----
+*  READ MOVEMENT OPTION
+*----
+      LVNEW=0.
+      IOPT=0
+      DELHIN=0.0
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(TEXT.EQ.'SPEED') THEN
+        CALL REDGET(ITYP,NITMA,SPEED,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@MOVGRP: REAL FOR SPEED EXPECTED.')
+        IF(SPEED.LE.0.)CALL XABORT('@MOVGRP: SPEED VALUE MUST BE > 0.')
+        IOPT=1
+      ELSEIF(TEXT.EQ.'DELH') THEN
+        CALL REDGET(ITYP,NITMA,DELHIN,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@MOVGRP: REAL FOR DELH EXPECTED.')
+        IF(DELHIN.LE.0.)CALL XABORT('@MOVGRP: DELH VALUE MUST BE > 0.')
+        IOPT=2
+      ELSEIF(TEXT.EQ.'LEVEL') THEN
+        CALL REDGET(ITYP,NITMA,LVNEW,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@MOVGRP: REAL FOR LEVEL EXPECTED.')
+        IF(LVNEW.GT.1.)CALL XABORT('@MOVGRP: WRONG LEVEL VALUE > 1.')
+        IF(LVNEW.LT.0.)CALL XABORT('@MOVGRP: WRONG LEVEL VALUE < 0.')
+        IOPT=3
+      ELSE
+        WRITE(IOUT,*)'@MOVGRP: WRONG KEYWORD : ',TEXT
+        CALL XABORT('@MOVGRP: ROD MOVEMENT OPTION EXPECTED.')
+      ENDIF
+*----
+*  RECOVER GROUP INFORMATION
+*----
+      JPDEV=LCMGID(IPDEV,'ROD_GROUP')
+      KPDEV=LCMGIL(JPDEV,IGRP)
+*     GROUP DATA
+      CALL LCMGET(KPDEV,'NUM-ROD',NDGR)
+      ALLOCATE(IDEV(NDGR))
+      IDEV(:NDGR)=0
+      CALL LCMGET(KPDEV,'ROD-ID',IDEV)
+*----
+*  MOVE ROD-DEVICES
+*----
+      DO I=1,NDGR
+        ID=IDEV(I)
+*       ROD PARAMETERS
+        JPDEV=LCMGID(IPDEV,'DEV_ROD')
+        KPDEV=LCMGIL(JPDEV,ID)
+        CALL LCMGET(KPDEV,'ROD-PARTS',NPART)
+        IF(NPART.GT.MAXPRT) CALL XABORT('MOVGRP: MAXPRT OVERFLOW.')
+        CALL LCMGET(KPDEV,'MAX-POS',MAXPOS)
+        CALL LCMLEN(KPDEV,'ROD-POS',ILONG,ITYLCM)
+        IF(ILONG.EQ.0) CALL XABORT('MOVGRP: UNDEFINED ROD POSITION.')
+        CALL LCMGET(KPDEV,'ROD-POS',RODPOS)
+        CALL LCMGET(KPDEV,'LENGTH',LENG)
+        CALL LCMGET(KPDEV,'LEVEL',LVOLD)
+        CALL LCMGET(KPDEV,'AXIS',IAXIS)
+        CALL LCMGET(KPDEV,'FROM',ITOP)
+*       PRINT OLD PARAMETERS
+        IF(IMPX.GT.1) WRITE(IOUT,1000) ID
+        IF(IMPX.GT.2) THEN
+          WRITE(IOUT,1001) LVOLD
+          DO 10 IPART=1,NPART
+          WRITE(IOUT,1002) IPART,RODPOS(1,IPART),RODPOS(3,IPART),
+     1           RODPOS(5,IPART),RODPOS(2,IPART),RODPOS(4,IPART),
+     2           RODPOS(6,IPART)
+   10     CONTINUE
+        ENDIF
+*       UPDATE POSITION
+        IF(IMODE.EQ.1) THEN
+*         FADING ROD
+          DELH0=LVOLD*(LENG(2)-LENG(1))
+          IF(IOPT.EQ.1)THEN
+            DELH=MIN(DELH0+MOVE*SPEED*DELT,LENG(2)-LENG(1))
+          ELSE IF(IOPT.EQ.2)THEN
+            DELH=MIN(DELH0+MOVE*DELHIN,LENG(2)-LENG(1))
+          ELSE IF(IOPT.EQ.3)THEN
+            DELH=LVNEW*(LENG(2)-LENG(1))
+          ENDIF
+          LVNEW=DELH/(LENG(2)-LENG(1))
+        ELSE IF(IMODE.EQ.2) THEN
+*         MOVING ROD
+          CALL LCMGET(IPDEV,'CORE-LIMITS',LIMIT)
+          IF(ITOP.EQ.-1) THEN
+            DELH0=LVOLD*(LENG(2)-LIMIT(1))+LIMIT(1)
+            IF(IOPT.EQ.1)THEN
+              DELH=DELH0+MOVE*SPEED*DELT
+            ELSE IF(IOPT.EQ.2)THEN
+              DELH=DELH0+MOVE*DELHIN
+            ELSE IF(IOPT.EQ.3)THEN
+              DELH=LVNEW*(LENG(2)-LIMIT(1))+LIMIT(1)
+            ENDIF
+            DELH=MIN(LIMIT(2),MAX(LIMIT(1),DELH))
+            LVNEW=(DELH-LIMIT(1))/(LENG(2)-LIMIT(1))
+          ELSE IF(ITOP.EQ.1) THEN
+            DELH0=LIMIT(2)-LVOLD*(LIMIT(2)-LENG(1))
+            IF(IOPT.EQ.1)THEN
+              DELH=DELH0-MOVE*SPEED*DELT
+            ELSE IF(IOPT.EQ.2)THEN
+              DELH=DELH0-MOVE*DELHIN
+            ELSE IF(IOPT.EQ.3)THEN
+              DELH=LIMIT(2)-LVNEW*(LIMIT(2)-LENG(1))
+            ENDIF
+            DELH=MIN(LIMIT(2),MAX(LIMIT(1),DELH))
+            LVNEW=(LIMIT(2)-DELH)/(LIMIT(2)-LENG(1))
+          ENDIF
+          IF(IMPX.GT.3) THEN
+            WRITE(IOUT,*) '    ADJ ',NXSEQ,' LEVEL ',LVNEW*100.,
+     1                    '% OF INSERTION'
+            WRITE(IOUT,*) '    NEW POSITION (L_sup)= ',DELH
+          ENDIF
+        ENDIF
+        IF((LVNEW.LT.0.0).OR.(LVNEW.GT.1.0)) THEN
+          WRITE(IOUT,'(/25H @MOVGRP: MOVE FROM DELH=,F8.3,3H TO,F8.3)')
+     1    DELH0,DELH
+          CALL XABORT('@MOVGRP: INVALID NEW VALUE OF LEVEL.')
+        ENDIF
+*       SET NEW POSITION
+        CALL LCMGET(KPDEV,'MAX-POS',RODPOS)
+        CALL MOVCHK(IMPX,IMODE,NPART,IAXIS,ITOP,DELH,LENG,RODPOS)
+*       STORE NEW PARAMETERS
+        CALL LCMPUT(KPDEV,'ROD-POS',6,2,RODPOS)
+        CALL LCMPUT(KPDEV,'LEVEL',1,2,LVNEW)
+*       PRINT UPDATED LEVEL
+        IF(IMPX.GT.1) WRITE(IOUT,1003) LVNEW
+*     PROCEED NEXT ROD
+      ENDDO
+      DEALLOCATE(IDEV)
+      RETURN
+*
+ 1000 FORMAT(/5X,' MOVGRP: => MOVING ROD #',I3.3)
+ 1001 FORMAT(
+     1 /5X,'MOVGRP:PREVIOUS INSERTION LEVEL =',F8.4)
+ 1002 FORMAT(
+     1 /5X,'MOVGRP:PART =',I5/
+     2  5X,'PREVIOUS ROD POSITION :'/
+     3  5X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4/
+     4  5X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4)
+ 1003 FORMAT(
+     1 /5X,'MOVGRP:NEW INSERTION LEVEL =',F8.4)
+      END
diff --git a/Donjon/src/MOVPOS.f b/Donjon/src/MOVPOS.f
new file mode 100644
index 0000000..5c15d6d
--- /dev/null
+++ b/Donjon/src/MOVPOS.f
@@ -0,0 +1,174 @@
+*DECK MOVPOS
+      SUBROUTINE MOVPOS(IPDEV,IMODE,ID,DELT,IMPX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Read the movement option and displace an individual rod to a new
+* position in the reactor core.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki
+*
+*Parameters: input
+* IPDEV  pointer to device information.
+* IMODE  type of displacement: =1 for FADE; =2 for MOVE (DONJON3-type
+*        movement).
+* ID     current rod identification number.
+* DELT   time step increment.
+* IMPX   printing index (=0 for no print).
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPDEV
+      INTEGER IMODE,ID,IMPX
+      REAL DELT
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(IOUT=6,MAXPRT=10)
+      REAL MAXPOS(6,MAXPRT),RODPOS(6,MAXPRT),LENG(2),LVOLD,LVNEW,
+     1 LIMIT(6)
+      CHARACTER TEXT*12
+      DOUBLE PRECISION DFLOT
+      TYPE(C_PTR) JPDEV,KPDEV
+*----
+*  RECOVER INFORMATION
+*----
+      JPDEV=LCMGID(IPDEV,'DEV_ROD')
+      KPDEV=LCMGIL(JPDEV,ID)
+*     ROD PARAMETERS
+      CALL LCMGET(KPDEV,'ROD-PARTS',NPART)
+      IF(NPART.GT.MAXPRT) CALL XABORT('MOVPOS: MAXPRT OVERFLOW.')
+      CALL LCMGET(KPDEV,'MAX-POS',MAXPOS)
+      CALL LCMLEN(KPDEV,'ROD-POS',ILONG,ITYLCM)
+      IF(ILONG.EQ.0) CALL XABORT('MOVPOS: UNDEFINED ROD POSITION.')
+      CALL LCMGET(KPDEV,'ROD-POS',RODPOS)
+      CALL LCMGET(KPDEV,'LENGTH',LENG)
+      CALL LCMGET(KPDEV,'LEVEL',LVOLD)
+      CALL LCMGET(KPDEV,'AXIS',IAXIS)
+      CALL LCMGET(KPDEV,'FROM',ITOP)
+*----
+*  READ MOVEMENT DIRECTION
+*----
+      MOVE=0
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(TEXT.EQ.'INSR')THEN
+        MOVE=1
+      ELSEIF(TEXT.EQ.'EXTR')THEN
+        MOVE=-1
+      ELSE
+        CALL XABORT('@MOVPOS: KEYWORD INSR OR EXTR EXPECTED.')
+      ENDIF
+*----
+*  READ MOVEMENT OPTION
+*----
+      LVNEW=0.
+      IOPT=0
+      DELHIN=0.0
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(TEXT.EQ.'SPEED') THEN
+        CALL REDGET(ITYP,NITMA,SPEED,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@MOVPOS: REAL FOR SPEED EXPECTED.')
+        IF(SPEED.LE.0.)CALL XABORT('@MOVPOS: SPEED VALUE MUST BE > 0.')
+        IOPT=1
+      ELSEIF(TEXT.EQ.'DELH') THEN
+        CALL REDGET(ITYP,NITMA,DELHIN,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@MOVPOS: REAL FOR DELH EXPECTED.')
+        IF(DELHIN.LE.0.)CALL XABORT('@MOVPOS: DELH VALUE MUST BE > 0.')
+        IOPT=2
+      ELSEIF(TEXT.EQ.'LEVEL') THEN
+        CALL REDGET(ITYP,NITMA,LVNEW,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@MOVPOS: REAL FOR LEVEL EXPECTED.')
+        IF(LVNEW.GT.1.)CALL XABORT('@MOVPOS: WRONG LEVEL VALUE > 1.')
+        IF(LVNEW.LT.0.)CALL XABORT('@MOVPOS: WRONG LEVEL VALUE < 0.')
+        IOPT=3
+      ELSE
+        WRITE(IOUT,*)'@MOVPOS: WRONG KEYWORD ',TEXT
+        CALL XABORT('@MOVPOS: ROD MOVEMENT OPTION EXPECTED.')
+      ENDIF
+*----
+*  NEW ROD POSITION
+*----
+      IF(IMODE.EQ.1) THEN
+        DELH0=LVOLD*(LENG(2)-LENG(1))
+        IF(IOPT.EQ.1)THEN
+          DELH=MIN(DELH0+MOVE*SPEED*DELT,LENG(2)-LENG(1))
+        ELSE IF(IOPT.EQ.2)THEN
+          DELH=MIN(DELH0+MOVE*DELHIN,LENG(2)-LENG(1))
+        ELSE IF(IOPT.EQ.3)THEN
+          DELH=LVNEW*(LENG(2)-LENG(1))
+        ENDIF
+        LVNEW=DELH/(LENG(2)-LENG(1))
+      ELSE IF(IMODE.EQ.2) THEN
+        CALL LCMGET(IPDEV,'CORE-LIMITS',LIMIT)
+        IF(ITOP.EQ.-1) THEN
+          DELH0=LVOLD*(LENG(2)-LIMIT(1))+LIMIT(1)
+          IF(IOPT.EQ.1)THEN
+            DELH=DELH0+MOVE*SPEED*DELT
+          ELSE IF(IOPT.EQ.2)THEN
+            DELH=DELH0+MOVE*DELHIN
+          ELSE IF(IOPT.EQ.3)THEN
+            DELH=LVNEW*(LENG(2)-LIMIT(1))+LIMIT(1)
+          ENDIF
+          DELH=MIN(LIMIT(2),MAX(LIMIT(1),DELH))
+          LVNEW=(DELH-LIMIT(1))/(LENG(2)-LIMIT(1))
+        ELSE IF(ITOP.EQ.1) THEN
+          DELH0=LIMIT(2)-LVOLD*(LIMIT(2)-LENG(1))
+          IF(IOPT.EQ.1)THEN
+            DELH=DELH0-MOVE*SPEED*DELT
+          ELSE IF(IOPT.EQ.2)THEN
+            DELH=DELH0-MOVE*DELHIN
+          ELSE IF(IOPT.EQ.3)THEN
+            DELH=LIMIT(2)-LVNEW*(LIMIT(2)-LENG(1))
+          ENDIF
+          DELH=MIN(LIMIT(2),MAX(LIMIT(1),DELH))
+          LVNEW=(LIMIT(2)-DELH)/(LIMIT(2)-LENG(1))
+        ENDIF
+        IF(IMPX.GT.3) THEN
+          WRITE(IOUT,*) '    ADJ ',NXSEQ,' LEVEL ',LVNEW*100.,
+     1                  '% OF INSERTION'
+          WRITE(IOUT,*) '    NEW POSITION (L_sup)= ',DELH
+        ENDIF
+      ENDIF
+      IF((LVNEW.LT.0.0).OR.(LVNEW.GT.1.0)) THEN
+        WRITE(IOUT,'(/25H @MOVPOS: MOVE FROM DELH=,F8.3,3H TO,F8.3)')
+     1  DELH0,DELH
+        CALL XABORT('@MOVPOS: INVALID NEW VALUE OF LEVEL.')
+      ENDIF
+*     PRINT OLD PARAMETERS
+      IF(IMPX.GT.2) THEN
+        WRITE(IOUT,1001) LVOLD
+        DO 10 IPART=1,NPART
+        WRITE(IOUT,1002) IPART,RODPOS(1,IPART),RODPOS(3,IPART),
+     1         RODPOS(5,IPART),RODPOS(2,IPART),RODPOS(4,IPART),
+     2         RODPOS(6,IPART)
+   10   CONTINUE
+      ENDIF
+*     SET NEW POSITION
+      CALL LCMGET(KPDEV,'MAX-POS',RODPOS)
+      CALL MOVCHK(IMPX,IMODE,NPART,IAXIS,ITOP,DELH,LENG,RODPOS)
+*     STORE NEW PARAMETERS
+      CALL LCMPUT(KPDEV,'ROD-POS',6,2,RODPOS)
+      CALL LCMPUT(KPDEV,'LEVEL',1,2,LVNEW)
+*     PRINT UPDATED LEVEL
+      IF(IMPX.GT.1) WRITE(IOUT,1003) LVNEW
+      RETURN
+*
+ 1001 FORMAT(
+     1 /5X,'MOVPOS: PREVIOUS INSERTION LEVEL =',F8.4)
+ 1002 FORMAT(
+     1 /5X,'MOVPOS: PART =',I5/
+     2  5X,'PREVIOUS ROD POSITION :'/
+     3  5X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4/
+     4  5X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4)
+ 1003 FORMAT(
+     1 /5X,'MOVPOS: NEW INSERTION LEVEL =',F8.4)
+      END
diff --git a/Donjon/src/Makefile b/Donjon/src/Makefile
new file mode 100644
index 0000000..f236c5e
--- /dev/null
+++ b/Donjon/src/Makefile
@@ -0,0 +1,241 @@
+#---------------------------------------------------------------------------
+#
+#  Makefile for building the Donjon library and load module
+#  Author : A. Hebert (2018-5-10)
+#
+#---------------------------------------------------------------------------
+#
+ARCH = $(shell uname -m)
+ifneq (,$(filter $(ARCH),aarch64 arm64))
+  nbit =
+else
+  ifneq (,$(filter $(ARCH),i386 i686))
+    nbit = -m32
+  else
+    nbit = -m64
+  endif
+endif
+
+DIRNAME = $(shell uname -sm | sed 's/[ ]/_/')
+OS = $(shell uname -s | cut -d"_" -f1)
+opt = -O -g
+PREPRO = cpp
+ifeq ($(openmp),1)
+  COMP = -fopenmp
+  PREPRO = cpp -D_OPENMP
+else
+  COMP =
+endif
+
+ifeq ($(intel),1)
+  fcompiler = ifort
+  ccompiler = icc
+else
+  ifeq ($(nvidia),1)
+    fcompiler = nvfortran
+    ccompiler = nvc
+  else
+    ifeq ($(llvm),1)
+      fcompiler = flang-new
+      ccompiler = clang
+    else
+      fcompiler = gfortran
+      ccompiler = gcc
+    endif
+  endif
+endif
+
+ifeq ($(OS),AIX)
+  python_version_major := 2
+else
+  python_version_full := $(wordlist 2,4,$(subst ., ,$(shell python --version 2>&1)))
+  python_version_major := $(word 1,${python_version_full})
+  ifneq ($(python_version_major),2)
+    python_version_major := 3
+  endif
+endif
+
+ifeq ($(OS),Darwin)
+  ifeq ($(openmp),1)
+    ccompiler = gcc-14
+  endif
+  F90 = $(fcompiler)
+  C = $(ccompiler)
+  FLAGS = -DLinux -DUnix
+  CFLAGS = -Wall $(nbit) -fPIC
+  FFLAGS = $(nbit) -fPIC
+  FFLAG77 = $(nbit) -fPIC
+  LFLAGS = $(nbit)
+else
+ifeq ($(OS),Linux)
+  F90 = $(fcompiler)
+  C = $(ccompiler)
+  FLAGS = -DLinux -DUnix
+  CFLAGS = -Wall $(nbit) -fPIC
+  FFLAGS = $(nbit) -fPIC
+  FFLAG77 = $(nbit) -fPIC
+  LFLAGS = $(nbit)
+else
+ifeq ($(OS),CYGWIN)
+  F90 = $(fcompiler)
+  C = $(ccompiler)
+  FLAGS = -DLinux -DUnix
+  CFLAGS = -Wall $(nbit) -fPIC
+  FFLAGS = $(nbit) -fPIC
+  FFLAG77 = $(nbit) -fPIC
+  LFLAGS = $(nbit)
+else
+ifeq ($(OS),SunOS)
+  fcompiler =
+  MAKE = gmake
+  F90 = f90
+  C = cc
+  PREPRO = /usr/lib/cpp
+  FLAGS = -DSunOS -DUnix
+  CFLAGS = $(nbit)
+  FFLAGS = $(nbit) -s -ftrap=%none
+  FFLAG77 = $(nbit) -s -ftrap=%none
+  LFLAGS = $(nbit)
+else
+ifeq ($(OS),AIX)
+  fcompiler =
+  opt = -O4
+  MAKE = gmake
+  DIRNAME = AIX
+  F90 = xlf90
+  C = cc
+  FLAGS = -DAIX -DUnix
+  CFLAGS = -qstrict
+  FFLAGS = -qstrict -qmaxmem=-1 -qsuffix=f=f90
+  FFLAG77 = -qstrict -qmaxmem=-1 -qxlf77=leadzero -qfixed
+  LFLAGS = -qstrict -bmaxdata:0x80000000 -qipa
+else
+  $(error $(OS) is not a valid OS)
+endif
+endif
+endif
+endif
+endif
+ifeq ($(fcompiler),gfortran)
+  ifneq (,$(filter $(ARCH),i386 i686 x86_64))
+    summary =
+  else
+    summary = -ffpe-summary=none
+  endif
+  ifeq ($(OS),Darwin)
+    summary = -ffpe-summary=none
+  endif
+  FFLAGS += -Wall $(summary)
+  FFLAG77 += -Wall -frecord-marker=4 $(summary)
+endif
+
+ifeq ($(intel),1)
+  FFLAGS = -fPIC
+  FFLAG77 = -fPIC
+  lib = ../lib/$(DIRNAME)_intel
+  libUtl = ../../Utilib/lib/$(DIRNAME)_intel
+  libGan = ../../Ganlib/lib/$(DIRNAME)_intel
+  libTri = ../../Trivac/lib/$(DIRNAME)_intel
+  libDra = ../../Dragon/lib/$(DIRNAME)_intel
+  bin = ../bin/$(DIRNAME)_intel
+  lib_module = ../lib/$(DIRNAME)_intel/modules
+  INCLUDE = -I../../Ganlib/lib/$(DIRNAME)_intel/modules/ -I../../Utilib/lib/$(DIRNAME)_intel/modules/
+else
+  ifeq ($(nvidia),1)
+    lib = ../lib/$(DIRNAME)_nvidia
+    libUtl = ../../Utilib/lib/$(DIRNAME)_nvidia
+    libGan = ../../Ganlib/lib/$(DIRNAME)_nvidia
+    libTri = ../../Trivac/lib/$(DIRNAME)_nvidia
+    libDra = ../../Dragon/lib/$(DIRNAME)_nvidia
+    bin = ../bin/$(DIRNAME)_nvidia
+    lib_module = ../lib/$(DIRNAME)_nvidia/modules
+    INCLUDE = -I../../Ganlib/lib/$(DIRNAME)_nvidia/modules/ -I../../Utilib/lib/$(DIRNAME)_nvidia/modules/
+  else
+    ifeq ($(llvm),1)
+      lib = ../lib/$(DIRNAME)_llvm
+      libUtl = ../../Utilib/lib/$(DIRNAME)_llvm
+      libGan = ../../Ganlib/lib/$(DIRNAME)_llvm
+      libTri = ../../Trivac/lib/$(DIRNAME)_llvm
+      libDra = ../../Dragon/lib/$(DIRNAME)_llvm
+      bin = ../bin/$(DIRNAME)_llvm
+      lib_module = ../lib/$(DIRNAME)_llvm/modules
+      INCLUDE = -I../../Ganlib/lib/$(DIRNAME)_llvm/modules/ -I../../Utilib/lib/$(DIRNAME)_llvm/modules/
+      FFLAGS += -mmlir -fdynamic-heap-array
+      LFLAGS += -lclang_rt.osx
+    else
+      lib = ../lib/$(DIRNAME)
+      libUtl = ../../Utilib/lib/$(DIRNAME)
+      libGan = ../../Ganlib/lib/$(DIRNAME)
+      libTri = ../../Trivac/lib/$(DIRNAME)
+      libDra = ../../Dragon/lib/$(DIRNAME)
+      bin = ../bin/$(DIRNAME)
+      lib_module = ../lib/$(DIRNAME)/modules
+      INCLUDE = -I../../Ganlib/lib/$(DIRNAME)/modules/ -I../../Utilib/lib/$(DIRNAME)/modules/
+    endif
+  endif
+endif
+
+ifeq ($(hdf5),1)
+  FLAGS += -DHDF5_LIB -I${HDF5_INC}
+  FFLAGS += -I${HDF5_INC}
+  LFLAGS += -L${HDF5_API} -lhdf5
+endif
+
+SRCC = $(shell ls *.c)
+SRC77 = $(shell ls *.f)
+SRCF77 = $(shell ls *.F)
+ifeq ($(python_version_major),2)
+  SRC90 = $(shell python ../../script/make_depend.py *.f90)
+else
+  SRC90 = $(shell python3 ../../script/make_depend_py3.py *.f90)
+endif
+OBJC = $(SRCC:.c=.o)
+OBJ90 = $(SRC90:.f90=.o)
+OBJ77 = $(SRC77:.f=.o)
+OBJF77 = $(SRCF77:.F=.o)
+all : sub-make Donjon
+ifeq ($(openmp),1)
+	@echo 'Donjon: openmp is defined'
+endif
+ifeq ($(intel),1)
+	@echo 'Donjon: intel is defined'
+endif
+ifeq ($(nvidia),1)
+	@echo 'Donjon: nvidia is defined'
+endif
+ifeq ($(llvm),1)
+	@echo 'Donjon: llvm is defined'
+endif
+ifeq ($(hdf5),1)
+	@echo 'Donjon: hdf5 is defined'
+endif
+sub-make:
+	$(MAKE) openmp=$(openmp) intel=$(intel) nvidia=$(nvidia) llvm=$(llvm) hdf5=$(hdf5) -C ../../Dragon/src
+%.o : %.c
+	$(C) $(CFLAGS) $(opt) $(COMP) -c $< -o $@
+%.o : %.f90
+	$(F90) $(FFLAGS) $(opt) $(COMP) $(INCLUDE) -c $< -o $@
+%.o : %.f
+	@/bin/rm -f temp.f
+	$(F90) $(FFLAG77) $(opt) $(COMP) $(INCLUDE) -c $< -o $@
+%.o : %.F
+	$(PREPRO) -P -W -traditional  $(FLAGS) $< temp.f
+	$(F90) $(FFLAG77) $(opt) $(COMP) $(INCLUDE) -c temp.f -o $@
+	/bin/rm temp.f
+$(lib_module)/:
+	mkdir -p $(lib_module)/
+$(lib)/: $(lib_module)/
+	mkdir -p $(lib)/
+libDonjon.a: $(OBJC) $(OBJ90) $(OBJ77) $(OBJF77) $(lib)/
+	ar r $@ $(OBJC) $(OBJ90) $(OBJ77) $(OBJF77)
+	cp $@ $(lib)/$@
+	cp *.mod $(lib_module)
+$(bin)/:
+	mkdir -p $(bin)/
+Donjon: libDonjon.a DONJON.o $(bin)/ sub-make
+	$(F90) $(opt) $(COMP) DONJON.o $(lib)/libDonjon.a $(libDra)/libDragon.a \
+	$(libTri)/libTrivac.a $(libUtl)/libUtilib.a $(libGan)/libGanlib.a $(LFLAGS) -o Donjon
+	cp $@ $(bin)/$@
+clean:
+	$(MAKE) -C ../../Dragon/src clean
+	/bin/rm -f *.o *.mod *.a sub-make temp.* Donjon
diff --git a/Donjon/src/NAP.f b/Donjon/src/NAP.f
new file mode 100644
index 0000000..5f0c48b
--- /dev/null
+++ b/Donjon/src/NAP.f
@@ -0,0 +1,206 @@
+*DECK NAP

+      SUBROUTINE NAP(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* - Construct an 'enriched' multicompo with additional information  

+* needed by Pin Power Reconstruction.

+* - Performed the Pin Power Reconstruction

+* - Split geometry from homogeneous to heterogeneous assemblies

+*     Note : this function is also called directly from the RESINI: module

+*

+*Copyright:

+* Copyright (C) 2014 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* R. Chambon

+*

+*Parameters: input

+* NENTRY  number of data structures transfered to this module.

+* HENTRY  name of the data structures.

+* IENTRY  data structure type where:

+*         IENTRY=1 for LCM memory object;

+*         IENTRY=2 for XSM file;

+*         IENTRY=3 for sequential binary file;

+*         IENTRY=4 for sequential ASCII file.

+* JENTRY  access permission for the data structure where:

+*         JENTRY=0 for a data structure in creation mode;

+*         JENTRY=1 for a data structure in modifications mode;

+*         JENTRY=2 for a data structure in read-only mode.

+* KENTRY  data structure pointer.

+*

+*Comments:

+* The NAP: calling specifications are:

+* Option 1: 

+* COMPO := NAP: COMPO TRKNAM FLUNAM :: (descnap1) ;

+* Option 2: 

+* MAP := NAP: MAP TRKNAM FLUNAM MATEX MACRES :: (descnap2) ;

+* Option 3: 

+* GEONEW := NAP: GEOOLD COMPO :: (descnap3) ;

+* where

+*   COMPO : name of the \emph{multicompo} data structure (L\_COMPO signature) 

+*     where the detailed subregion properties will be stored.

+*   TRKNAM : name of the read-only \emph{tracking} data structure 

+*     (L\_TRACK signature) containing the tracking. 

+*   FLUNAM : name of the read-only \emph{fluxunk} data structure 

+*     (L\_FLUX signature) containing a transport solution.

+*   MAP : name of the \emph{map} data structure (L\_MAP signature) containing 

+*     fuel regions description, global and local parameter information (burnup, 

+*     fuel/coolant temperatures, coolant density, etc). A previous call to the 

+*     FLPOW: module is highly recommended prior to the pin-power reconstruction 

+*     to normalize the flux and compute the assembly power. If not, the 

+*     pin-power reconstruction  will be normalized using the whole core power 

+*     instead of a normalization for each assembly.

+*   MATEX : name of the read-only \emph{matex} data structure 

+*     (L\_MATEX signature). The object corresponds to the heterogeneously 

+*     splited geometry.

+*   MACRES : name of the read-only \emph{macrolib} data structure 

+*     (L\_MACROLIB signature) containing a cross section for the fuel. The 

+*     \emph{macrolib} data structure must have been created with a 

+*     \emph{multicompo} data structure with pin level properties (transport 

+*     flux, H-factor, infinite domain diffusion flux).

+*   GEONEW : name of the created \emph{geometry} data structure 

+*     (L\_GEOM signature) containing the detailed core geometry definition at 

+*     heterogeneous assembly level.

+*   GEOOLD : name of the read-only \emph{geometry} data structure 

+*     (L\_GEOM signature) containing the core geometry definition with 

+*     homogeneous assembly (only 1 mesh per assembly mandatory).

+*   (descnap1) : structure containing the input data to this module to compute 

+*     additional properties for subregions

+*   (descnap2) : structure containing the input data to this module to perform 

+*     pin power reconstruction

+*   (descnap3) : structure containing the input data to this module to 

+*     automatically define the core geometry with heterogeneous assembly

+*

+*-----------------------------------------------------------------------

+*

+      USE GANLIB

+      IMPLICIT NONE

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)

+      TYPE(C_PTR)  KENTRY(NENTRY)

+      CHARACTER    HENTRY(NENTRY)*12

+*----

+*  LOCAL VARIABLES

+*----

+      INTEGER IOUT,MAXPAR,MAXLIN,MAXVAL,NSTATE,MAXADD

+      REAL REPS

+      PARAMETER (REPS=1.0E-4,IOUT=6,MAXPAR=50,MAXLIN=50,MAXVAL=200,

+     1 NSTATE=40,MAXADD=10)

+      TYPE(C_PTR) IPCPO,IPFLU,IPTRK,IPMAP,IPMTX,IPGNW,IPGOD,IPMPP,IPMAC

+      CHARACTER TEXT*12,HSIGN*12

+      INTEGER KCHAR(3)

+      INTEGER IEN,I

+      LOGICAL ldebug

+

+      IPMAP=C_NULL_PTR

+      IPMTX=C_NULL_PTR

+      IPGNW=C_NULL_PTR

+      IPGOD=C_NULL_PTR

+      IPCPO=C_NULL_PTR

+      IPMPP=C_NULL_PTR

+      IPMAC=C_NULL_PTR

+      

+      ldebug=.false.

+      if(ldebug)write(6,*) 'NAP begin debug'

+*----

+*  PARAMETER VALIDATION

+*----

+      IF(NENTRY.LE.2)CALL XABORT('@NAP: AT LEAST 3 PARAMETERS'

+     > //' EXPECTED.')

+      

+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2))CALL XABORT('@NAP'

+     1 //': LCM OBJECT EXPECTED AT LHS.')

+* NAPGEO

+      if(ldebug)write(6,*) 'NAP begin NAPGEO'

+      IF(JENTRY(1).EQ.0) THEN 

+        IPGNW=KENTRY(1)

+        DO IEN=2,3

+          IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2))CALL XABORT('@NAP'

+     1     //': LCM OBJECT EXPECTED AT RHS.')

+          CALL LCMGET(KENTRY(IEN),'SIGNATURE',KCHAR)

+          WRITE(HSIGN,'(3A4)') (KCHAR(I),I=1,3)

+          IF(HSIGN.EQ.'L_GEOM')THEN

+            IPGOD=KENTRY(IEN)

+          ELSEIF(HSIGN.EQ.'L_MULTICOMPO')THEN

+            IPCPO=KENTRY(IEN)

+          ELSE

+              CALL XABORT('@NAP: COMPO OR GEOM OBJECT EXPECTED.')

+          ENDIF

+        ENDDO

+        GOTO 3000

+      ENDIF

+* NAPCPO + NAPPPR

+      if(ldebug)write(6,*) 'NAP begin NAPCPO + NAPPPR'

+      CALL LCMGET(KENTRY(1),'SIGNATURE',KCHAR)

+      WRITE(HSIGN,'(3A4)') (KCHAR(I),I=1,3)

+      IF(HSIGN.EQ.'L_MULTICOMPO')THEN

+        IPCPO=KENTRY(1)

+      ELSEIF(HSIGN.EQ.'L_MAP')THEN

+        IPMAP=KENTRY(1)

+      ELSE

+        CALL XABORT('@NAP: L_MULTICOMPO or L_MAP EXPECTED.')

+      ENDIF

+      DO 5 IEN=2,3

+        IF((IENTRY(IEN).NE.1).AND.(IENTRY(IEN).NE.2))CALL XABORT('@N'

+     1 //'AP: LCM OBJECT EXPECTED AT RHS.')

+        IF(JENTRY(IEN).NE.2)CALL XABORT('@NAP: LCM OBJECT IN READ-ON'

+     1 //'LY MODE EXPECTED AT RHS.')

+        CALL LCMGET(KENTRY(IEN),'SIGNATURE',KCHAR)

+        WRITE(HSIGN,'(3A4)') (KCHAR(I),I=1,3)

+        IF(HSIGN.EQ.'L_FLUX')THEN

+          IPFLU=KENTRY(IEN)

+        ELSEIF(HSIGN.EQ.'L_TRACK')THEN

+          IPTRK=KENTRY(IEN)

+        ELSE

+            CALL XABORT('@NAP: FLUX OR TRACKING OBJECT EXPECTED.')

+        ENDIF

+    5 CONTINUE

+      IF(NENTRY.EQ.3) GOTO 1000

+* NAPPPR

+      if(ldebug)write(6,*) 'NAP begin NAPPPR'

+      DO 7 IEN=4,NENTRY

+        IF((IENTRY(IEN).NE.1).AND.(IENTRY(IEN).NE.2))CALL XABORT('@N'

+     1   //'AP: LCM OBJECT EXPECTED AT RHS.')

+        IF(JENTRY(IEN).NE.2)CALL XABORT('@NAP: LCM OBJECT IN READ-ON'

+     1   //'LY MODE EXPECTED AT RHS.')

+        CALL LCMGET(KENTRY(IEN),'SIGNATURE',KCHAR)

+        WRITE(HSIGN,'(3A4)') (KCHAR(I),I=1,3)

+C        IF(HSIGN.EQ.'L_MAP')THEN

+C          IPMPP=KENTRY(IEN)

+C        ELSEIF((HSIGN.EQ.'L_MATEX'))THEN

+        IF((HSIGN.EQ.'L_MATEX'))THEN

+          IPMTX=KENTRY(IEN)

+        ELSEIF((HSIGN.EQ.'L_MACROLIB'))THEN

+          IPMAC=KENTRY(IEN)

+        ELSE

+          TEXT=HENTRY(IEN)

+          CALL XABORT('@NAP: SIGNATURE OF '//TEXT//' IS '//HSIGN//

+     1    '. L_MATEX or L_MACROLIB EXPECTED.')

+        ENDIF

+    7 CONTINUE

+      GOTO 2000

+*----

+*  enriched L_MULTICOMPO  computation

+*----

+ 1000 CALL NAPCPO(IPCPO,IPTRK,IPFLU,NSTATE)

+      GOTO 9000

+*----

+*  Pin Power Reconstruction

+*----

+ 2000 CALL NAPPPR(IPMAP,IPTRK,IPFLU,IPMTX,IPMAC,NSTATE)

+      GOTO 9000

+*----

+*  Automatic geometry unfolding

+*----

+ 3000 CALL NAPGEO(IPGNW,IPGOD,IPCPO,NSTATE)

+      GOTO 9000

+*----

+* END

+*----

+*

+ 9000 RETURN

+      END

diff --git a/Donjon/src/NAPCPO.f b/Donjon/src/NAPCPO.f
new file mode 100644
index 0000000..74efe96
--- /dev/null
+++ b/Donjon/src/NAPCPO.f
@@ -0,0 +1,602 @@
+*DECK NAPCPO

+      SUBROUTINE NAPCPO(IPCPO,IPTRK,IPFLU,NSTATE)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Construct an 'enriched' multicompo with additional information  

+* needed by Pin Power Reconstruction.

+*

+*Copyright:

+* Copyright (C) 2014 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* R. Chambon

+*

+*Parameters: input/output

+* IPCPO   LCM object address of Multicompo.

+* IPTRK   LCM object address of Tracking.

+* IPFLU   LCM object address of Flux.

+* NSTATE  length of the state vector

+*

+*-----------------------------------------------------------------------

+*

+      USE GANLIB

+      IMPLICIT NONE

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      INTEGER      NSTATE

+      TYPE(C_PTR)  IPCPO,IPTRK,IPFLU

+*----

+*  LOCAL VARIABLES

+*----

+      INTEGER NCRCAL,NGPT

+      INTEGER IOUT,MAXPAR,MAXLIN,MAXVAL,MAXADD,MAXIFX

+      REAL REPS

+      PARAMETER (REPS=1.0E-4,IOUT=6,MAXPAR=50,MAXLIN=50,MAXVAL=200,

+     1 MAXADD=10,MAXIFX=5,NGPT=2)

+      CHARACTER PARKEY(MAXPAR)*12,PARFMT(MAXPAR)*8,RECNAM*12,

+     1  COMMEN(MAXLIN)*80,PARKEL(MAXPAR)*12,VALH(MAXPAR)*12

+      TYPE(C_PTR) JPCPO,KPCPO,LPCPO,JPMIC,JPFLU

+      CHARACTER TEXT*12,HSMG*131,DIRHOM*12,VCHAR(MAXVAL)*12,HVECT*8

+      INTEGER ISTATE(NSTATE),NPAR,NLOC,IMPX,IEL,NFDI,FINF(MAXIFX)

+      INTEGER IPAR,IBMOLD,IFX

+      REAL FLOT

+      DOUBLE PRECISION DFLOT

+      INTEGER VALI(MAXPAR),NVALUE(MAXPAR),VINTE(MAXVAL),

+     1 MUPLET(2*MAXPAR)

+      REAL VALR(2*MAXPAR,2),VREAL(MAXVAL),NVPO(2),PTR,PDF,PDF2

+      REAL ZGKSIX(NGPT),ZGKSIY(NGPT),WGKSIX(NGPT), WGKSIY(NGPT),

+     1 FLUGP(NGPT,NGPT),FPD,DX,DY

+      INTEGER NGFF,NXP,NYP,ITYPGP,NMIXP,NMIL,NG,NCOMLI,MAXNVP,STYPP,

+     1 NMCAL

+      INTEGER I,J,ICAL,INDIC,ITYLCM,IX,IY,LENGTH,NITMA,IREG,IREGP,IG,

+     1 IMIXP,ID,JD,IGP,JGP,IP,JP,J1,ICHX,IDIM,LC,L4,MAXKN,MKN

+      INTEGER NREG,NUN,NXD,NYD,ITYPGD,NREGP

+      REAL E(25)

+      LOGICAL LNOINT,FLAG

+*----

+*  ALLOCATABLE ARRAYS

+*----

+      INTEGER, ALLOCATABLE, DIMENSION(:) :: MIXP

+      REAL, ALLOCATABLE, DIMENSION(:) :: MXP,MYP,KN

+      REAL, ALLOCATABLE, DIMENSION(:) :: MXD,MYD,XX,YY

+      INTEGER, ALLOCATABLE, DIMENSION(:) :: KEYFLX,MATCOD,IXPD,

+     1  IYPD,JDEBAR,JARBVA

+      REAL, ALLOCATABLE, DIMENSION(:) :: FLXD

+      REAL, ALLOCATABLE, DIMENSION(:,:) :: FLXP,FT,FXTD,FYTD

+      LOGICAL, ALLOCATABLE, DIMENSION(:) :: FLAGMX

+*

+      IMPX=0

+      CALL REDGET(INDIC,NITMA,FLOT,TEXT,DFLOT)

+      IF(INDIC.NE.3) CALL XABORT('NAPCPO: character data expected.')

+      IF(TEXT.EQ.'EDIT') THEN

+        CALL REDGET(INDIC,IMPX,FLOT,TEXT,DFLOT)

+        IF(INDIC.NE.1) CALL XABORT('NAPCPO: integer data expected.')

+        CALL REDGET(INDIC,NITMA,FLOT,TEXT,DFLOT)

+        IF(INDIC.NE.3) CALL XABORT('NAPCPO: character data expected.')

+      ENDIF

+      IF(TEXT.NE.'PROJECTION') CALL XABORT('NAPCPO: ''PROJECTION'' '//

+     1  'EXPECTED.')

+      CALL REDGET(INDIC,NITMA,FLOT,TEXT,DFLOT)

+      IF(TEXT.NE.'STEP') CALL XABORT('NAPCPO: ''STEP'' '//

+     1  'EXPECTED.')

+      CALL REDGET(INDIC,NITMA,FLOT,DIRHOM,DFLOT)

+      IF(INDIC.NE.3) CALL XABORT('NAPCPO: character data expected.')

+      CALL LCMSIX(IPCPO,DIRHOM,1)

+*      

+      IFX=1

+      LNOINT=.FALSE.

+      FINF(:MAXIFX)=-1

+*----

+*  RECOVER TABLE-OF-CONTENT INFORMATION FOR THE COMPO.

+*----

+      CALL LCMGET(IPCPO,'STATE-VECTOR',ISTATE)

+      NMIL=ISTATE(1)

+      NG=ISTATE(2)

+      NMCAL=ISTATE(4)

+      NPAR=ISTATE(5)

+      NLOC=ISTATE(6)

+      NCOMLI=ISTATE(10)

+      NGFF=ISTATE(14)

+      IF(NGFF.EQ.0) CALL XABORT('NAPCPO: NO GFF INFO IN MULTICOMPO.')

+      CALL LCMGTC(IPCPO,'COMMENT',80,NCOMLI,COMMEN)

+      IF(NPAR.GT.0)THEN

+        CALL LCMSIX(IPCPO,'GLOBAL',1)

+        CALL LCMGTC(IPCPO,'PARKEY',12,NPAR,PARKEY)

+        CALL LCMGTC(IPCPO,'PARFMT',8,NPAR,PARFMT)

+        CALL LCMGET(IPCPO,'NVALUE',NVALUE)

+        IF(IMPX.GT.10)THEN

+          DO IPAR=1,NPAR

+            WRITE(RECNAM,'(''pval'',I8.8)') IPAR

+            IF(PARFMT(IPAR).EQ.'INTEGER') THEN

+              CALL LCMGET(IPCPO,RECNAM,VINTE)

+              WRITE(IOUT,'(13H NAPCPO: KEY=,A,18H TABULATED POINTS=,

+     1        1P,6I12/(43X,6I12))') PARKEY(IPAR),(VINTE(I),I=1,

+     2        NVALUE(IPAR))

+            ELSE IF(PARFMT(IPAR).EQ.'REAL') THEN

+              CALL LCMGET(IPCPO,RECNAM,VREAL)

+              WRITE(IOUT,'(13H NAPCPO: KEY=,A,18H TABULATED POINTS=,

+     1        1P,6E12.4/(43X,6E12.4))') PARKEY(IPAR),(VREAL(I),I=1,

+     2        NVALUE(IPAR))

+            ELSE IF(PARFMT(IPAR).EQ.'STRING') THEN

+              CALL LCMGTC(IPCPO,RECNAM,12,NVALUE(IPAR),VCHAR)

+              WRITE(IOUT,'(13H NAPCPO: KEY=,A,18H TABULATED POINTS=,

+     1        1P,6A12/(43X,6A12))') PARKEY(IPAR),(VCHAR(I),I=1,

+     2        NVALUE(IPAR))

+            ENDIF

+          ENDDO

+        ENDIF

+        CALL LCMSIX(IPCPO,' ',2)

+      ENDIF

+      IF(NLOC.GT.0)THEN

+        CALL LCMSIX(IPCPO,'LOCAL',1)

+        CALL LCMGTC(IPCPO,'PARKEY',12,NLOC,PARKEL)

+        CALL LCMSIX(IPCPO,' ',2)

+        JPCPO=LCMGID(IPCPO,'MIXTURES')

+        DO IBMOLD=1,NMIL

+          KPCPO=LCMGIL(JPCPO,IBMOLD)

+          LPCPO=LCMGID(KPCPO,'TREE')

+          CALL LCMGET(LPCPO,'NVALUE',NVALUE)

+          IF(IMPX.GT.10)THEN

+            WRITE(IOUT,'(17H NAPCPO: MIXTURE=,I6)') IBMOLD

+            DO IPAR=1,NLOC

+              WRITE(RECNAM,'(''pval'',I8.8)') IPAR

+              CALL LCMGET(LPCPO,RECNAM,VREAL)

+              WRITE(IOUT,'(13H NAPCPO: KEY=,A,18H TABULATED POINTS=,

+     1        1P,6E12.4/(43X,6E12.4))') PARKEL(IPAR),(VREAL(I),I=1,

+     2        NVALUE(IPAR))

+            ENDDO

+          ENDIF

+        ENDDO

+      ENDIF

+      IF(IMPX.GT.10)WRITE(IOUT,'(1X,A)') (COMMEN(I),I=1,NCOMLI)

+*----

+*  READ (INTERP_DATA) AND SET VALI, VALR AND VALH PARAMETERS

+*  CORRESPONDING TO THE INTERPOLATION POINT. FILL MUPLET FOR

+*  PARAMETERS.

+*----

+      MUPLET(:NPAR+NLOC)=0

+ 1020 CALL REDGET(INDIC,NITMA,FLOT,TEXT,DFLOT)

+      IF(INDIC.NE.3) CALL XABORT('NAPCPO: character data expected.')

+      IF(TEXT.EQ.'SET') THEN

+         CALL REDGET(INDIC,NITMA,FLOT,TEXT,DFLOT)

+         IF(INDIC.NE.3) CALL XABORT('NAPCPO: character data expected.')

+         DO 50 I=1,NPAR

+         IF(TEXT.EQ.PARKEY(I)) THEN

+            IPAR=I

+            GO TO 60

+         ENDIF

+   50    CONTINUE

+         GO TO 100

+   60    LPCPO=LCMGID(IPCPO,'GLOBAL')

+         CALL LCMGET(LPCPO,'NVALUE',NVALUE)

+         IF(NVALUE(IPAR).GT.MAXVAL) CALL XABORT('NAPCPO: MAXVAL OVERFL'

+     1   //'OW.')

+         WRITE(RECNAM,'(''pval'',I8.8)') IPAR

+         CALL LCMLEN(LPCPO,RECNAM,LENGTH,ITYLCM)

+         IF(LENGTH.EQ.0) THEN

+            WRITE(HSMG,'(25HNAPCPO: GLOBAL PARAMETER ,A,9H NOT SET.)')

+     1      PARKEY(IPAR)

+            CALL XABORT(HSMG)

+         ENDIF

+         IF(PARFMT(IPAR).EQ.'INTEGER') THEN

+            CALL REDGET(INDIC,VALI(IPAR),FLOT,TEXT,DFLOT)

+            IF(INDIC.NE.1) CALL XABORT('NAPCPO: integer data expected.')

+            CALL LCMGET(LPCPO,RECNAM,VINTE)

+            DO J=1,NVALUE(IPAR)

+              IF(VALI(IPAR).EQ.VINTE(J)) THEN

+                MUPLET(IPAR)=J

+*               MUTYPE(IPAR)=ITYPGD

+                GO TO 1020

+              ENDIF

+            ENDDO

+            WRITE(HSMG,'(26HNAPCPO: INTEGER PARAMETER ,A,9H WITH VAL,

+     1      2HUE,I5,29H NOT FOUND IN COMPO DATABASE.)') PARKEY(IPAR),

+     2      VALI(IPAR)

+            CALL XABORT(HSMG)

+         ELSE IF(PARFMT(IPAR).EQ.'REAL') THEN

+            CALL REDGET(INDIC,NITMA,VALR(IPAR,1),TEXT,DFLOT)

+            IF(INDIC.NE.2) CALL XABORT('NAPCPO: real data expected.')

+            VALR(IPAR,2)=VALR(IPAR,1)

+!            CALL REDGET(INDIC,NITMA,FLOT,TEXT,DFLOT)

+            CALL LCMGET(LPCPO,RECNAM,VREAL)

+            DO J=1,NVALUE(IPAR)

+              IF(ABS(VALR(IPAR,1)-VREAL(J)).LE.REPS*ABS(VREAL(J))) THEN

+                MUPLET(IPAR)=J

+*               MUTYPE(IPAR)=ITYPGD

+               GO TO 1020

+              ENDIF

+            ENDDO

+            WRITE(HSMG,'(23HNAPCPO: REAL PARAMETER ,A,9H WITH VAL,

+     1      2HUE,I5,29H NOT FOUND IN COMPO DATABASE.)') PARKEY(IPAR),

+     2      VALR(IPAR,1)

+            CALL XABORT(HSMG)

+         ELSE IF(PARFMT(IPAR).EQ.'STRING') THEN

+            CALL REDGET(INDIC,NITMA,FLOT,VALH(IPAR),DFLOT)

+            IF(INDIC.NE.3) CALL XABORT('NAPCPO: STRING DATA EXPECTED.')

+            CALL LCMGTC(LPCPO,RECNAM,12,NVALUE(IPAR),VCHAR)

+            DO J=1,NVALUE(IPAR)

+              IF(VALH(IPAR).EQ.VCHAR(J)) THEN

+                MUPLET(IPAR)=J

+*               MUTYPE(IPAR)=ITYPGD

+                GO TO 1020

+              ENDIF

+            ENDDO

+            WRITE(HSMG,'(25HNAPCPO: STRING PARAMETER ,A,10H WITH VALU,

+     1      2HE ,A12,29H NOT FOUND IN COMPO DATABASE.)') PARKEY(IPAR),

+     2      VALH(IPAR)

+            CALL XABORT(HSMG)

+         ENDIF

+  100    DO 110 I=1,NLOC

+         IF(TEXT.EQ.PARKEL(I)) THEN

+            IPAR=NPAR+I

+            GO TO 120

+         ENDIF

+  110    CONTINUE

+         CALL XABORT('NAPCPO: PARAMETER '//TEXT//' NOT FOUND.')

+  120    JPCPO=LCMGID(IPCPO,'MIXTURES')

+         IBMOLD=1

+         KPCPO=LCMGIL(JPCPO,IBMOLD)

+         LPCPO=LCMGID(KPCPO,'TREE')

+         CALL LCMGET(LPCPO,'NVALUE',NVALUE)

+         CALL REDGET(INDIC,NITMA,VALR(IPAR,1),TEXT,DFLOT)

+         IF(INDIC.NE.2) CALL XABORT('NAPCPO: real data expected.')

+         VALR(IPAR,2)=VALR(IPAR,1)

+         WRITE(RECNAM,'(''pval'',I8.8)') IPAR-NPAR

+         CALL LCMLEN(LPCPO,RECNAM,LENGTH,ITYLCM)

+         IF(LENGTH.EQ.0) THEN

+            WRITE(HSMG,'(24HNAPCPO: LOCAL PARAMETER ,A,9H NOT SET.)')

+     1      PARKEL(IPAR-NPAR)

+            CALL XABORT(HSMG)

+         ELSE IF(LENGTH.GT.MAXVAL) THEN

+            CALL XABORT('NAPCPO: MAXVAL OVERFLOW.')

+         ENDIF

+         CALL LCMGET(LPCPO,RECNAM,VREAL)

+         DO J=1,NVALUE(IPAR-NPAR)

+           IF(ABS(VALR(IPAR,1)-VREAL(J)).LE.REPS*ABS(VREAL(J))) THEN

+             MUPLET(IPAR)=J

+*            MUTYPE(IPAR)=ITYPGD

+             GO TO 1020

+           ENDIF

+         ENDDO

+         WRITE(HSMG,'(26HNAPCPO: INTEGER PARAMETER ,A,9H WITH VAL,

+     1   2HUE,I5,29H NOT FOUND IN COMPO DATABASE.)') PARKEY(IPAR),

+     2   VALI(IPAR)

+         CALL XABORT(HSMG)

+      ELSEIF(TEXT.EQ.'IFX') THEN

+        CALL REDGET(INDIC,IFX,FLOT,TEXT,DFLOT)

+        IF(INDIC.NE.1) CALL XABORT('NAPCPO: integer data expected.')

+        GO TO 1020

+      ELSEIF(TEXT.EQ.'NOINTP') THEN

+        LNOINT=.TRUE.

+        GO TO 1020

+      ELSEIF(TEXT.EQ.'INTERP') THEN

+        LNOINT=.FALSE.

+        GO TO 1020

+      ELSEIF(TEXT.EQ.';') THEN

+        GOTO 200

+      ENDIF

+      CALL XABORT('NAPCPO: '//TEXT//' is a wrong keyword')

+*

+  200 CONTINUE

+      JPCPO=LCMGID(IPCPO,'MIXTURES')

+      IBMOLD=1

+      KPCPO=LCMGIL(JPCPO,IBMOLD)

+      LPCPO=LCMGID(KPCPO,'TREE')

+      CALL LCMGET(LPCPO,'NVP',NVPO)

+      CALL LCMLEN(LPCPO,'ARBVAL',MAXNVP,ITYLCM)

+      IF(NVPO(1).GT.MAXNVP) CALL XABORT('NAPCPO: NVP OVERFLOW.')

+      ALLOCATE(JDEBAR(MAXNVP+1),JARBVA(MAXNVP))

+      CALL LCMGET(LPCPO,'DEBARB',JDEBAR)

+      CALL LCMGET(LPCPO,'ARBVAL',JARBVA)

+      IF(IMPX.GE.20) THEN

+        WRITE(6,*) 'MUPLET: ',(MUPLET(I),I=1,NPAR+NLOC)

+      ENDIF

+      ICAL=NCRCAL(1,NVPO(1),NPAR+NLOC,JDEBAR,JARBVA,MUPLET)

+      IF(IMPX.GE.2) THEN

+        WRITE(6,*) 'Performing projection for calculation: ',ICAL

+      ENDIF

+*

+      LPCPO=LCMGID(KPCPO,'CALCULATIONS')

+      JPMIC=LCMGIL(LPCPO,ICAL)

+      CALL LCMGET(JPMIC,'STATE-VECTOR',ISTATE)

+      CALL LCMSIX(JPMIC,'MACROLIB    ',1)

+      CALL LCMSIX(JPMIC,'GFF         ',1)

+      CALL LCMSIX(JPMIC,'GFF-GEOM    ',1)

+C get dimension in geometry from L_MULTICOMPO

+      CALL LCMGET(JPMIC,'STATE-VECTOR',ISTATE)

+      ITYPGP=ISTATE(1)

+      STYPP=ISTATE(11)

+      IF(ITYPGP.NE.5) CALL XABORT('NAPCPO: CAR2D geometry type '

+     1 //'expected in L_MULTICOMPO.')

+      IF(STYPP.NE.0) CALL XABORT('NAPCPO: No split in geometry expected'

+     1 //' in L_MULTICOMPO.')

+      NXP=ISTATE(3)

+      NYP=ISTATE(4)

+      NREGP=ISTATE(6)

+      NMIXP=ISTATE(7)

+      IF(NMIXP.NE.NGFF) CALL XABORT('NAPCPO: INVALID GFF-GEOM.')

+      ALLOCATE(MXP(NXP+1),MYP(NYP+1))

+      ALLOCATE(IXPD(NXP+1),IYPD(NYP+1))

+      ALLOCATE(MIXP(NREGP))

+      CALL LCMGET(JPMIC,'MESHX',MXP)

+      CALL LCMGET(JPMIC,'MESHY',MYP)

+      CALL LCMGET(JPMIC,'MIX',MIXP)

+      CALL LCMSIX(JPMIC,'GFF-GEOM    ',2)

+      IXPD(:NXP+1)=0

+      IYPD(:NYP+1)=0

+C get dimension in geometry from L_TRACK

+      CALL LCMGET(IPTRK,'STATE-VECTOR',ISTATE)

+      NREG=ISTATE(1)

+      NUN=ISTATE(2)

+      ITYPGD=ISTATE(6)

+      IEL=ISTATE(9)

+      IF(ITYPGD.NE.5) CALL XABORT('NAPCPO: CAR2D geometry type expected'

+     1 //' in L_TRACKING.')

+      IEL=ISTATE(9)

+      L4=ISTATE(11)

+      ICHX=ISTATE(12)

+      NXD=ISTATE(14)

+      NYD=ISTATE(15)

+      IDIM=2

+      IF(NREG.NE.NXD*NYD) CALL XABORT('NAPCPO: No Splitting allowed in '

+     1 //'CAR2D geometry type from L_TRACK.')

+C     compute X and Y mesh from L_TRACK

+      ALLOCATE(MXD(NXD+1),MYD(NYD+1))

+      ALLOCATE(XX(NREG),YY(NREG))

+      CALL LCMGET(IPTRK,'XX',XX)

+      CALL LCMGET(IPTRK,'YY',YY)

+      MXD(1)=MXP(1)

+      DO I=1,NXD

+        MXD(I+1)=MXD(I)+XX(I)

+      ENDDO

+      MYD(1)=MYP(1)

+      DO I=1,NYD

+        MYD(I+1)=MYD(I)+YY((I-1)*NXD+1)

+      ENDDO

+      if(IMPX.ge.10) then

+        WRITE(6,*) 'Respective mesh (Diffusion vs. Transport):'

+        WRITE(6,*) ' X direction :'

+        WRITE(6,*) 'MXD:',(MXD(I),I=1,NXD+1)

+        WRITE(6,*) 'MXP:',(MXP(I),I=1,NXP+1)

+        WRITE(6,*) ' Y direction :'

+        WRITE(6,*) 'MYD:',(MYD(I),I=1,NYD+1)

+        WRITE(6,*) 'MYP:',(MYP(I),I=1,NYP+1)

+      endif

+      IF((ABS(MXD(NXD+1)-MXP(NXP+1)).GE.1E-3).OR.

+     1   (ABS(MXD(NXD+1)-MXP(NXP+1)).GE.1E-3)) CALL XABORT('NAPCPO: '

+     2 //'Diffusion and transport geometries total size mismach')

+      ALLOCATE(FXTD(NXP,NXD),FYTD(NYP,NYD))

+      FXTD(:NXP,:NXD)=0.0

+      FYTD(:NYP,:NYD)=0.0

+      CALL NAPFTD(NXP,MXP,NXD,MXD,FXTD)

+      CALL NAPFTD(NYP,MYP,NYD,MYD,FYTD)

+      IF(LNOINT) THEN

+C     verify that both meshes match 

+      J1=1

+      DO I=2,NXD+1

+        FLAG=.TRUE.

+        DO J=J1,NXP+1

+          IF(MXP(J).LT.MXD(I)) THEN

+            IXPD(J)=I-1

+          ENDIF

+          IF(ABS(MXD(I)-MXP(J)).LE.ABS(1E-5*MXP(J))) THEN

+            FLAG=.FALSE.

+            IXPD(J)=I

+            J1=J+1

+          ENDIF

+        ENDDO

+        IF(FLAG) CALL XABORT('NAPCPO: a X mesh in L_TRACK does not '

+     1 //'match the CAR2D geometry imbedded in L_MULTICOMPO.')

+      ENDDO

+      J1=1

+      DO I=2,NYD+1

+        FLAG=.TRUE.

+        DO J=J1,NYP+1

+          IF(MYP(J).LT.MYD(I)) THEN

+            IYPD(J)=I-1

+          ENDIF

+          IF(ABS(MYD(I)-MYP(J)).LE.ABS(1E-5*MYP(J))) THEN

+            FLAG=.FALSE.

+            IYPD(J)=I

+            J1=J+1

+          ENDIF

+        ENDDO

+        IF(FLAG) CALL XABORT('NAPCPO: a Y mesh in L_TRACK does not '

+     1  //'match the CAR2D geometry imbedded in L_MULTICOMPO.')

+      ENDDO

+      ENDIF

+C     project flux 

+      ALLOCATE(KEYFLX(NREG),MATCOD(NREG))

+      CALL LCMGET(IPTRK,'KEYFLX',KEYFLX)

+      CALL LCMGET(IPTRK,'MATCOD',MATCOD)

+      ALLOCATE(FLXD(NUN),FLXP(NMIXP,NG))

+      ALLOCATE(FLAGMX(NMIXP))

+      JPFLU=LCMGID(IPFLU,'FLUX')

+      DO IG=1,NG

+        CALL LCMGDL(JPFLU,IG,FLXD)

+        DO IP=1,NXP

+          DO JP=1,NYP

+            IREGP=IP+(JP-1)*NXP

+            IF(IREGP.GT.NREGP) CALL XABORT('NAPCPO: NREGP OVERFLOW(1).')

+            IMIXP=MIXP(IREGP)

+            FLXP(IMIXP,IG)=0.0

+            IF(LNOINT) THEN

+*     integrated projected flux FLXP

+              IREG=IXPD(IP)+(IYPD(JP)-1)*NXD

+              FLXP(IMIXP,IG)=FLXD(KEYFLX(IREG))

+            ELSE

+*     interpolated projected flux FLXP

+              DO ID=1,NXD

+                DO JD=1,NYD

+                  IF(FXTD(IP,ID)*FYTD(JP,JD).NE.0.0) THEN

+* -----

+      CALL ALGPT(NGPT,MAX(MXP(IP),MXD(ID)),MIN(MXP(IP+1),MXD(ID+1)),

+     1   ZGKSIX,WGKSIX)

+      DX=MIN(MXP(IP+1),MXD(ID+1))-MAX(MXP(IP),MXD(ID))

+      CALL ALGPT(NGPT,MAX(MYP(JP),MYD(JD)),MIN(MYP(JP+1),MYD(JD+1)),

+     1   ZGKSIY,WGKSIY)

+      DY=MIN(MYP(JP+1),MYD(JD+1))-MAX(MYP(JP),MYD(JD))

+      IF(IMPX.GE.5) THEN

+        WRITE(6,*) 'IP,JP:',IP,JP,FXTD(IP,ID),'ID,JD:',ID,JD,FYTD(JP,JD)

+        WRITE(6,*) 'Gauss point ZGWG:',(ZGKSIX(I),I=1,NGPT),

+     1   (WGKSIX(I),I=1,NGPT),'DX',DX

+        WRITE(6,*) 'Gauss point ZGWG:',(ZGKSIY(I),I=1,NGPT),

+     1   (WGKSIY(I),I=1,NGPT),'DY',DY

+      ENDIF

+      FPD=0.0

+*     interpolate flux

+      IF(ICHX.EQ.1) THEN

+*       Variational collocation method

+        CALL LCMLEN(IPTRK,'KN',MAXKN,ITYLCM)

+        MKN=MAXKN/(NXD*NYD)

+        ALLOCATE(KN(MAXKN))

+        CALL LCMGET(IPTRK,'KN',KN)

+        CALL LCMSIX(IPTRK,'BIVCOL',1)

+        CALL LCMLEN(IPTRK,'T',LC,ITYLCM)

+        CALL LCMGET(IPTRK,'E',E)

+        CALL LCMSIX(IPTRK,' ',2)

+        CALL VALU2B(LC,MKN,NXD,NYD,L4,ZGKSIX,ZGKSIY,MXD,MYD,FLXD,MATCOD,

+     1  KN,NGPT,NGPT,E,FLUGP)

+      ELSE IF(ICHX.EQ.2) THEN

+*       Raviart-Thomas finite element method

+        CALL VALU4B(IEL,NUN,NXD,NYD,ZGKSIX,ZGKSIY,MXD,MYD,FLXD,MATCOD,

+     1  KEYFLX,NGPT,NGPT,FLUGP)

+      ELSE IF(ICHX.EQ.3) THEN

+*       Nodal collocation method (MCFD)

+        CALL VALU1B(IDIM,NXD,NYD,L4,ZGKSIX,ZGKSIY,MXD,MYD,FLXD,MATCOD,

+     1  IEL,NGPT,NGPT,FLUGP)

+      ELSE

+        CALL XABORT('NAPCPO: INTERPOLATION NOT IMPLEMENTED.')

+      ENDIF

+      IF(IMPX.GE.5) THEN

+        WRITE(6,*) 'Gauss flux values:'

+        do JGP=1,NGPT

+          WRITE(6,*) (FLUGP(IGP,JGP),IGP=1,NGPT)

+        ENDDO

+      ENDIF

+*     integrate flux (gauss method)

+      DO IGP=1,NGPT

+      DO JGP=1,NGPT

+        FPD=FPD+FLUGP(IGP,JGP)*WGKSIX(IGP)*WGKSIY(JGP)

+      ENDDO

+      ENDDO

+*        get average flux

+      FPD=FPD/DX/DY

+      FLXP(IMIXP,IG)=FLXP(IMIXP,IG)+FPD*FXTD(IP,ID)*FYTD(JP,JD)

+* -----

+                  ENDIF

+                ENDDO

+              ENDDO

+            ENDIF

+          ENDDO

+        ENDDO

+      ENDDO

+C     flux normalization

+C         get data from transport calculations

+      ALLOCATE(FT(NMIXP,NG))

+        CALL LCMGET(JPMIC,'NWT0',FT)

+C           group by group

+      DO IG=1,NG

+C         compute average flux from transport calculations

+      PTR=0.0

+      IREGP=0

+      DO IY=1,NYP

+      DO IX=1,NXP

+        IREGP=IREGP+1

+        IF(IREGP.GT.NREGP) CALL XABORT('NAPCPO: NREGP OVERFLOW(2).')

+        IMIXP=MIXP(IREGP)

+        PTR=PTR+FT(IMIXP,IG)*(MXP(IX+1)-MXP(IX))*(MYP(IY+1)-MYP(IY))

+      ENDDO

+      ENDDO

+C         compute average flux  with projected diffusion flux

+      PDF=0.0

+      IREGP=0

+      DO IY=1,NYP

+      DO IX=1,NXP

+        IREGP=IREGP+1

+        IF(IREGP.GT.NREGP) CALL XABORT('NAPCPO: NREGP OVERFLOW(3).')

+        IMIXP=MIXP(IREGP)

+        PDF=PDF+FLXP(IMIXP,IG)*(MXP(IX+1)-MXP(IX))*(MYP(IY+1)-MYP(IY))

+      ENDDO

+      ENDDO

+C         renormalize flux

+      DO IMIXP=1,NMIXP

+        FLXP(IMIXP,IG)=FLXP(IMIXP,IG)/PDF*PTR

+      ENDDO

+C

+      IF(IMPX.GT.5) THEN

+        PDF2=0.0

+        IREGP=0

+        DO IY=1,NYP

+        DO IX=1,NXP

+          IREGP=IREGP+1

+          IF(IREGP.GT.NREGP) CALL XABORT('NAPCPO: NREGP OVERFLOW(4).')

+          IMIXP=MIXP(IREGP)

+          PDF2=PDF2+FLXP(IMIXP,IG)

+     1          *(MXP(IX+1)-MXP(IX))*(MYP(IY+1)-MYP(IY))

+        ENDDO

+        ENDDO

+        WRITE(6,*)'NAPCPO: transport power:',PTR

+        WRITE(6,*)'NAPCPO: diffusion power (before normalization):',PDF

+        WRITE(6,*)'NAPCPO: diffusion power (after normalization):',PDF2

+        IREGP=0

+        WRITE(6,*) 'NAPCPO: FLXP/FT: group #',IG

+        DO IY=1,NYP

+          WRITE(6,*) (FLXP(MIXP(IREGP+I),IG)

+     1                /FT(MIXP(IREGP+I),IG),I=1,NXP)

+          IREGP=IREGP+NYP

+        ENDDO

+      ENDIF

+C     verify that all mixtures have a projected flux 

+        DO IMIXP=1,NMIXP

+          IF(FLXP(IMIXP,IG).EQ.0.0) THEN

+            WRITE(HSMG,'(42HNAPCPO: no projected flux for mixture and ,

+     1      6Hgroup=,2I6,1H.)') IMIXP,IG

+            CALL XABORT(HSMG)

+          ENDIF

+        ENDDO

+C     end DO IG=1,NG

+      ENDDO

+C     save projected flux in L_MULTICOMPO for each original mixture

+      DO I=1,NMIL

+        JPCPO=LCMGID(IPCPO,'MIXTURES')

+        KPCPO=LCMGIL(JPCPO,I)

+        LPCPO=LCMGID(KPCPO,'CALCULATIONS')

+        JPMIC=LCMGIL(LPCPO,ICAL)

+        CALL LCMSIX(JPMIC,'MACROLIB    ',1)

+        CALL LCMSIX(JPMIC,'GFF         ',1)

+        CALL LCMLEN(JPMIC,'FINF_NUMBER ',NFDI,ITYLCM)

+        IF(NFDI+1.GT.MAXIFX) CALL XABORT('NAPCPO: MAXIFX OVERFLOW.')

+        IF(NFDI.GT.0) CALL LCMGET(JPMIC,'FINF_NUMBER ',FINF)

+        FINF(NFDI+1)=IFX

+        WRITE(HVECT,500) IFX

+        CALL LCMPUT(JPMIC,'FINF_NUMBER ',NFDI+1,1,FINF)

+        IF(IMPX.GE.10) THEN

+          WRITE(6,'(17H NAPCPO: MIXTURE=,I5,8H RECORD ,A8,1H=)') I,HVECT

+          DO IG=1,NG

+            WRITE(6,'(7H GROUP=,I5/(1X,1P,12E13.4))') IG,

+     1      (FLXP(IMIXP,IG),IMIXP=1,NMIXP)

+          ENDDO

+        ENDIF

+        CALL LCMPUT(JPMIC,HVECT,NMIXP*NG,2,FLXP)

+        CALL LCMSIX(JPMIC,'GFF         ',2)

+        CALL LCMSIX(JPMIC,'*MAC*RES    ',2)

+      ENDDO

+      DEALLOCATE(FT)

+      DEALLOCATE(FLAGMX)

+      DEALLOCATE(FLXD,FLXP)

+      DEALLOCATE(FXTD,FYTD)

+      DEALLOCATE(KEYFLX,MATCOD)

+      DEALLOCATE(MXD,MYD)

+      DEALLOCATE(XX,YY)

+      DEALLOCATE(MIXP)

+      DEALLOCATE(MXP,MYP)

+      DEALLOCATE(IXPD,IYPD)

+      DEALLOCATE(JDEBAR,JARBVA)

+      RETURN

+*

+  500 FORMAT(5HFINF_,I3.3)

+      END

diff --git a/Donjon/src/NAPFTD.f b/Donjon/src/NAPFTD.f
new file mode 100644
index 0000000..a1058a7
--- /dev/null
+++ b/Donjon/src/NAPFTD.f
@@ -0,0 +1,58 @@
+*DECK NAPFTD

+      SUBROUTINE NAPFTD(NXP,MXP,NXD,MXD,FXTD)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Perform a projection of second geometry on first one to compute 

+*     fraction of region of the first geometry occupied by the second 

+*     geometry regions

+*

+*Copyright:

+* Copyright (C) 2014 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* R. Chambon

+*

+*Parameters: input/output

+*    for core with heterogeneous mixture

+* NXP    number of region along X direction for first geometry

+* MXP    mesh of region along X direction for first geometry

+* NXD    number of region along X direction for second geometry

+* MXD    mesh of region along X direction for second geometry

+* FXTD   fraction of region along X direction

+*

+*-----------------------------------------------------------------------

+*

+      USE GANLIB

+      IMPLICIT NONE

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      INTEGER      NXP,NXD

+      REAL         MXP(NXP),MXD(NXD),FXTD(NXP,NXD)

+*----

+*  LOCAL VARIABLES

+*----

+      INTEGER IP,ID

+      REAL DXP

+

+      DO IP=1,NXP

+      DXP=MXP(IP+1)-MXP(IP)

+      DO ID=1,NXD

+        IF((MXD(ID).LE.MXP(IP)).AND.(MXD(ID+1).GE.MXP(IP+1))) THEN

+          FXTD(IP,ID)=1.0

+        ELSEIF ((MXD(ID).LE.MXP(IP)).AND.(MXD(ID+1).GT.MXP(IP))) THEN

+          FXTD(IP,ID)=(MXD(ID+1)-MXP(IP))/DXP

+        ELSEIF ((MXD(ID).GE.MXP(IP)).AND.

+     1          (MXD(ID+1).LE.MXP(IP+1))) THEN

+          FXTD(IP,ID)=(MXD(ID+1)-MXD(ID))/DXP

+        ELSEIF ((MXD(ID).LT.MXP(IP+1)).AND.

+     1          (MXD(ID+1).GE.MXP(IP+1))) THEN

+          FXTD(IP,ID)=(MXP(IP+1)-MXD(ID))/DXP

+        ENDIF

+      ENDDO

+      ENDDO

+

+      RETURN

+      END

diff --git a/Donjon/src/NAPGEO.f b/Donjon/src/NAPGEO.f
new file mode 100644
index 0000000..da231e6
--- /dev/null
+++ b/Donjon/src/NAPGEO.f
@@ -0,0 +1,487 @@
+*DECK NAPGEO

+      SUBROUTINE NAPGEO(IPGNW,IPGOD,IPCPO,NSTATE)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Split geometry from homogeneous to heterogeneous assemblies

+*

+*Copyright:

+* Copyright (C) 2014 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* R. Chambon

+*

+*Parameters: input/output

+* IPGNW   LCM object address of heterogeneous assembly Geometry.

+* IPGOD   LCM object address of homogeneous assembly Geometry.

+* IPCPO   LCM object address of Multicompo.

+* NSTATE  length of the state vector

+*

+*-----------------------------------------------------------------------

+*

+      USE GANLIB

+      IMPLICIT NONE

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      INTEGER      NSTATE

+      TYPE(C_PTR)  IPGNW,IPGOD,IPCPO

+*----

+*  LOCAL VARIABLES

+*----

+      INTEGER IOUT,MAXLIN

+      REAL REPS

+      PARAMETER (REPS=1.0E-4,IOUT=6,MAXLIN=50)

+      TYPE(C_PTR) JPGEO,KPGEO,JPCPO,KPCPO

+      INTEGER INDIC,NITMA,LENGTH

+      CHARACTER TEXT*12

+      REAL FLOT

+      DOUBLE PRECISION DFLOT

+      INTEGER ISTATE(NSTATE),IMPX,NCODE(6),ICODE(6),ITYPGP,STYPP,

+     1  KCHAR(3)

+      REAL ZCODE(6)

+      INTEGER NXP,NYP,NREGP,NMIXP,NCOMLI,NXD,NYD,NZD,NREGD,NMIXD,NXF,

+     1  NYF,NZF,NREGF,NMIXF,NXA,NYA,NMIXA,NXPTMP,NYPTMP,NMIXD2,NASS

+      CHARACTER DIRHET*12,COMMEN(MAXLIN)*80,HMSG*131

+      INTEGER I,J,K,L,IP,JP,JF,IFBEG,JFBEG,LMIX,IASS,IZ,IZT,JM,JN,IM

+      LOGICAL LSPX,LSPY,LSPZ,LPOS,LMGEO

+      INTEGER, ALLOCATABLE, DIMENSION(:) :: MIXA,NBAX,AZONE,IBAX

+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: MIXP

+      INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: MIXD,MIXF

+      REAL, ALLOCATABLE, DIMENSION(:) :: MXP,MYP,MXD,MYD,MZD,MXF,

+     1  MYF

+      INTEGER, ALLOCATABLE, DIMENSION(:) :: SXP,SYP,SXD,SYD,SZD,

+     1  SXF,SYF,AXD,AYD

+

+      IMPX=0

+      LSPX=.FALSE.

+      LSPY=.FALSE.

+      LSPZ=.FALSE.

+      LMGEO=.FALSE.

+C Read mandatory inputs

+      CALL REDGET(INDIC,NITMA,FLOT,TEXT,DFLOT)

+      IF(INDIC.NE.3) CALL XABORT('NAPGEO: character data expected.')

+      IF(TEXT.EQ.'EDIT') THEN

+        CALL REDGET(INDIC,IMPX,FLOT,TEXT,DFLOT)

+        IF(INDIC.NE.1) CALL XABORT('NAPGEO: integer data expected.')

+        CALL REDGET(INDIC,NITMA,FLOT,TEXT,DFLOT)

+        IF(INDIC.NE.3) CALL XABORT('NAPGEO: character data expected.')

+      ENDIF

+      IF(TEXT.NE.'DIRGEO') CALL XABORT('NAPGEO: ''DIRGEO'' '//

+     1  'expected.')

+      CALL REDGET(INDIC,NITMA,FLOT,DIRHET,DFLOT)

+      IF(INDIC.NE.3) CALL XABORT('NAPGEO: character data expected.')

+      CALL REDGET(INDIC,NITMA,FLOT,TEXT,DFLOT)

+      IF(TEXT.EQ.'MACGEO') THEN

+        LMGEO=.TRUE.

+        CALL REDGET(INDIC,NITMA,FLOT,TEXT,DFLOT)

+      ENDIF

+      IF(TEXT.NE.'MIXASS') THEN

+        CALL XABORT('NAPGEO: ''MIXASS'' expected.')

+      ENDIF

+      CALL REDGET(INDIC,NMIXA,FLOT,DIRHET,DFLOT)

+      IF(INDIC.NE.1)CALL XABORT('@NAPGEO: integer data expected.')

+      ALLOCATE(MIXA(NMIXA*2))

+      DO I=1,NMIXA

+        CALL REDGET(INDIC,MIXA(I),FLOT,DIRHET,DFLOT)

+        IF(INDIC.NE.1)CALL XABORT('@NAPGEO: integer data expected.')

+      ENDDO

+      CALL LCMSIX(IPCPO,DIRHET,1)

+

+*----

+*  RECOVER TABLE-OF-CONTENT INFORMATION FOR THE COMPO.

+*----

+      CALL LCMGET(IPCPO,'STATE-VECTOR',ISTATE)

+      NCOMLI=ISTATE(10)

+      CALL LCMGTC(IPCPO,'COMMENT',80,NCOMLI,COMMEN)

+      IF(IMPX.GT.10)WRITE(IOUT,'(1X,A)') (COMMEN(I),I=1,NCOMLI)

+* Get Geometry from calculation #1

+* for pin by pin geometries

+      IF(LMGEO) THEN

+        JPCPO=LCMGID(IPCPO,'MIXTURES')

+        KPCPO=LCMGIL(JPCPO,1)

+        JPGEO=LCMGID(KPCPO,'CALCULATIONS')

+        KPGEO=LCMGIL(JPGEO,1)

+        CALL LCMSIX(KPGEO,'MACROLIB    ',1)

+        CALL LCMSIX(KPGEO,'GFF         ',1)

+        CALL LCMSIX(KPGEO,'GFF-GEOM    ',1)

+      ELSE

+* for heterogeneous geometries

+        JPGEO=LCMGID(IPCPO,'GEOMETRIES')

+        KPGEO=LCMGIL(JPGEO,1)

+      ENDIF

+C get dimension in geometry from L_MULTICOMPO

+      if(impx.ge.100)write(6,*) 'debug: get ISTATE multicompo Geometry'

+      CALL LCMGET(KPGEO,'STATE-VECTOR',ISTATE)

+      ITYPGP=ISTATE(1)

+      STYPP=ISTATE(11)

+      IF(ITYPGP.NE.5) CALL XABORT('NAPGEO: CAR2D geometry type '

+     1 //'expected in L_MULTICOMPO.')

+      IF(STYPP.NE.0) CALL XABORT('NAPGEO: No split in geometry '

+     1 //'expected in L_MULTICOMPO.')

+      NXP=ISTATE(3)

+      NYP=ISTATE(4)

+      NREGP=ISTATE(6)

+      NMIXP=ISTATE(7)

+      ALLOCATE(MXP(NXP+1),MYP(NYP+1))

+      ALLOCATE(SXP(NXP),SYP(NYP))

+      ALLOCATE(MIXP(NXP,NYP))

+      CALL LCMGET(KPGEO,'MESHX',MXP)

+      CALL LCMGET(KPGEO,'MESHY',MYP)

+      CALL LCMGET(KPGEO,'MIX',MIXP)

+      SXP(:NXP)=1

+      SYP(:NYP)=1

+C get dimension in homogeneous assembly core Geometry

+      if(impx.ge.100)write(6,*) 'debug: ISTATE homog. ass. core Geom.'

+      CALL LCMGET(IPGOD,'SIGNATURE',KCHAR)

+      CALL LCMGET(IPGOD,'STATE-VECTOR',ISTATE)

+      ITYPGP=ISTATE(1)

+      NXD=ISTATE(3)

+      NYD=ISTATE(4)

+      NZD=ISTATE(5)

+      NREGD=ISTATE(6)

+      NMIXD=ISTATE(7)

+      NMIXD2=NMIXD

+      ALLOCATE(MXD(NXD+1),MYD(NYD+1))

+      ALLOCATE(MZD(NZD+1))

+      ALLOCATE(SXD(NXD),SYD(NYD))

+      ALLOCATE(SZD(NZD))

+      ALLOCATE(AXD(NXD),AYD(NYD))

+      ALLOCATE(MIXD(NXD,NYD,NZD))

+      CALL LCMGET(IPGOD,'MESHX',MXD)

+      CALL LCMGET(IPGOD,'MESHY',MYD)

+      CALL LCMGET(IPGOD,'MESHZ',MZD)

+      CALL LCMGET(IPGOD,'MIX',MIXD)

+      AXD(:NXD)=0

+      AYD(:NYD)=0

+      CALL LCMLEN(IPGOD,'SPLITX',LENGTH,INDIC)

+      IF(LENGTH.NE.0) THEN

+        CALL LCMGET(IPGOD,'SPLITX',SXD)

+        LSPX=.TRUE.

+      ELSE

+        SXD(:NXD)=1

+      ENDIF

+      CALL LCMLEN(IPGOD,'SPLITY',LENGTH,INDIC)

+      IF(LENGTH.NE.0) THEN

+        CALL LCMGET(IPGOD,'SPLITY',SYD)

+        LSPY=.TRUE.

+      ELSE

+        SYD(:NYD)=1

+      ENDIF

+      CALL LCMLEN(IPGOD,'SPLITZ',LENGTH,INDIC)

+      IF(LENGTH.NE.0) THEN

+        CALL LCMGET(IPGOD,'SPLITZ',SZD)

+        LSPZ=.TRUE.

+      ELSE

+        SZD(:NZD)=1

+      ENDIF

+      CALL LCMGET(IPGOD,'NCODE',NCODE)

+      CALL LCMGET(IPGOD,'ZCODE',ZCODE)

+      CALL LCMGET(IPGOD,'ICODE',ICODE)

+C get assembly mixture in homogeneous core geometry

+      if(impx.ge.100)write(6,*) 'debug: get assembly mixture'

+      DO 40 K=1,NZD

+      DO 30 J=1,NYD

+      DO 20 I=1,NXD

+      DO 10 L=1,NMIXA

+         IF(MIXA(L).EQ.MIXD(I,J,K)) THEN

+           AXD(I)=1

+           AYD(J)=1

+           GOTO 20

+         ENDIF

+   10 CONTINUE

+   20 CONTINUE

+   30 CONTINUE

+   40 CONTINUE

+      if(impx.ge.5) then

+        write(6,*) 'Original mesh corresponding to assemblies'

+        write(6,*) 'X direction: AXD(1 : NXD)=',(AXD(I),I=1,NXD)

+        write(6,*) 'Y direction: AYD(1 : NYD)=',(AYD(I),I=1,NYD)

+      endif

+C specify splitting in heterogeneous assembly geometry

+   50 CALL REDGET(INDIC,NITMA,FLOT,TEXT,DFLOT)

+      IF(INDIC.NE.3) CALL XABORT('@NAPGEO: character data expected 1.')

+      IF(TEXT.EQ.'SPLITX-ASS') THEN

+        DO I=1,NXP

+          CALL REDGET(INDIC,SXP(I),FLOT,TEXT,DFLOT)

+          IF(INDIC.NE.1) THEN

+            WRITE(HMSG,*) '@NAPGEO: integer number expected'

+     1  //' for SPLITX-ASS: ',I,'out of ',NXP

+            CALL XABORT(HMSG)

+          ENDIF

+        ENDDO

+        LSPX=.TRUE.

+        GOTO 50

+      ELSEIF(TEXT.EQ.'SPLITY-ASS') THEN

+        DO I=1,NYP

+          CALL REDGET(INDIC,SYP(I),FLOT,TEXT,DFLOT)

+          IF(INDIC.NE.1) THEN

+            WRITE(HMSG,*) '@NAPGEO: integer number expected'

+     1  //' for SPLITY-ASS: ',I,'out of ',NYP

+            CALL XABORT(HMSG)

+          ENDIF

+        ENDDO

+        LSPY=.TRUE.

+        GOTO 50

+C read final ';'

+      ELSEIF(TEXT.EQ.'MAX-MIX-GEO') THEN

+        CALL REDGET(INDIC,NITMA,FLOT,TEXT,DFLOT)

+        IF(INDIC.NE.1) CALL XABORT('@NAPGEO: integer data expected.')

+        NMIXD2=MAX(NMIXD,NITMA)

+        GOTO 50

+C read final ';'

+      ELSEIF(TEXT.EQ.';') THEN

+        if(impx.ge.5) then

+          write(6,*) 'Splitting within assemblies:'

+          write(6,*) 'SXP',(SXP(I),I=1,NXP)

+          write(6,*) 'SYP',(SYP(I),I=1,NYP)

+        endif

+        GOTO 60

+      ELSE

+        CALL XABORT('@NAPGEO: '//TEXT//' WRONG KEYWORD')

+      ENDIF

+C compute new dimension

+C     get number of x and y original mesh to split

+   60 NXA=0

+      DO I=1,NXD

+        NXA=NXA+AXD(I)

+      ENDDO

+      NYA=0

+      DO I=1,NYD

+        NYA=NYA+AYD(I)

+      ENDDO

+C     compute new dimension

+      NXF=NXD+NXA*(NXP-1)

+      NYF=NYD+NYA*(NYP-1)

+      NZF=NZD

+      NREGF=NXF*NYF*NZF

+C allocate new geometry dimensions

+      ALLOCATE(MXF(NXF+1),MYF(NYF+1))

+      ALLOCATE(MIXF(NXF,NYF,NZF))

+      ALLOCATE(SXF(NXF),SYF(NYF))

+C Compute new x/y mesh and new x/y split

+      if(impx.ge.100)write(6,*) 'debug: Compute new x/y mesh and split'

+      J=1

+      MXF(J)=MXD(1)

+      DO I=2,NXD+1

+        IF(AXD(I-1).EQ.0) THEN

+          J=J+1

+          MXF(J)=MXD(I)

+          SXF(J-1)=SXD(I-1)

+        ELSE

+          DO K=2,NXP+1

+            J=J+1

+            MXF(J)=MXD(I-1)+MXP(K)-MXP(1)

+            SXF(J-1)=SXP(K-1)

+          ENDDO

+        ENDIF

+      ENDDO

+      J=1

+      MYF(J)=MYD(1)

+      DO I=2,NYD+1

+        IF(AYD(I-1).EQ.0) THEN

+          J=J+1

+          MYF(J)=MYD(I)

+          SYF(J-1)=SYD(I-1)

+        ELSE

+          DO K=2,NYP+1

+            J=J+1

+            MYF(J)=MYD(I-1)+MYP(K)-MYP(1)

+            SYF(J-1)=SYP(K-1)

+          ENDDO

+        ENDIF

+      ENDDO

+      IF(MXF(NXF+1).NE.MXD(NXD+1)) CALL XABORT('@NAPGEO: OLD and NEW'

+     1 //' X MESH do not match.')

+      IF(MYF(NYF+1).NE.MYD(NYD+1)) CALL XABORT('@NAPGEO: OLD and NEW'

+     1 //' Y MESH do not match.')

+C Compute new mixture

+      if(impx.ge.100)write(6,*) 'debug: Compute new mixture'

+      NMIXF=NMIXD2+NMIXA*NMIXP

+      MIXF(:NXF,:NYF,:NZF)=-1

+      DO 100 L=1,NMIXA

+         MIXA(L+NMIXA)=NMIXD2+(L-1)*NMIXP+1 

+  100 CONTINUE

+      DO 240 K=1,NZD

+      JFBEG=0

+      DO 230 J=1,NYD

+      IFBEG=0

+      DO 220 I=1,NXD

+        LMIX=0

+        DO 110 L=1,NMIXA

+          IF(MIXA(L).EQ.MIXD(I,J,K)) THEN

+            LMIX=L

+          ENDIF

+  110   CONTINUE

+        IF((AXD(I).EQ.1).AND.(AYD(J).EQ.1).AND.(LMIX.NE.0)) THEN

+          DO 130 JP=1,NYP

+          JF=JFBEG+JP

+          DO 120 IP=1,NXP

+            MIXF(IFBEG+IP,JF,K)=MIXA(LMIX+NMIXA)-1+MIXP(IP,JP)

+  120     CONTINUE

+  130     CONTINUE

+          IFBEG=IFBEG+NXP

+        ELSE

+          NXPTMP=1

+          IF(AXD(I).EQ.1) NXPTMP=NXP

+          NYPTMP=1

+          IF(AYD(J).EQ.1) NYPTMP=NYP

+          DO 150 JP=1,NYPTMP

+          JF=JFBEG+JP

+          DO 140 IP=1,NXPTMP

+            MIXF(IFBEG+IP,JF,K)=MIXD(I,J,K)

+  140     CONTINUE

+  150     CONTINUE

+          IFBEG=IFBEG+NXPTMP

+        ENDIF

+  220 CONTINUE

+      NYPTMP=1

+      IF(AYD(J).EQ.1) NYPTMP=NYP

+      JFBEG=JFBEG+NYPTMP

+  230 CONTINUE

+  240 CONTINUE

+      

+C Compute A-ZONE

+      if(impx.ge.100)write(6,*) 'debug: Compute A-ZONE'

+      IASS=0

+      ALLOCATE(NBAX(NYD))

+      ALLOCATE(IBAX(NYD))

+      DO 340 J=1,NYD

+      NBAX(J)=0

+      IBAX(J)=0

+      DO 330 I=1,NXD

+      DO 320 K=1,NZD

+        DO 310 L=1,NMIXA

+          IF(MIXA(L).EQ.MIXD(I,J,K)) THEN

+            IASS=IASS+1

+            NBAX(J)=NBAX(J)+1

+            IF(IBAX(J).EQ.0) IBAX(J)=I

+            GOTO 330

+          ENDIF

+  310   CONTINUE

+  320 CONTINUE

+  330 CONTINUE

+  340 CONTINUE

+      NASS=IASS

+*

+      ALLOCATE(AZONE(NASS*NXP*NYP))

+      IZ=0

+      IASS=0

+      DO 370 J=1,NYD

+      DO 360 I=1,NBAX(J)

+      IASS=IASS+1

+      DO 365 JP=1,NYP

+      DO 355 IP=1,NXP

+      IZT=IZ+(JP-1)*NXP*NBAX(J)+(I-1)*NXP+IP

+      AZONE(IZT)=IASS

+  355 CONTINUE

+  365 CONTINUE

+  360 CONTINUE

+      IZ=IZ+NBAX(J)*NXP*NYP

+  370 CONTINUE

+*      

+      if(impx.ge.5)then

+        write(6,*) 'New mixtures:'

+        do K=1,NZF

+          write(6,*) 'plane #',K

+          do J=1,NYF

+            write(6,*) (MIXF(I,J,K),I=1,NXF)

+          enddo

+        enddo

+

+        write(6,*) 'Assembly zones:'

+        IZ=0

+        do J=1,NYD

+          do K=1,NYP

+            write(6,*) (AZONE(I),I=IZ+(K-1)*NBAX(J)*NXP+1,

+     1      IZ+K*NBAX(J)*NXP)

+          enddo

+          IZ=IZ+NBAX(J)*NXP*NYP

+        enddo

+      endif

+C Verify new mixture

+      DO K=1,NZF

+      DO J=1,NYF

+      DO I=1,NXF

+      IF(MIXF(I,J,K).EQ.-1) CALL XABORT('@NAPGEO: new '

+     1 //'geometry mixture not assigned')

+      ENDDO

+      ENDDO

+      ENDDO

+

+      DEALLOCATE(MXD,MYD)

+      DEALLOCATE(SXD,SYD)

+      DEALLOCATE(MIXD)

+

+      DEALLOCATE(MXP,MYP)

+      DEALLOCATE(SXP,SYP)

+      DEALLOCATE(MIXP)

+C Compute relative position of assembly in original geometry

+      if(impx.ge.100)write(6,*) 'debug: Compute relative position'

+      JM=0

+      JN=0

+      LPOS=.TRUE.

+      DO J=1,NYD

+        IF(NBAX(J).NE.0) THEN

+          JN=JN+1

+          IF(LPOS) THEN

+            JM=J

+            LPOS=.FALSE.

+          ENDIF

+        ENDIF

+      ENDDO

+

+      IM=10000000

+      DO J=JM,JM+JN-1

+        IM=MIN(IBAX(J),IM)

+      ENDDO

+      DO J=1,NYD

+        IBAX(J)=IBAX(J)-IM+1

+      ENDDO

+

+C Save heterogeneous core geometry

+      if(impx.ge.100)write(6,*) 'debug: Save heter. core geometry'

+      ISTATE(:NSTATE)=0

+      ISTATE(1)=ITYPGP

+      ISTATE(3)=NXF

+      ISTATE(4)=NYF

+      ISTATE(5)=NZF

+      ISTATE(6)=NREGF

+      ISTATE(7)=NMIXF

+*      ISTATE(39)=NMIXA

+*      ISTATE(40)=NMIXP

+      IF(LSPX .OR. LSPY .OR. LSPZ) ISTATE(11)=1

+      CALL LCMPUT(IPGNW,'STATE-VECTOR',NSTATE,1,ISTATE)

+      CALL LCMPUT(IPGNW,'MESHX',NXF+1,2,MXF)

+      CALL LCMPUT(IPGNW,'MESHY',NYF+1,2,MYF)

+      CALL LCMPUT(IPGNW,'MESHZ',NZF+1,2,MZD)

+      IF(LSPX) CALL LCMPUT(IPGNW,'SPLITX',NXF,1,SXF)

+      IF(LSPY) CALL LCMPUT(IPGNW,'SPLITY',NYF,1,SYF)

+      IF(LSPZ) CALL LCMPUT(IPGNW,'SPLITZ',NZF,1,SZD)

+      CALL LCMPUT(IPGNW,'MIX',NREGF,1,MIXF)

+      CALL LCMPUT(IPGNW,'NCODE',6,1,NCODE)

+      CALL LCMPUT(IPGNW,'ICODE',6,1,ICODE)

+      CALL LCMPUT(IPGNW,'ZCODE',6,2,ZCODE)

+      CALL LCMPUT(IPGNW,'MIX-ASBLY',2*NMIXA,1,MIXA)

+      CALL LCMPUT(IPGNW,'SIGNATURE',3,3,KCHAR)

+      CALL LCMPUT(IPGNW,'A-ZONE',NASS*NXP*NYP,1,AZONE)

+      CALL LCMPUT(IPGNW,'A-NX',JN,1,NBAX(JM))

+      CALL LCMPUT(IPGNW,'A-IBX',JN,1,IBAX(JM))

+      CALL LCMPUT(IPGNW,'A-NMIXP',1,1,NMIXP)

+! 

+      if(impx.ge.100)write(6,*) 'debug: beging deallacate'

+

+      DEALLOCATE(IBAX)

+      DEALLOCATE(NBAX)

+      DEALLOCATE(AZONE)

+      DEALLOCATE(MXF,MYF)

+      DEALLOCATE(MZD)

+      DEALLOCATE(SXF,SYF)

+      DEALLOCATE(SZD)

+      DEALLOCATE(MIXF)

+      DEALLOCATE(MIXA)

+

+

+      RETURN

+      END

diff --git a/Donjon/src/NAPPPR.f b/Donjon/src/NAPPPR.f
new file mode 100644
index 0000000..d1f891c
--- /dev/null
+++ b/Donjon/src/NAPPPR.f
@@ -0,0 +1,866 @@
+*DECK NAPPPR

+      SUBROUTINE NAPPPR(IPMAP,IPTRK,IPFLU,IPMTX,IPMAC,NSTATE)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Perform the Pin Power Reconstruction for core with

+* heterogeneous mixture

+*

+*Copyright:

+* Copyright (C) 2014 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* R. Chambon (EPM) and R. Nguyen Van Ho (URANUS)

+*

+*Parameters: input/output

+* IPMAP   LCM object address of Map.

+* IPTRK   LCM object address of Tracking.

+* IPFLU   LCM object address of Flux.

+* IPMTX   LCM object address of Matex.

+* IPMAC   LCM object address of Macrolib of the fuel.

+* NSTATE  length of the state vector

+*

+*-----------------------------------------------------------------------

+*

+      USE GANLIB

+      IMPLICIT NONE

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      INTEGER      NSTATE

+      TYPE(C_PTR)  IPMAP,IPTRK,IPFLU,IPMTX,IPMAC

+*----

+*  LOCAL VARIABLES

+*----

+      INTEGER IOUT,NGPT

+      REAL REPS

+      PARAMETER (REPS=1.0E-4,IOUT=6,NGPT=2)

+      TYPE(C_PTR) JPFLU,JPMAP,KPMAP

+      INTEGER INDIC,NITMA,LENGTH,NBPIN

+      CHARACTER TEXT*12

+      REAL FLOT

+      DOUBLE PRECISION DFLOT

+      INTEGER ISTATE(NSTATE),IMPX,IMETH

+      INTEGER NXP,NYP,NXD,NYD,NZD,NAX,NAY,

+     1  NASS,NCOMB,NG,NASS2,NREG,NXM,NYM,NZM,

+     2  NXT,NYT,NZT,NXDA,NYDA,NZDA,NCH,NZASS,NPIN,IFX,

+     3  NUN,IEL,NMIX,NAMIX,NGFF

+      CHARACTER LABEL*8

+      CHARACTER TFDINF*12

+      INTEGER I,J,K,IP,JP,I1,I2,J1,J2,K1,K2,IASS,ICH,IG,IM,JM,ID,JD,KM,

+     1 IAX,JAX,IGP,JGP,KGP,IMIX,IPIN,ICHX,IDIM,LC,L4,MAXKN,MKN,ITYLCM,

+     2 ITYPE

+      REAL POW,FACT,POWTOT,POWASS,DX,DY,DZ,FPD,FQ,PMAX,

+     1  HOTPINPOW,PINPOW,FXY,VTOT

+      REAL ZGKSIX(NGPT),ZGKSIY(NGPT),ZGKSIZ(NGPT),WGKSIX(NGPT),

+     1  WGKSIY(NGPT),WGKSIZ(NGPT),X(NGPT),Y(NGPT),Z(NGPT),

+     2  FLUGP(NGPT,NGPT,NGPT)

+      REAL E(25)

+      LOGICAL LSPX,LSPY,LSPZ,LCH,LPOW,LNOINT,LDEBUG

+*----

+*  ALLOCATABLE ARRAYS

+*----

+      CHARACTER*4, ALLOCATABLE, DIMENSION(:) :: NAMX,NAMY

+      INTEGER, ALLOCATABLE, DIMENSION(:) :: NBAX,IBAX,BMIXP,AZONE,

+     1  ACOMB,KN

+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: CODEA

+      INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: KEYFLX,BMIX,MAT

+      REAL, ALLOCATABLE, DIMENSION(:) :: MXP,MYP,MXD,MYD,MZD,MXM,

+     1  MYM,MZM,MXDA,MYDA,MZDA,FLXD,VOLM,FXYZ,PLINMAXZ,FXYASS,

+     2  FACTASS,PWASS,PWASS2

+      REAL, ALLOCATABLE, DIMENSION(:,:) :: FXTD,FYTD,BUNDPW

+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: HFA,HFM,FDINFM,

+     1  FTINFM,AXPOW,VPIN

+      REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: FLXDA,VOL

+      REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:) :: FLXP,HF,FDINF,FTINF

+*

+      IMPX=0

+      FACT=1.0

+      LSPX=.FALSE.

+      LSPY=.FALSE.

+      LSPZ=.FALSE.

+      LPOW=.FALSE.

+      LNOINT=.FALSE.

+      NZASS=0

+      NPIN=0

+      NBPIN=0

+      IFX=0

+      POW=1.0

+      FQ=0.0

+      FXY=0.0

+      HOTPINPOW=0.0

+      PINPOW=0.0

+      PMAX=0.0

+      VTOT=0.0

+      LDEBUG=.false.

+* Read mandatory keywords

+      if(LDEBUG)write(6,*) 'NAPPPR begin debug'

+* [EDIT] PPR

+      CALL REDGET(INDIC,NITMA,FLOT,TEXT,DFLOT)

+      IF(INDIC.NE.3) CALL XABORT('NAPPPR: character data expected.')

+      IF(TEXT.EQ.'EDIT') THEN

+        CALL REDGET(INDIC,IMPX,FLOT,TEXT,DFLOT)

+        IF(INDIC.NE.1) CALL XABORT('NAPPPR: inteGEr data expected.')

+        CALL REDGET(INDIC,NITMA,FLOT,TEXT,DFLOT)

+        IF(INDIC.NE.3) CALL XABORT('NAPPPR: character data expected.')

+      ENDIF

+      IF(TEXT.NE.'PPR') CALL XABORT('NAPPPR: ''PPR'' keyword '//

+     1  'expected.')

+!* NPIN

+!      CALL REDGET(INDIC,NITMA,FLOT,TEXT,DFLOT)

+!      IF(INDIC.NE.3) CALL XABORT('NAPPPR: character data expected.')

+!      IF(TEXT.NE.'NPIN') CALL XABORT('NAPPPR: ''NPIN'' keyword '//

+!     1  'expected.')

+!      CALL REDGET(INDIC,NPIN,FLOT,TEXT,DFLOT)

+!      IF(INDIC.NE.1) CALL XABORT('NAPPPR: NPIN inteGEr expected.')

+!      NXP=NPIN

+!      NYP=NPIN

+* NZASS

+      CALL REDGET(INDIC,NITMA,FLOT,TEXT,DFLOT)

+      IF(INDIC.NE.3) CALL XABORT('NAPPPR: character data expected.')

+      IF(TEXT.NE.'NZASS') CALL XABORT('NAPPPR: ''NZASS'' keyword '//

+     1  'expected.')

+      CALL REDGET(INDIC,NZASS,FLOT,TEXT,DFLOT)

+      IF(INDIC.NE.1) CALL XABORT('NAPPPR: NZASS inteGEr expected.')

+C* SPIN + SGAP

+C      CALL REDGET(INDIC,NITMA,FLOT,TEXT,DFLOT)

+C      IF(INDIC.NE.3) CALL XABORT('NAPPPR: character data expected.')

+C      IF(TEXT.NE.'DIM') CALL XABORT('NAPPPR: ''NZASS'' keyword '//

+C     1  'expected.')

+C      CALL REDGET(INDIC,NITMA,SPIN,TEXT,DFLOT)

+C      IF(INDIC.NE.2) CALL XABORT('NAPPPR: SPIN real expected.')

+C      CALL REDGET(INDIC,NITMA,SGAP,TEXT,DFLOT)

+C      IF(INDIC.NE.2) CALL XABORT('NAPPPR: SGAP real expected.')

+C      

+* GEt core GEometry description in matex

+      IF(IMPX.GE.100)WRITE(6,*) 'debug:GEt matex info'

+      CALL LCMGET(IPMTX,'STATE-VECTOR',ISTATE)

+      NG=ISTATE(1)

+      NXD=ISTATE(8)

+      NYD=ISTATE(9)

+      NZD=ISTATE(10)

+      ALLOCATE(MXD(NXD+1),MYD(NYD+1),MZD(NZD+1))

+      CALL LCMGET(IPMTX,'MESHX',MXD)

+      CALL LCMGET(IPMTX,'MESHY',MYD)

+      CALL LCMGET(IPMTX,'MESHZ',MZD)

+* GEt KEYFLX

+      IF(IMPX.GE.100)WRITE(6,*) 'debug:GEt track info'

+      CALL LCMGET(IPTRK,'STATE-VECTOR',ISTATE)

+      NREG=ISTATE(1)

+      NUN=ISTATE(2)

+      ITYPE=ISTATE(6)

+      IEL=ISTATE(9)

+      L4=ISTATE(11)

+      ICHX=ISTATE(12)

+      NXT=ISTATE(14)

+      NYT=ISTATE(15)

+      NZT=ISTATE(16)

+      IDIM=1

+      IF((ITYPE.EQ.5).OR.(ITYPE.EQ.6).OR.(ITYPE.EQ.8)) IDIM=2

+      IF((ITYPE.EQ.7).OR.(ITYPE.EQ.9)) IDIM=3

+      IF((NXD.NE.NXT).OR.(NYD.NE.NYT).OR.(NZD.NE.NZT)) CALL XABORT

+     1  ('NAPPPR: dimension do not match between MATEX and TRACKING')

+      ALLOCATE(KEYFLX(NXT,NYT,NZT),MAT(NXT,NYT,NZT))

+      CALL LCMGET(IPTRK,'KEYFLX',KEYFLX)

+      CALL LCMGET(IPTRK,'MATCOD',MAT)

+      ALLOCATE(FLXD(NUN))

+* GEt assembly GEometry in map

+      IF(IMPX.GE.100)WRITE(6,*) 'debug:GEt map info'

+      CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)

+      NCH=ISTATE(2)

+      NASS=ISTATE(14)

+      NAX=ISTATE(15)

+      NAY=ISTATE(16)

+      ALLOCATE(AZONE(NCH))

+      ALLOCATE(NAMX(NAX),NAMY(NAY))

+      CALL LCMGET(IPMAP,'A-ZONE',AZONE)

+      CALL LCMGTC(IPMAP,'AXNAME',4,NAX,NAMX)

+      CALL LCMGTC(IPMAP,'AYNAME',4,NAY,NAMY)

+      CALL LCMSIX(IPMAP,'GEOMAP',1)

+      CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)

+      NXM=ISTATE(3)

+      NYM=ISTATE(4)

+      NZM=ISTATE(5)

+      ALLOCATE(MXM(NXM+1),MYM(NYM+1),MZM(NZM+1))

+      ALLOCATE(NBAX(NAY),IBAX(NAY))

+      ALLOCATE(BMIX(NXM,NYM,NZM))

+      CALL LCMGET(IPMAP,'MESHX',MXM)

+      CALL LCMGET(IPMAP,'MESHY',MYM)

+      CALL LCMGET(IPMAP,'MESHZ',MZM)

+      CALL LCMLEN(IPMAP,'A-NX',LENGTH,INDIC)

+      IF(LENGTH.NE.NAY) CALL XABORT('NAPPPR: Number of assembly along'

+     1  //'Y direction do not match between MAP and embedded GEometry')

+      CALL LCMGET(IPMAP,'A-NX',NBAX)

+      CALL LCMGET(IPMAP,'A-IBX',IBAX)

+      CALL LCMSIX(IPMAP,'GEOMAP',2)

+      CALL LCMGET(IPMAP,'BMIX',BMIX)

+C* GEt data in pin by pin assembly GEometry 

+C      IF(IMPX.GE.100)WRITE(6,*) 'debug:GEt map pinBypin info'

+C      CALL LCMGET(IPMPP,'STATE-VECTOR',ISTATE)

+C      NCHP=ISTATE(2)

+C      NASSP=ISTATE(14)

+C*     total number of fuel bundles = tot. nb. of .XS 

+C      NXS=ISTATE(9)

+C      IF(NASS.NE.NASSP)CALL XABORT('NAPPPR: number of assembly do not '

+C     1  //'match between unfolded GEometries')

+C      ALLOCATE(AZONEP(NCHP))

+C      CALL LCMGET(IPMPP,'A-ZONE',AZONEP)

+C      CALL LCMSIX(IPMPP,'GEOMAP',1)

+C      CALL LCMGET(IPMPP,'STATE-VECTOR',ISTATE)

+C      NXMP=ISTATE(3)

+C      NYMP=ISTATE(4)

+C      NZMP=ISTATE(5)

+C      CALL LCMSIX(IPMPP,'GEOMAP',2)

+C      ALLOCATE(BMIXP(NXMP,NYMP,NZMP))

+C      CALL LCMGET(IPMPP,'BMIX',BMIXP)

+      IF(IMPX.GE.5) THEN

+        WRITE(6,*) 'MATEX dimension   (het):',NXD,NYD,NZD

+        WRITE(6,*) 'TRACKING dimension(het):',NXT,NYT,NZT

+        WRITE(6,*) 'MAP dimension     (het):',NXM,NYM,NZM

+      ENDIF

+* Read remaining input file

+      NCOMB=0

+      ALLOCATE(ACOMB(NASS))

+      IF(IMPX.GE.100)WRITE(6,*) 'debug: beg read input'

+      IMETH=0

+    5 CALL REDGET(INDIC,NITMA,FLOT,TEXT,DFLOT)

+        IF(TEXT.EQ.'METH') THEN

+        CALL REDGET(INDIC,NITMA,FLOT,TEXT,DFLOT)

+        IF(INDIC.NE.3) CALL XABORT('NAPPPR: character data expected.')

+        IF(TEXT.EQ.'GPPR') THEN

+          IMETH=1

+          CALL REDGET(INDIC,IFX,FLOT,TEXT,DFLOT)

+          IF(INDIC.NE.1) CALL XABORT('NAPPPR: inteGEr data expected.')

+          WRITE(TFDINF,500) IFX

+        ELSE

+          CALL XABORT('NAPPPR: '//TEXT//' is a wrong method keyword.')

+        ENDIF

+        GOTO 5

+      ELSEIF(TEXT.EQ.'POWER') THEN

+        LPOW=.TRUE.

+        CALL REDGET(INDIC,NITMA,POW,TEXT,DFLOT)

+        IF(INDIC.NE.2) CALL XABORT('NAPPPR: POWER real expected.')

+        GOTO 5

+      ELSEIF(TEXT.EQ.';') THEN

+        GOTO 50

+      ELSE

+        CALL XABORT('NAPPPR: '//TEXT//' is a wrong keyword.')

+      ENDIF

+*-----------------------------

+   50 CONTINUE

+      IF(IMPX.GE.100)WRITE(6,*) 'debug: computation begin'

+* Compute mesh X and Y for a pin-by-pin assembly

+      CALL LCMGET(IPMAC,'STATE-VECTOR',ISTATE)

+      NMIX=ISTATE(2)

+      NAMIX=NMIX/NASS/NZASS

+      IF(IMPX.GE.1) WRITE(6,*) 'Number of Mix per assembly per plane'//

+     1 ' NAMIX = ',NAMIX

+      NGFF=ISTATE(16)

+      IF(NGFF.EQ.0) CALL XABORT('NAPPPR: NGFF.NE.0 expected.')

+      CALL LCMSIX(IPMAC,'GFF',1)

+      CALL LCMSIX(IPMAC,'GFF-GEOM',1)

+      CALL LCMGET(IPMAC,'STATE-VECTOR',ISTATE)

+      NXP=ISTATE(3)

+      NYP=ISTATE(4)

+      NPIN=NXP

+      ALLOCATE(MXP(NXP+1),MYP(NYP+1))

+      CALL LCMGET(IPMAC,'MESHX',MXP)

+      CALL LCMGET(IPMAC,'MESHY',MYP)

+      DO I=2,NXP+1

+        MXP(I)=MXP(I)-MXP(1)

+      ENDDO

+      MXP(1)=0.0

+      DO I=2,NYP+1

+        MYP(I)=MYP(I)-MYP(1)

+      ENDDO

+      MYP(1)=0.0

+      CALL LCMSIX(IPMAC,'GFF-GEOM',2)

+      CALL LCMSIX(IPMAC,'GFF',2)

+* Compute IX-,IX+,IY-,IY+,IZ-,IZ+ for each assembly in core GEometry

+      IF(IMPX.GE.100) WRITE(6,*) 'debug PPR:IX-,IX+,IY-,IY+,IZ-,IZ+'

+      ALLOCATE(CODEA(NASS,6))

+      CODEA(:NASS,:6)=0

+      ICH=0

+      I1=0

+      I2=0

+      NASS2=0

+      DO IASS=1,NASS

+        CODEA(IASS,1)=NXD+1

+        CODEA(IASS,2)=0

+        CODEA(IASS,3)=NYD+1

+        CODEA(IASS,4)=0

+        CODEA(IASS,5)=NZD+1

+        CODEA(IASS,6)=0

+      ENDDO

+      DO 150 JM=1,NYM

+      DO 130 IM=1,NXM

+      LCH=.TRUE.

+      IASS=0

+      DO 100 KM=1,NZM

+      IF(BMIX(IM,JM,KM).NE.0) THEN

+        IF(LCH) THEN

+          ICH=ICH+1

+          LCH=.FALSE.

+          IASS=AZONE(ICH)

+          NASS2=MAX(NASS2,IASS)

+          DO I=1,NXD+1

+            IF(MXD(I).EQ.MXM(IM)) I1=I

+            IF(MXD(I).EQ.MXM(IM+1)) I2=I

+          ENDDO

+          CODEA(IASS,1)=MIN(I1,CODEA(IASS,1))

+          CODEA(IASS,2)=MAX(I2,CODEA(IASS,2))

+          DO I=1,NYD+1

+            IF(MYD(I).EQ.MYM(JM)) I1=I

+            IF(MYD(I).EQ.MYM(JM+1)) I2=I

+          ENDDO

+          CODEA(IASS,3)=MIN(I1,CODEA(IASS,3))

+          CODEA(IASS,4)=MAX(I2,CODEA(IASS,4))

+          DO I=1,NZD+1

+            IF(MZD(I).EQ.MZM(KM)) I1=I

+            IF(MZD(I).EQ.MZM(KM+1)) I2=I

+          ENDDO

+          CODEA(IASS,5)=MIN(I1,CODEA(IASS,5))

+          CODEA(IASS,6)=MAX(I2,CODEA(IASS,6))

+        ELSE

+          DO I=2,NZD+1

+            IF(MZD(I).EQ.MZM(KM+1)) I2=I

+          ENDDO

+          CODEA(IASS,6)=MAX(I2,CODEA(IASS,6))

+        ENDIF

+      ENDIF

+  100 CONTINUE

+  130 CONTINUE

+  150 CONTINUE

+      IF(IMPX.GE.10) THEN

+        WRITE(6,*) 'Position of the assemblies in the core'

+        WRITE(6,*) 'IX-,IX+,IY-,IY+,IZ-,IZ+'

+        do iass=1,nass

+          WRITE(6,*) 'Assembly #',iass,':',(CODEA(iass,i),i=1,6)

+        ENDDO

+      ENDIF

+      IF(NASS2.NE.NASS)CALL XABORT('NAPPPR: number of assembly do not'

+     1 //' match: NASS2.NE.NASS')

+* For all assembly perform PPR 

+      ALLOCATE(FLXP(NXP,NYP,NZASS,NG,NASS))

+      ALLOCATE(AXPOW(NXP,NYP,NASS))

+      ALLOCATE(VPIN(NXP,NYP,NASS))

+      ALLOCATE(FXYASS(NASS))

+      ALLOCATE(FACTASS(NASS))

+      ALLOCATE(PWASS(NASS),PWASS2(NASS))

+      ALLOCATE(BUNDPW(NASS,NZASS))

+      IF(.NOT.LPOW) THEN

+        CALL LCMGET(IPMAP,'BUND-PW',BUNDPW)

+      ENDIF

+      DO IASS=1,NASS

+        PWASS(IASS)=0.0

+        DO IP=1,NXP

+          DO JP=1,NYP

+            AXPOW(IP,JP,IASS)=0.0

+            VPIN(IP,JP,IASS)=0.0

+          ENDDO

+        ENDDO

+        FXYASS(IASS)=0.0

+        IF(.NOT.LPOW) THEN

+          DO K=1,NZASS

+            PWASS(IASS)=PWASS(IASS)+BUNDPW(IASS,K)

+          ENDDO

+        ENDIF

+      ENDDO

+      DO IASS=1,NASS

+*   GEt flux at core GEometry level for assembly only

+      I1=CODEA(IASS,1)

+      I2=CODEA(IASS,2)

+      J1=CODEA(IASS,3)

+      J2=CODEA(IASS,4)

+      K1=CODEA(IASS,5)

+      K2=CODEA(IASS,6)

+      NXDA=I2-I1

+      NYDA=J2-J1

+      NZDA=K2-K1

+      ALLOCATE(FLXDA(NXDA,NYDA,NZDA,NG))

+      FLXDA(:NXDA,:NYDA,:NZDA,:NG)=0.0

+      IF(NZDA.NE.NZASS) CALL XABORT('NAPPPR: incoherent number of mesh' 

+     1 //' in Z direction for an assembly: NZDA.NE.NZASS')

+      JPFLU=LCMGID(IPFLU,'FLUX')

+      IF((LNOINT).OR.(IMPX.GE.0)) THEN

+        

+        DO IG=1,NG

+          CALL LCMGDL(JPFLU,IG,FLXD)

+        DO I=I1,I2-1

+        DO J=J1,J2-1

+        DO K=K1,K2-1

+          FLXDA(I-I1+1,J-J1+1,K-K1+1,IG)=FLXD(KEYFLX(I,J,K))

+        ENDDO

+C       end K

+        ENDDO

+C       end J

+        ENDDO

+C       end I

+        ENDDO

+C       end IG

+      ENDIF

+      ALLOCATE(MXDA(NXDA+1),MYDA(NYDA+1),MZDA(NZDA+1))

+      DO I=I1,I2

+        MXDA(I-I1+1)=MXD(I)-MXD(I1)+MXP(1)

+      ENDDO

+      IF(ABS(MXDA(NXDA+1)-MXDA(1)-MXP(NXP+1)+MXP(1)).GT.0.0001) THEN

+        WRITE(6,*) 'Assembly Transport and Core meshX do not match:'// 

+     1   'Transport=',MXP(NXP+1)-MXP(1),'Core=',MXDA(NXDA+1)-MXDA(1)

+        CALL XABORT('Sizes do not match')

+      ENDIF

+      DO J=J1,J2

+        MYDA(J-J1+1)=MYD(J)-MYD(J1)+MYP(1)

+      ENDDO

+      IF(ABS(MYDA(NYDA+1)-MYDA(1)-MYP(NYP+1)+MYP(1)).GT.0.0001) THEN

+        WRITE(6,*) 'Assembly Transport and Core meshY do not match:'// 

+     1   'Transport=',MYP(NYP+1)-MYP(1),'Core=',MYDA(NYDA+1)-MYDA(1)

+        CALL XABORT('Sizes do not match')

+      ENDIF

+      DO K=K1,K2

+        MZDA(K-K1+1)=MZD(K)

+      ENDDO

+      IF(IMPX.GE.10) THEN

+        WRITE(6,*) 'Coarse Flux and mesh at assembly level'

+        WRITE(6,*) 'Mesh X:',(MXDA(I),I=1,NXDA+1)

+        WRITE(6,*) 'Mesh Y:',(MYDA(I),I=1,NYDA+1)

+        WRITE(6,*) 'Mesh Z:',(MZDA(I),I=1,NZDA+1)

+        WRITE(6,*) 'Flux:'

+        DO IG=1,NG

+        WRITE(6,*) 'Group #',IG

+        DO K=1,NZDA

+        WRITE(6,*) 'Plan #',K

+        DO J=1,NYDA

+        WRITE(6,*) (FLXDA(I,J,K,IG),I=1,NXDA)

+        ENDDO

+        ENDDO

+        ENDDO

+      ENDIF

+*   project flux at assembly level

+      ALLOCATE(FXTD(NXP,NXDA),FYTD(NYP,NYDA))

+      FXTD(:NXP,:NXDA)=0.0

+      FYTD(:NYP,:NYDA)=0.0

+*   compute fraction of the transport volumes occupied by diffusion volumes  

+      CALL NAPFTD(NXP,MXP,NXDA,MXDA,FXTD)

+      CALL NAPFTD(NYP,MYP,NYDA,MYDA,FYTD)

+!      DO IP=1,NXP

+!      DXP=MXP(IP+1)-MXP(IP)

+!      DO ID=1,NXDA

+!        IF((MXDA(ID).LE.MXP(IP)).AND.(MXDA(ID+1).GE.MXP(IP+1))) THEN

+!          FXTD(IP,ID)=1.0

+!        ELSEIF ((MXDA(ID).LE.MXP(IP)).AND.(MXDA(ID+1).GT.MXP(IP))) THEN

+!          FXTD(IP,ID)=(MXDA(ID+1)-MXP(IP))/DXP

+!        ELSEIF ((MXDA(ID).GE.MXP(IP)).AND.

+!     1          (MXDA(ID+1).LE.MXP(IP+1))) THEN

+!          FXTD(IP,ID)=(MXDA(ID+1)-MXDA(ID))/DXP

+!        ELSEIF ((MXDA(ID).LT.MXP(IP+1)).AND.

+!     1          (MXDA(ID+1).GE.MXP(IP+1))) THEN

+!          FXTD(IP,ID)=(MXP(IP+1)-MXDA(ID))/DXP

+!        ENDIF

+!      ENDDO

+!      ENDDO

+*

+!      DO IP=1,NYP

+!      DYP=MYP(IP+1)-MYP(IP)

+!      DO ID=1,NYDA

+!        IF((MYDA(ID).LE.MYP(IP)).AND.(MYDA(ID+1).GE.MYP(IP+1))) THEN

+!          FYTD(IP,ID)=1.0

+!        ELSEIF ((MYDA(ID).LE.MYP(IP)).AND.(MYDA(ID+1).GT.MYP(IP))) THEN

+!          FYTD(IP,ID)=(MYDA(ID+1)-MYP(IP))/DYP

+!        ELSEIF ((MYDA(ID).GE.MYP(IP)).AND.

+!     1          (MYDA(ID+1).LE.MYP(IP+1))) THEN

+!          FYTD(IP,ID)=(MYDA(ID+1)-MYDA(ID))/DYP

+!        ELSEIF ((MYDA(ID).LT.MYP(IP+1)).AND.

+!     1          (MYDA(ID+1).GE.MYP(IP+1))) THEN

+!          FYTD(IP,ID)=(MYP(IP+1)-MYDA(ID))/DYP

+!        ENDIF

+!      ENDDO

+!      ENDDO

+!     adds up all fluxes

+      if(LDEBUG)write(6,*)'NXP,NYP',NXP,NYP

+      DO IG=1,NG

+      IF(.NOT.LNOINT) CALL LCMGDL(JPFLU,IG,FLXD)

+      DO K=1,NZASS

+      DO IP=1,NXP

+      DO JP=1,NYP

+        FLXP(IP,JP,K,IG,IASS)=0.0

+        DO ID=1,NXDA

+        DO JD=1,NYDA

+          IF(LNOINT) THEN

+* No interpolation: use averaGE flux

+            FLXP(IP,JP,K,IG,IASS)=FLXP(IP,JP,K,IG,IASS)

+     1       +FLXDA(ID,JD,K,IG)*FXTD(IP,ID)*FYTD(JP,JD)

+* Interpolate flux with polynomial representation

+*   (only if pin and macro region have a non-nul intersection)

+          ELSEIF(FXTD(IP,ID)*FYTD(JP,JD).NE.0.0) THEN

+*     indent removed

+*     compute gauss points and weights

+      CALL ALGPT(NGPT,MAX(MXP(IP),MXDA(ID)),MIN(MXP(IP+1),MXDA(ID+1)),

+     1   ZGKSIX,WGKSIX)

+      DX=MIN(MXP(IP+1),MXDA(ID+1))-MAX(MXP(IP),MXDA(ID))

+      CALL ALGPT(NGPT,MAX(MYP(JP),MYDA(JD)),MIN(MYP(JP+1),MYDA(JD+1)),

+     1   ZGKSIY,WGKSIY)

+      DY=MIN(MYP(JP+1),MYDA(JD+1))-MAX(MYP(JP),MYDA(JD))

+      CALL ALGPT(NGPT,MZDA(K),MZDA(K+1),ZGKSIZ,WGKSIZ)

+      DZ=MZDA(K+1)-MZDA(K)

+      IF(IMPX.GE.10) then

+        WRITE(6,*) 'IP,JP:',IP,JP,FXTD(IP,ID),'ID,JD:',ID,JD,FYTD(JP,JD)

+        WRITE(6,*) 'Gauss point ZGWG:',(ZGKSIX(I),I=1,NGPT),

+     1   (WGKSIX(I),I=1,NGPT),'DX',DX

+        WRITE(6,*) 'Gauss point ZGWG:',(ZGKSIY(I),I=1,NGPT),

+     1   (WGKSIY(I),I=1,NGPT),'DY',DY

+        WRITE(6,*) 'Gauss point ZGWG:',(ZGKSIZ(I),I=1,NGPT),

+     1   (WGKSIZ(I),I=1,NGPT),'DZ',DZ

+      ENDIF

+      

+*     interpolate flux

+      FPD=0.0

+      DO IGP=1,NGPT

+        X(IGP)=MXD(I1)-MXP(1)+ZGKSIX(IGP)

+      ENDDO

+      DO JGP=1,NGPT

+        Y(JGP)=MYD(J1)-MYP(1)+ZGKSIY(JGP)

+      ENDDO

+      DO KGP=1,NGPT

+        Z(KGP)=ZGKSIZ(KGP)

+      ENDDO

+      IF(IMPX.GE.10) then

+        WRITE(6,*) 'Gauss point X:',(X(I),I=1,NGPT)

+        WRITE(6,*) 'Gauss point Y:',(Y(I),I=1,NGPT)

+        WRITE(6,*) 'Gauss point Z:',(Z(I),I=1,NGPT)

+      ENDIF

+      IF(ICHX.EQ.1) THEN

+*       Variational collocation method

+        CALL LCMLEN(IPTRK,'KN',MAXKN,ITYLCM)

+        MKN=MAXKN/(NXD*NYD*NZD)

+        ALLOCATE(KN(MAXKN))

+        CALL LCMGET(IPTRK,'KN',KN)

+        CALL LCMSIX(IPTRK,'BIVCOL',1)

+        CALL LCMLEN(IPTRK,'T',LC,ITYLCM)

+        CALL LCMGET(IPTRK,'E',E)

+        CALL LCMSIX(IPTRK,' ',2)

+        CALL VALUE2(LC,MKN,NXD,NYD,NZD,L4,X,Y,Z,MXD,MYD,MZD,

+     1  FLXD,MAT,KN,NGPT,NGPT,NGPT,E,FLUGP)

+        DEALLOCATE(KN)

+      ELSE IF(ICHX.EQ.2) THEN

+*       Raviart-Thomas finite element method

+        CALL VALUE4(IEL,NUN,NXD,NYD,NZD,X,Y,Z,MXD,MYD,MZD,

+     1  FLXD,MAT,KEYFLX,NGPT,NGPT,NGPT,FLUGP)

+      ELSE IF(ICHX.EQ.3) THEN

+*       Nodal collocation method (MCFD)

+        CALL VALUE1(IDIM,NXD,NYD,NZD,L4,X,Y,Z,MXD,MYD,MZD,

+     1  FLXD,MAT,IEL,NGPT,NGPT,NGPT,FLUGP)

+      ELSE

+        CALL XABORT('NAPPPR: INTERPOLATION NOT IMPLEMENTED.')

+      ENDIF

+      IF(IMPX.GE.10) then

+        WRITE(6,*) 'Gauss flux values:'

+        DO KGP=1,NGPT

+          WRITE(6,*) 'KGP=:',KGP

+        DO JGP=1,NGPT

+          WRITE(6,*) (FLUGP(IGP,JGP,KGP),IGP=1,NGPT)

+        ENDDO

+        ENDDO

+      ENDIF

+*     integrate flux (gauss method)

+      DO IGP=1,NGPT

+      DO JGP=1,NGPT

+      DO KGP=1,NGPT

+        FPD=FPD+FLUGP(IGP,JGP,KGP)*WGKSIX(IGP)*WGKSIY(JGP)*WGKSIZ(KGP)

+      ENDDO

+      ENDDO

+      ENDDO

+*        GEt averaGE flux

+      FPD=FPD/DX/DY/DZ

+      if(LDEBUG)write(6,*)'FLXP,FPD,FXTD,FYTD',FLXP(IP,JP,K,IG,IASS),

+     1                     FPD,FXTD(IP,ID),FYTD(JP,JD)

+   

+      FLXP(IP,JP,K,IG,IASS)=FLXP(IP,JP,K,IG,IASS)

+     1                     +FPD*FXTD(IP,ID)*FYTD(JP,JD)

+      if(LDEBUG)write(6,*)'FLXP after',FLXP(IP,JP,K,IG,IASS)

+*     indent back

+          ENDIF

+        ENDDO

+        ENDDO

+      ENDDO

+      ENDDO

+      ENDDO

+      ENDDO

+*

+      DEALLOCATE(FXTD,FYTD)

+      DEALLOCATE(MXDA,MYDA,MZDA)

+      DEALLOCATE(FLXDA)

+      IF(IMPX.GE.100)WRITE(6,*) 'debug PPR:projection flux for one '

+     1  //'assem end'

+!     end of DO IASS=1,NASS

+      ENDDO

+      IF(IMPX.GE.100)WRITE(6,*) 'debug PPR:projection flux for all '

+     1  //'assem end'

+* GPPR

+      IF(IMETH.EQ.1) THEN

+        IF(IMPX.GE.100)WRITE(6,*) 'debug PPR:',TFDINF

+*   GEt Volume, phi^t,inf_p and phi^d,inf_m,p from macrolib of fuel

+*      Note: if homoGEneous (normal PPR), m=1

+        ALLOCATE(VOLM(NGFF),HFM(NMIX,NGFF,NG),

+     1   FTINFM(NMIX,NGFF,NG),FDINFM(NMIX,NGFF,NG))

+        ALLOCATE(VOL(NPIN,NPIN,NZASS,NASS))

+        ALLOCATE(HF(NPIN,NPIN,NZASS,NG,NASS))

+        ALLOCATE(FTINF(NPIN,NPIN,NZASS,NG,NASS))

+        ALLOCATE(FDINF(NPIN,NPIN,NZASS,NG,NASS))

+        ALLOCATE(BMIXP(NPIN*NPIN))

+        VOL(:NPIN,:NPIN,:NZASS,:NASS)=0.0

+        HF(:NPIN,:NPIN,:NZASS,:NG,:NASS)=0.0

+        FTINF(:NPIN,:NPIN,:NZASS,:NG,:NASS)=0.0

+        FDINF(:NPIN,:NPIN,:NZASS,:NG,:NASS)=0.0

+

+        if(LDEBUG) call LCMLIB(IPMAC)

+        CALL LCMSIX(IPMAC,'GFF',1)

+        if(LDEBUG) call LCMLIB(IPMAC)

+        CALL LCMGET(IPMAC,'VOLUME',VOLM)

+        CALL LCMGET(IPMAC,'H-FACTOR',HFM)

+        CALL LCMGET(IPMAC,'NWT0',FTINFM)

+        CALL LCMGET(IPMAC,TFDINF,FDINFM)

+        CALL LCMSIX(IPMAC,'GFF-GEOM',1)

+        CALL LCMGET(IPMAC,'MIX',BMIXP)

+        CALL LCMSIX(IPMAC,'GFF-GEOM',2)

+        CALL LCMSIX(IPMAC,'GFF',2)

+

+        DO IG=1,NG

+        

+        DO IASS=1,NASS

+          K1=CODEA(IASS,5)

+          DO K=1,NZASS

+!  NAMIX = 1 for homogeneous assembly 

+!        > 1 for heterogeneous assembly

+!             Note that all values of HFM are identical 

+!             for all the mix in a specific assembly

+          IMIX=(IASS-1+(K-1)*NASS)*NAMIX+1

+          DO J=1,NPIN

+            DO I=1,NPIN

+            IPIN=I+(J-1)*NPIN

+            HF(I,J,K,IG,IASS)=HFM(IMIX,BMIXP(IPIN),IG)

+            FTINF(I,J,K,IG,IASS)=FTINFM(IMIX,BMIXP(IPIN),IG)

+            FDINF(I,J,K,IG,IASS)=FDINFM(IMIX,BMIXP(IPIN),IG)

+            VOL(I,J,K,IASS)=(MXP(I+1)-MXP(I))*(MYP(J+1)-MYP(J))

+     3         *(MZM(K1+K)-MZM(K1+K-1))

+            ENDDO

+          ENDDO

+          ENDDO

+!       end of DO IASS=1,NASS

+        ENDDO

+!       end of DO IG=1,NG

+        ENDDO

+        IF(IMPX.GE.6) then

+        DO iass=1,nass

+          WRITE(6,*) 'XS for assembly #',IASS

+          DO k=1,nzass

+           WRITE(6,*) 'Plane #',K

+          DO ig=1,ng

+           WRITE(6,*) 'group #',ig

+           WRITE(6,*) 'HF #'

+          DO j=1,npin

+           WRITE(6,*) (HF(I,J,K,ig,iass),I=1,NPIN)

+          ENDDO

+          WRITE(6,*) 'FTINF #'

+          DO j=1,npin

+           WRITE(6,*) (FTINF(I,J,K,ig,iass),I=1,NPIN)

+          ENDDO

+          WRITE(6,*) 'FLXP #'

+          DO j=1,npin

+           WRITE(6,*) (FLXP(I,J,K,ig,iass),I=1,NPIN)

+          ENDDO

+          WRITE(6,*) 'FDINF #'

+          DO j=1,npin

+           WRITE(6,*) (FDINF(I,J,K,ig,iass),I=1,NPIN)

+          ENDDO

+!           end of do ig=1,ng

+          ENDDO

+          WRITE(6,*) 'VOL #'

+          DO j=1,npin

+           WRITE(6,*) (VOL(I,J,K,iass),I=1,NPIN)

+          ENDDO

+          ENDDO

+        ENDDO

+        ENDIF

+* Print and save reaction rates

+        IF(IMPX.GE.100)WRITE(6,*) 'debug: Print and save reaction rates'

+        POWTOT=0.0

+        DO IASS=1,NASS

+          PWASS2(IASS)=0.0

+          K1=CODEA(IASS,5)

+          DO K=1,NZASS

+            DO J=1,NPIN

+            DO I=1,NPIN

+              VTOT=VTOT+VOL(I,J,K,IASS)

+            DO IG=1,NG

+              POWTOT=POWTOT+HF(I,J,K,IG,IASS)*FTINF(I,J,K,IG,IASS)

+     1         *FLXP(I,J,K,IG,IASS)/FDINF(I,J,K,IG,IASS)

+     2         *VOL(I,J,K,IASS)

+              PWASS2(IASS)=PWASS2(IASS)

+     1         +HF(I,J,K,IG,IASS)*FTINF(I,J,K,IG,IASS)

+     1         *FLXP(I,J,K,IG,IASS)/FDINF(I,J,K,IG,IASS)

+     2         *VOL(I,J,K,IASS)

+            ENDDO

+            ENDDO

+            ENDDO

+          ENDDO

+        ENDDO

+        IF(IMPX.GE.2) WRITE(6,*) 'POWTOT:',POWTOT

+        IF(LPOW) THEN

+          DO IASS=1,NASS

+            FACTASS(IASS)=POW/POWTOT

+          ENDDO

+        ELSE

+          DO IASS=1,NASS

+            FACTASS(IASS)=PWASS(IASS)/PWASS2(IASS)

+          ENDDO

+        ENDIF

+        IF(IMPX.GE.2) WRITE(6,*) 'FACTASS:',(FACTASS(I),I=1,NASS)

+        ALLOCATE(HFA(NPIN,NPIN,NZASS))

+        ALLOCATE(FXYZ(NZASS))

+        ALLOCATE(PLINMAXZ(NZASS))

+        DO K=1,NZASS

+          FXYZ(K)=0.0

+          PLINMAXZ(K)=0.0

+        ENDDO

+        JPMAP=LCMLID(IPMAP,'ASSEMBLY',NASS)

+        IAX=0

+        JAX=1

+        DO IASS=1,NASS

+        K1=CODEA(IASS,5)

+        IAX=IAX+1

+        IF(IAX.GT.NBAX(JAX)) THEN

+          IAX=1

+          JAX=JAX+1

+        ENDIF

+        WRITE(LABEL,'(A4,A4)') NAMY(JAX),NAMX(IBAX(JAX)+IAX-1)

+        IF(IMPX.GE.5) THEN

+          WRITE(6,*) 'Reaction rates for assembly #',IASS,' Label:',

+     1     LABEL

+        ENDIF

+        DO K=1,NZASS

+        IF(IMPX.GE.5) WRITE(6,*) 'Plane #',K

+        DO J=1,NPIN

+        DO I=1,NPIN

+        HFA(I,J,K)=0.0

+        DO IG=1,NG

+          HFA(I,J,K)=HFA(I,J,K)+HF(I,J,K,IG,IASS)*FTINF(I,J,K,IG,IASS)

+     1        *FLXP(I,J,K,IG,IASS)/FDINF(I,J,K,IG,IASS)

+     2        *FACTASS(IASS)

+     2        *VOL(I,J,K,IASS)

+          IF((PLINMAXZ(K)*(MZM(K1+K)-MZM(K1+K-1))).LT.HFA(I,J,K)) THEN

+            PLINMAXZ(K)=HFA(I,J,K)/(MZM(K1+K)-MZM(K1+K-1))

+          ENDIF

+!       end of DO IG=1,NG

+        ENDDO

+!       end of I=1,NPIN

+        ENDDO

+          IF(IMPX.GE.5) WRITE(6,*) (HFA(I,J,K),I=1,NPIN)

+!       end of J=1,NPIN

+        ENDDO

+!       end of DO K=1,NZASS

+        ENDDO

+*

+        KPMAP=LCMDIL(JPMAP,IASS)

+        CALL LCMPTC(KPMAP,'LABEL',8,LABEL)

+        CALL LCMPUT(KPMAP,'PIN-POWER',NPIN*NPIN*NZASS,2,HFA)

+        CALL LCMPUT(KPMAP,'FLUX',NPIN*NPIN*NZASS*NG,2,

+     1              FLXP(1,1,1,1,IASS))

+        POWASS=0.0

+        DO I=1,NPIN

+        DO J=1,NPIN

+        DO K=1,NZASS

+          POWASS=POWASS+HFA(I,J,K)!power of the assembly iass

+          VPIN(I,J,IASS)=VPIN(I,J,IASS)+VOL(I,J,K,IASS)

+          !pin volume

+        ENDDO

+        ENDDO

+        ENDDO

+        DO I=1,NPIN

+        DO J=1,NPIN

+        DO K=1,NZASS

+          AXPOW(I,J,IASS)=HFA(I,J,K)

+     2    +AXPOW(I,J,IASS)

+          !AXPOW:axially integrated pin power per pin

+          !normalized to the pin mean power

+          IF(PMAX.LT.HFA(I,J,K)) THEN

+            PMAX=HFA(I,J,K)!maximal 3D local power

+          ENDIF

+        ENDDO

+        AXPOW(I,J,IASS)=AXPOW(I,J,IASS)/(POWASS/NPIN/NPIN)

+        ENDDO

+        ENDDO

+*

+        IF(IMPX.GE.2) WRITE(6,*) 'Power of assembly #',IASS,":",POWASS

+        DO I=1,NPIN

+          DO J=1,NPIN

+            IF(IMPX.GE.2) THEN

+              WRITE(6,*) 'AXPOW for assembly #',IASS

+              NBPIN=NBPIN+1

+              WRITE(6,*) 'ASS:',IASS,'PIN #',NBPIN,":",AXPOW(I,J,IASS)

+            ENDIF

+            PINPOW=AXPOW(I,J,IASS)*VPIN(I,J,IASS)

+            IF(HOTPINPOW.LT.PINPOW) THEN

+              HOTPINPOW=PINPOW

+        !power of the hot pin normalized to the pin mean power

+            ENDIF

+            IF(FXYASS(IASS).LT.AXPOW(I,J,IASS)) THEN

+              FXYASS(IASS)=AXPOW(I,J,IASS)

+            ENDIF

+          ENDDO

+        ENDDO

+        NBPIN=0

+*

+        IF(IMPX.GE.1) THEN

+          WRITE(6,*) 'Fxy for assembly #',IASS,":",FXYASS(IASS)

+        ENDIF

+        CALL LCMPUT(KPMAP,'ASS-POWER',1,2,POWASS)

+!       end of DO IASS=1,NASS

+        ENDDO

+!     end of IF(IMETH.EQ.1) THEN

+      ENDIF

+*

+      FQ=PMAX

+      FXY=HOTPINPOW

+*

+      IF(IMPX.GE.0) THEN

+        WRITE(6,*) 'FQ=',FQ

+        WRITE(6,*) 'FXY=',FXY

+      DO K=1,NZASS

+        FXYZ(K)=PLINMAXZ(K)

+        IF(IMPX.GE.0) WRITE(6,*) 'Plane #',K,'---> FXYZ(Z)=',FXYZ(K)

+      ENDDO

+      ENDIF

+      CALL LCMPUT(IPMAP,'FQ',1,2,FQ)

+      CALL LCMPUT(IPMAP,'FXY',1,2,FXY)

+      CALL LCMPUT(IPMAP,'FXYZ',NZASS,2,FXYZ)

+      CALL LCMPUT(IPMAP,'FXYASS',IASS,2,FXYASS)

+      CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)

+      ISTATE(17)=NZASS

+      CALL LCMPUT(IPMAP,'STATE-VECTOR',NSTATE,1,ISTATE)

+!

+      IF(IMPX.GE.100)WRITE(6,*) 'debug: beging deallacate'

+

+      DEALLOCATE(FLXP,FLXD)

+      DEALLOCATE(MXP,MYP)

+

+      DEALLOCATE(CODEA)

+      IF(IMETH.EQ.1) THEN 

+        DEALLOCATE(VOLM,HFM,FTINFM,FDINFM)

+        DEALLOCATE(VOL,HF,FTINF,FDINF,AXPOW,FXYASS)

+        DEALLOCATE(HFA,FXYZ,PLINMAXZ,VPIN)

+        DEALLOCATE(FACTASS,PWASS,PWASS2)

+        DEALLOCATE(BUNDPW)

+      ENDIF

+      DEALLOCATE(ACOMB)

+      DEALLOCATE(AZONE)

+      DEALLOCATE(NAMX,NAMY)

+      DEALLOCATE(BMIX,BMIXP)

+      DEALLOCATE(MXM,MYM,MZM)

+      DEALLOCATE(NBAX,IBAX)

+      DEALLOCATE(KEYFLX,MAT)

+      DEALLOCATE(MXD,MYD,MZD)

+

+      RETURN

+  500 FORMAT(5HFINF_,I3.3,4H    )

+      END

diff --git a/Donjon/src/NCR.f b/Donjon/src/NCR.f
new file mode 100644
index 0000000..389e70b
--- /dev/null
+++ b/Donjon/src/NCR.f
@@ -0,0 +1,410 @@
+*DECK NCR
+      SUBROUTINE NCR(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+*  Recover and interpolate microlib and macrolib information from one
+*  or many multicompo database objects.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert and R. Chambon
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The NCR: calling specifications are:
+* MLIB := NCR: [ { MLIB | MLIB2 } ] CPONAM1 [[ CPONAM2 ]] [ MAPFL ]
+*   :: (ncr\_data) ;
+* where
+*   MLIB : name of a \emph{microlib} (type L\_LIBRARY) or \emph{macrolib} 
+*     (type L\_MACROLIB) containing the interpolated data. If this object also 
+*     appears on the RHS of structure (NCR:, it is open in modification mode 
+*     and updated.
+*   MLIB2 : name of an optional \emph{microlib} object whose content is copied 
+*     on MLIB.
+*   CPONAM1 : name of the \emph{multicompo} data structure (L\_MULTICOMPO 
+*     signature).
+*   CPONAM2 : name of an additional \emph{multicompo} data structure 
+*     (L\_MULTICOMPO signature). This object is optional.
+*   MAPFL : name of the \emph{map} object containing fuel regions description, 
+*     global and local parameter information (burnup, fuel/coolant temperatures,
+*     coolant density, etc). Keyword TABLE is expected in (ncr\_data).
+*   ncr\_data : input data structure containing interpolation information.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXISD=200
+      INTEGER, PARAMETER::NSTATE=40
+      REAL B2, FLOTT
+      INTEGER I, I0, IACCS, ILENG, IMPX, INDIC, ITER, ITH, ITYLCM, ITYP,
+     & MAXFEL, MAXISO, MAXNIS, NB, NCAL, NCH, NCOMB, NFUEL, NGFF, NALBP,
+     & IDF, NGRP, NITMA, NMIL, NMIX, NPARM
+      CHARACTER TEXT12*12,HSMG*131,HSIGN*12,NAMDIR*12
+      LOGICAL LMACRO,LCUBIC,LXS,LRES,LPURE
+      DOUBLE PRECISION DFLOTT
+      INTEGER ISTATE(NSTATE)
+      TYPE(C_PTR) IPLIB,IPLIB2,IPMAP,IPCPO,JPCPO
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: MIXC,NISO
+      INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: HISO
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: TERP,CONC
+      LOGICAL, ALLOCATABLE, DIMENSION(:) :: LISO
+*----
+*  PARAMETER VALIDATION
+*----
+      IF(NENTRY.LE.1) CALL XABORT('NCR: MINIMUM OF 2 OBJECTS EXPECTED.')
+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('NCR: MICRO'
+     1 //'LIB LCM OBJECT EXPECTED AT LHS.')
+      IF((JENTRY(1).NE.0).AND.(JENTRY(1).NE.1)) CALL XABORT('NCR: MICRO'
+     1 //'LIB IN CREATE OR MODIFICATION MODE EXPECTED.')
+      IACCS=JENTRY(1)
+      IPLIB=KENTRY(1)
+      IPLIB2=C_NULL_PTR
+      IPMAP=C_NULL_PTR
+      NGRP=0
+      NMIX=0
+      IF(IACCS.EQ.1) THEN
+        CALL LCMGTC(IPLIB,'SIGNATURE',12,HSIGN)
+        IF(HSIGN.EQ.'L_LIBRARY') THEN
+          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+          NGRP=ISTATE(3)
+          NMIX=ISTATE(1)
+        ELSE IF(HSIGN.EQ.'L_MACROLIB') THEN
+          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+          NGRP=ISTATE(1)
+          NMIX=ISTATE(2)
+        ELSE
+          TEXT12=HENTRY(1)
+          CALL XABORT('NCR: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     1    '. L_LIBRARY OR L_MACROLIB EXPECTED.')
+        ENDIF
+      ENDIF
+      DO 10 I=2,NENTRY
+        IF((IENTRY(I).NE.1).AND.(IENTRY(I).NE.2)) CALL XABORT('NCR: '
+     1 //'LCM OBJECTS EXPECTED AT RHS.')
+        IF(JENTRY(I).NE.2) CALL XABORT('NCR: LCM OBJECTS IN READ-ONLY '
+     1 //'MODE EXPECTED AT RHS.')
+        CALL LCMGTC(KENTRY(I),'SIGNATURE',12,HSIGN)
+        IF(HSIGN.EQ.'L_LIBRARY') THEN
+          IF(C_ASSOCIATED(IPLIB2)) CALL XABORT('NCR: ONLY ONE MICROLIB'
+     1    //' EXPECTED AT RHS.')
+          IPLIB2=KENTRY(I)
+          GO TO 10
+        ELSE IF(HSIGN.EQ.'L_MACROLIB') THEN
+          CALL XABORT('NCR: ANOTHER MACROLIB NOT EXPECTED AT RHS.')
+        ELSE IF(HSIGN.EQ.'L_MAP') THEN
+          IF(I.NE.NENTRY) CALL XABORT('NCR: FUEL-MAP EXPECTED TO BE TH'
+     1    //'E LAST OBJECT.')
+          IF(NENTRY.LT.3) CALL XABORT('NCR: MISSING MULTICOMPO OBJECT.')
+          IPMAP=KENTRY(NENTRY)
+          CALL LCMLEN(IPMAP,'FLMIX',NMIX,ITYP)
+        ELSE IF(HSIGN.NE.'L_MULTICOMPO') THEN
+          TEXT12=HENTRY(I)
+          CALL XABORT('NCR: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     1   '. L_MULTICOMPO EXPECTED.')
+        ENDIF
+   10 CONTINUE
+*----
+*  READ THE INPUT DATA
+*----
+      LMACRO=.FALSE.
+      LXS=.FALSE.
+      LCUBIC=.FALSE.
+      LRES=.FALSE.
+      LPURE=.FALSE.
+      B2=0.0
+      MAXFEL=0
+      ITER=-1
+      IPCPO=C_NULL_PTR
+      IMPX=1
+   20 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+      IF(INDIC.NE.3) CALL XABORT('NCR: CHARACTER DATA EXPECTED(1).')
+   30 IF(TEXT12.EQ.'EDIT') THEN
+*       READ THE PRINT INDEX.
+        CALL REDGET(INDIC,IMPX,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1) CALL XABORT('NCR: INTEGER DATA EXPECTED(1).')
+      ELSE IF(TEXT12.EQ.'NMIX') THEN
+*       READ THE MAXIMUM NUMBER OF MATERIAL MIXTURES.
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1) CALL XABORT('NCR: INTEGER DATA EXPECTED(2).')
+        IF(NITMA.LT.NMIX) THEN
+           WRITE(HSMG,'(20HNCR: NMIX MUST BE >=,I8)') NMIX
+           CALL XABORT(HSMG)
+        ENDIF
+        NMIX=NITMA
+      ELSE IF(TEXT12.EQ.'MACRO') THEN
+        IF(LMACRO) CALL XABORT('NCR: ONLY ONE MACRO KEYWORD EXPECTED.')
+        LMACRO=.TRUE.
+      ELSE IF(TEXT12.EQ.'MICRO') THEN
+        LMACRO=.FALSE.
+      ELSE IF(TEXT12.EQ.'LINEAR') THEN
+        LCUBIC=.FALSE.
+      ELSE IF(TEXT12.EQ.'CUBIC') THEN
+        LCUBIC=.TRUE.
+      ELSE IF(TEXT12.EQ.'ALLX') THEN
+        LXS=.TRUE.
+        CALL REDGET(INDIC,MAXFEL,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1) CALL XABORT('NCR: INTEGER DATA EXPECTED(3).')
+      ELSE IF(TEXT12.EQ.'RES') THEN
+        IF((IACCS.EQ.0).AND.(.NOT.C_ASSOCIATED(IPLIB2))) THEN
+          CALL XABORT('NCR: RHS MICROLIB EXPECTED WITH RES OPTION.')
+        ENDIF
+        LRES=.TRUE.
+      ELSE IF(TEXT12.EQ.'PURE') THEN
+        LPURE=.TRUE.
+      ELSE IF(TEXT12.EQ.'COMPO') THEN
+        IF(NMIX.EQ.0) CALL XABORT('NCR: ZERO NUMBER OF MIXTURES.')
+        IF(C_ASSOCIATED(IPMAP)) THEN
+          WRITE(IOUT,'(/43H NCR: ***WARNING*** A FUEL MAP IS SET AT RH,
+     1    26HS; KEYWORD TABLE EXPECTED.)')
+        ENDIF
+        IF((IACCS.EQ.0).AND.(C_ASSOCIATED(IPLIB2))) THEN
+          CALL LCMEQU(IPLIB2,IPLIB)
+          IACCS=1
+        ENDIF
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3) CALL XABORT('NCR: CHARACTER DATA EXPECTED(2).')
+        CALL REDGET(INDIC,NITMA,FLOTT,NAMDIR,DFLOTT)
+        IF(INDIC.NE.3) CALL XABORT('NCR: CHARACTER DATA EXPECTED(3).')
+        I0=0
+        DO 50 I=2,NENTRY
+          IF(C_ASSOCIATED(KENTRY(I),IPLIB2)) GO TO 50
+          IF(TEXT12.EQ.HENTRY(I)) THEN
+            CALL LCMGTC(KENTRY(I),'SIGNATURE',12,TEXT12)
+            IF(TEXT12.EQ.'L_MULTICOMPO') THEN
+              IPCPO=KENTRY(I)
+            ELSE
+              CALL XABORT('NCR: WRONG SIGNATURE ('//TEXT12//').')
+            ENDIF
+            ITH=I
+            GO TO 60
+          ENDIF
+   50   CONTINUE
+        CALL XABORT('NCR: MULTICOMPO '//TEXT12//' NOT FOUND.')
+   60   IF(IMPX.GT.0) WRITE(IOUT,320) HENTRY(I),NAMDIR
+        CALL LCMLEN(IPCPO,NAMDIR,ILENG,ITYLCM)
+        IF((ILENG.EQ.0).OR.(ITYLCM.NE.0)) THEN
+          CALL LCMLIB(IPCPO)
+          CALL XABORT('NCR: NO '//NAMDIR//' DIRECTORY TO STEP.')
+        ENDIF
+        JPCPO=LCMGID(IPCPO,NAMDIR)
+        CALL LCMGET(JPCPO,'STATE-VECTOR',ISTATE)
+        IF(NGRP.EQ.0) THEN
+          NGRP=ISTATE(2)
+        ELSE IF(NGRP.NE.ISTATE(2)) THEN
+          WRITE(HSMG,'(9H NCR: THE,I4,29H-TH MULTICOMPO HAS AN INVALID,
+     1    25H NUMBER OF ENERGY GROUPS.)') ITH
+          CALL XABORT(HSMG)
+        ENDIF
+        IF(ISTATE(12).NE.2006) CALL XABORT('NCR: 2006 MULTICOMPO SPECI'
+     1   //'F EXPECTED.')
+        NMIL=ISTATE(1)
+        NCAL=ISTATE(3)
+        NGFF=ISTATE(14)
+        NALBP=ISTATE(15)
+        IDF=ISTATE(16)
+        IF(NGFF.EQ.-1) CALL XABORT('NCR: GFF INFO MISSING.')
+        IF(NALBP.EQ.-1) CALL XABORT('NCR: PHYSICAL ALBEDO MISSING.')
+        IF(IDF.EQ.-1) CALL XABORT('NCR: SURF-CURRENT INFO MISSING.')
+        ALLOCATE(MIXC(NMIX),TERP(NCAL,NMIX),NISO(NMIX),LISO(NMIX),
+     1  HISO(2,NMIX,MAXISD),CONC(NMIX,MAXISD))
+*
+        CALL NCRDRV(JPCPO,LCUBIC,NMIX,IMPX,NMIL,NCAL,ITER,MAXNIS,MIXC,
+     1  TERP,NISO,LISO,HISO,CONC)
+        GO TO 100
+      ELSE IF(TEXT12.EQ.'TABLE') THEN
+        IF(.NOT.C_ASSOCIATED(IPMAP)) CALL XABORT('NCR: MISSING FUEL-MA'
+     1  //'P OBJECT.')
+        ISTATE(:NSTATE)=0
+        CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+        NB=ISTATE(1)
+        NCH=ISTATE(2)
+        NCOMB=ISTATE(3)
+        NGRP=ISTATE(4)
+        NFUEL=ISTATE(7)
+        NPARM=ISTATE(8)
+        IF(NCOMB.EQ.0)CALL XABORT('NCR: NUMBER OF COMBUSTION ZONES NO'
+     1   //'T YET DEFINED IN THE FUEL MAP NCOMB=0.')
+        IF((IACCS.EQ.0).AND.(C_ASSOCIATED(IPLIB2))) THEN
+          CALL LCMEQU(IPLIB2,IPLIB)
+          IACCS=1
+        ENDIF
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3) CALL XABORT('NCR: CHARACTER DATA EXPECTED(2).')
+        CALL REDGET(INDIC,NITMA,FLOTT,NAMDIR,DFLOTT)
+        IF(INDIC.NE.3) CALL XABORT('NCR: CHARACTER DATA EXPECTED(3).')
+        I0=0
+        DO 80 I=2,NENTRY
+          IF((C_ASSOCIATED(KENTRY(I),IPLIB2)).OR.
+     1       (C_ASSOCIATED(KENTRY(I),IPMAP))) GO TO 80
+          IF(TEXT12.EQ.HENTRY(I)) THEN
+            CALL LCMGTC(KENTRY(I),'SIGNATURE',12,TEXT12)
+            IF(TEXT12.EQ.'L_MULTICOMPO') THEN
+              IPCPO=KENTRY(I)
+            ELSE
+              CALL XABORT('NCR: WRONG SIGNATURE ('//TEXT12//').')
+            ENDIF
+            ITH=I
+            GO TO 90
+          ENDIF
+   80   CONTINUE
+        CALL XABORT('NCR: MULTICOMPO '//TEXT12//' NOT FOUND.')
+   90   IF(IMPX.GT.0) WRITE(IOUT,320) HENTRY(I),NAMDIR
+        CALL LCMLEN(IPCPO,NAMDIR,ILENG,ITYLCM)
+        IF((ILENG.EQ.0).OR.(ITYLCM.NE.0)) THEN
+          CALL LCMLIB(IPCPO)
+          CALL XABORT('NCR: NO '//NAMDIR//' DIRECTORY TO STEP.')
+        ENDIF
+        JPCPO=LCMGID(IPCPO,NAMDIR)
+        ISTATE(:NSTATE)=0
+        CALL LCMGET(JPCPO,'STATE-VECTOR',ISTATE)
+        IF(ISTATE(12).NE.2006) CALL XABORT('NCR: 2006 MULTICOMPO SPECI'
+     1   //'F EXPECTED.')
+        IF(NGRP.NE.ISTATE(2)) THEN
+          WRITE(HSMG,'(9H NCR: THE,I4,29H-TH MULTICOMPO HAS AN INVALID,
+     1    25H NUMBER OF ENERGY GROUPS.)') ITH
+          CALL XABORT(HSMG)
+        ENDIF
+        NMIL=ISTATE(1)
+        NCAL=ISTATE(3)
+        NGFF=ISTATE(14)
+        NALBP=ISTATE(15)
+        IDF=ISTATE(16)
+        IF(NGFF.EQ.-1) CALL XABORT('NCR: GFF INFO MISSING.')
+        IF(NALBP.EQ.-1) CALL XABORT('NCR: PHYSICAL ALBEDO MISSING.')
+        ALLOCATE(MIXC(NMIX),TERP(NCAL,NMIX),NISO(NMIX),LISO(NMIX),
+     1  HISO(2,NMIX,MAXISD),CONC(NMIX,MAXISD))
+*
+        CALL NCRRGR(JPCPO,IPMAP,LCUBIC,NMIX,IMPX,NMIL,NCAL,NCH,
+     1  NB,NFUEL,NPARM,ITER,MAXNIS,MIXC,TERP,NISO,LISO,HISO,CONC)
+        GO TO 100
+      ELSE IF(TEXT12.EQ.'LEAK') THEN
+        CALL REDGET(INDIC,NITMA,B2,TEXT12,DFLOTT)
+        IF(INDIC.NE.2) CALL XABORT('NCR: REAL DATA EXPECTED.')
+      ELSE
+        CALL XABORT('NCR: '//TEXT12//' IS AN INVALID KEYWORD.')
+      ENDIF
+      GO TO 20
+*----
+*  BUILD THE INTERPOLATED MACROLIB OR MICROLIB
+*----
+ 100  IF(LMACRO) THEN
+*       build a macrolib
+        CALL NCRMAC(MAXNIS,IPLIB,JPCPO,IACCS,NMIL,NMIX,NGRP,NGFF,NALBP,
+     1  IDF,IMPX,NCAL,TERP,NISO,LISO,HISO,CONC,MIXC,LRES,LPURE,B2)
+        IF(IMPX.GT.0) THEN
+          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+          WRITE(IOUT,290) IMPX,(ISTATE(I),I=1,9),ISTATE(12),ISTATE(16)
+        ENDIF
+      ELSE
+*       build a microlib
+        IF(IACCS.EQ.0)THEN
+          MAXISO=MAXISD*NMIX
+        ELSE
+          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+          MAXISO=MAX(MAXISD*NMIX,ISTATE(2))
+        ENDIF
+        CALL NCRLIB(MAXNIS,MAXISO,MAXFEL,IPLIB,JPCPO,IACCS,NMIL,NMIX,
+     1  NGRP,NGFF,NALBP,IDF,IMPX,NCAL,TERP,NISO,LISO,HISO,CONC,MIXC,
+     2  LXS,LRES,LPURE,B2)
+        IF(IMPX.GT.0) THEN
+          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+          WRITE(IOUT,300) IMPX,(ISTATE(I),I=1,12)
+          WRITE(IOUT,310) (ISTATE(I),I=13,15),(ISTATE(I),I=17,24)
+        ENDIF
+      ENDIF
+*
+      DEALLOCATE(CONC,HISO,LISO,NISO,TERP,MIXC)
+*----
+*  CONTINUE DATA PROCESSING
+*----
+      IF(ITER.EQ.0) THEN
+        GO TO 200
+      ELSE IF(ITER.EQ.1) THEN
+        TEXT12='COMPO'
+        GO TO 30
+      ELSE IF(ITER.EQ.2) THEN
+        TEXT12='TABLE'
+        GO TO 30
+      ENDIF
+*----
+*  LEAVE NCR:
+*----
+  200 IF(IMPX.GT.2) CALL LCMLIB(IPLIB)
+      RETURN
+*
+  290 FORMAT(/8H OPTIONS/8H -------/
+     1 7H IMPX  ,I6,30H   (0=NO PRINT/1=SHORT/2=MORE)/
+     2 7H NGROUP,I6,28H   (NUMBER OF ENERGY GROUPS)/
+     3 7H NBMIX ,I6,39H   (NUMBER OF MIXTURES IN THE MACROLIB)/
+     4 7H NANISO,I6,34H   (MAXIMUM SCATTERING ANISOTROPY)/
+     5 7H NIFISS,I6,47H   (MAXIMUM NUMBER OF FISSILE ISOTOPES IN A MIX,
+     6 5HTURE)/
+     7 7H NEDMAC,I6,34H   (NUMBER OF CROSS SECTION EDITS)/
+     8 7H ITRANC,I6,45H   (0=NO TRANSPORT CORRECTION/1=APOLLO TYPE/2,
+     9 43H=RECOVER FROM LIBRARY/4=LEAKAGE CORRECTION)/
+     1 7H NLG   ,I6,39H   (NUMBER OF DELAYED PRECURSOR GROUPS)/
+     2 7H NALBP ,I6,31H   (0: NO PHYSICAL ALBEDO INFO)/
+     3 7H ILEAK ,I6,40H   (1=DIFF AVAILABLE; 2=DIFFX AVAILABLE)/
+     4 7H IDF   ,I6,47H   (0=NO INFO/1=ALBS INFO/2=FLUX GAP INFO/3=ADF,
+     5 10H GAP INFO)/
+     6 7H NGFF  ,I6,39H   (0: NO GENERALIZED FORM FACTOR INFO))
+  300 FORMAT(/8H OPTIONS/8H -------/
+     1 7H IMPX  ,I6,30H   (0=NO PRINT/1=SHORT/2=MORE)/
+     2 7H MAXMIX,I6,31H   (MAXIMUM NUMBER OF MIXTURES)/
+     3 7H NBISO ,I6,36H   (NUMBER OF ISOTOPES OR MATERIALS)/
+     4 7H NGRP  ,I6,28H   (NUMBER OF ENERGY GROUPS)/
+     5 7H NL    ,I6,30H   (NUMBER OF LEGENDRE ORDERS)/
+     6 7H ITRANC,I6,45H   (0=NO TRANSPORT CORRECTION/1=APOLLO TYPE/2,
+     7 57H=RECOVER FROM LIBRARY/3=WIMS-D TYPE/4=LEAKAGE CORRECTION)/
+     8 7H IPROB ,I6,23H   (0=DIRECT/1=ADJOINT)/
+     9 7H ITIME ,I6,28H   (1=STEADY-STATE/2=PROMPT)/
+     1 7H NLIB  ,I6,32H   (NUMBER OF SETS OF LIBRARIES)/
+     2 7H NGF   ,I6,48H   (NUMBER OF FAST GROUP WITHOUT SELF-SHIELDING)/
+     3 7H IGRMAX,I6,41H   (LAST GROUP INDEX WITH SELF-SHIELDING)/
+     4 7H NDEPL ,I6,33H   (NUMBER OF DEPLETING ISOTOPES)/
+     5 7H NCOMB ,I6,33H   (NUMBER OF DEPLETING MIXTURES))
+  310 FORMAT(7H NEDMAC,I6,34H   (NUMBER OF CROSS SECTION EDITS)/
+     1 7H NBMIX ,I6,23H   (NUMBER OF MIXTURES)/
+     2 7H NRES  ,I6,40H   (NUMBER OF SETS OF RESONANT MIXTURES)/
+     3 7H IPROC ,I6,48H   (-1=SKIP LIBRARY PROCESSING/0=DILUTION INTERP,
+     4 48HOLATION/1=USE PHYSICAL TABLES/2=BUILD A DRAGLIB/,
+     5 55H3=COMPUTE CALENDF TABLES/4=COMPUTE SLOWING-DOWN TABLES)/
+     6 7H IMAC  ,I6,45H   (0=DO NOT/1=DO BUILD AN EMBEDDED MACROLIB)/
+     7 7H NDEL  ,I6,31H   (NUMBER OF PRECURSOR GROUPS)/
+     8 7H NFISS ,I6,31H   (NUMBER OF FISSILE ISOTOPES)/
+     9 7H ISOADD,I6,37H   (0=COMPLETE BURNUP CHAIN/1=DO NOT)/
+     1 7H MAXISM,I6,40H   (MAX. NUMBER OF ISOTOPES PER MIXTURE)/
+     2 7H IPRECI,I6,34H   (CALENDF ACCURACY FLAG:1/2/3/4)/
+     3 7H IDF   ,I6,47H   (0=NO INFO/1=ALBS INFO/2=FLUX GAP INFO/3=ADF,
+     4 10H GAP INFO))
+  320 FORMAT(/32H NCR: INTERPOLATING MULTICOMPO ',A12,13H' FROM DIRECT,
+     1 5HORY ',A12,2H'.)
+      END
diff --git a/Donjon/src/NCRAGF.f b/Donjon/src/NCRAGF.f
new file mode 100644
index 0000000..b21f935
--- /dev/null
+++ b/Donjon/src/NCRAGF.f
@@ -0,0 +1,532 @@
+*DECK NCRAGF
+      SUBROUTINE NCRAGF(IPMAC,IPCPO,IACCS,NMIL,NMIX,NGRP,NGFF,NALBP,
+     1 IMPX,NCAL,TERP,MIXC,IDF,NTYPE,NFINF)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Build the macrolib by scanning the NCAL elementary calculations and
+* weighting them with TERP factors. ADF, GFF and physical albedos part.
+*
+*Copyright:
+* Copyright (C) 2015 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* R. Chambon, A. Hebert
+*
+*Parameters: input
+* IPMAC   address of the output macrolib LCM object.
+* IPCPO   address of the multicompo object.
+* IACCS   =0 macrolib is created; =1 ... is updated.
+* NMIL    number of material mixtures in the multicompo.
+* NMIX    maximum number of material mixtures in the macrolib.
+* NGRP    number of energy groups.
+* NGFF    number of group form factors per energy group.
+* NALBP   number of physical albedos per energy group.
+* IMPX    print parameter (equal to zero for no print).
+* NCAL    number of elementary calculations in the multicompo.
+* TERP    interpolation factors.
+* MIXC    mixture index in the multicompo corresponding to each macrolib
+*         mixture. Equal to zero if a macrolib mixture is not updated.
+* IDF     ADF type, 0 = none, 1 = Albedo, 2 = FD_B/FD_C/..., 3 = ADF.
+* NTYPE   number of ADF.
+* NFINF   number of 'enriched' flux (for pin power reconstruction in
+*         NAP:).
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAC,IPCPO
+      INTEGER IACCS,NMIL,NMIX,NGRP,NGFF,NALBP,IMPX,NCAL,MIXC(NMIX),IDF,
+     1 NTYPE,NFINF
+      REAL TERP(NCAL,NMIX)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXIFX=5
+      INTEGER, PARAMETER::NSTATE=40
+      INTEGER FINF(MAXIFX),NITMA
+      REAL WEIGHT,FACTOR,ZZZ
+      CHARACTER FINFN*8,HSMG*131
+      TYPE(C_PTR) JPCPO,KPCPO,LPCPO,MPCPO
+      INTEGER IKEFF,IKINF,I,IBM,IBMOLD,ICAL,IGR,JGR,IGFF,ILONG,ITYLCM,
+     1 ITYPE,ITYP2,JTYPE,IAL,NTYPE2
+      INTEGER ISTATE(NSTATE)
+      DOUBLE PRECISION GAR1,GAR2
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      REAL, ALLOCATABLE, DIMENSION(:) :: GAR4,VOL,ZKINF,ZKEFF
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: GAR6,ALBP
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: GAR5,ADF2,ALBP2
+      REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: GFF,ADF2M
+      CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: HADF,HADF2
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(GAR4(NGRP*NGRP),GAR6(NGRP,2),GFF(NMIX,NGFF,NGRP,2+NFINF),
+     1 GAR5(NGFF,NGRP,2+MAXIFX),ALBP(NALBP,NGRP),ALBP2(NMIX,NALBP,NGRP),
+     2 ZKINF(NMIX),ZKEFF(NMIX),HADF(NTYPE),ADF2(NMIX,NGRP,NTYPE),
+     3 ADF2M(NMIX,NGRP,NGRP,NTYPE))
+*----
+*  OVERALL MULTICOMPO MIXTURE LOOP
+*----
+      IKINF=0
+      IKEFF=0
+      JPCPO=LCMGID(IPCPO,'MIXTURES')
+      IF(NALBP.NE.0) ALBP2(:NMIX,:NALBP,:NGRP)=0.0
+      ZKINF(:NMIX)=0.0
+      ZKEFF(:NMIX)=0.0
+      DO 500 IBMOLD=1,NMIL
+      IF(IMPX.GT.0) WRITE(IOUT,'(/33H NCRAGF: PROCESS MULTICOMPO MIXTU,
+     1 2HRE,I5)') IBMOLD
+      KPCPO=LCMGIL(JPCPO,IBMOLD)
+      LPCPO=LCMGID(KPCPO,'CALCULATIONS')
+*----
+*  READ EXISTING MACROLIB INFORMATION
+*----
+      MPCPO=LCMGIL(LPCPO,1)
+      CALL LCMGET(MPCPO,'STATE-VECTOR',ISTATE)
+      IF(ISTATE(1).NE.1) CALL XABORT('NCRAGF: THE NUMBER OF MIXTURE SH'
+     1 //'OULD ALWAYS BE EQUAL TO 1 IN A MULTICOMPO MICROLIB BRANCH.')
+      IF(IACCS.EQ.0) THEN  !IACCS
+        IF((IDF.NE.0).OR.(NGFF.NE.0)) CALL LCMSIX(MPCPO,'MACROLIB',1)
+        IF(IDF.NE.0) THEN
+          !copy ADF names from multicompo
+          CALL LCMSIX(IPMAC,'ADF',1)
+          CALL LCMLEN(MPCPO,'ADF',ILONG,ITYLCM)
+          IF(ILONG.EQ.0) CALL XABORT('NCRAGF: MISSING ADF DIRECTORY I'
+     1    //'N MULTICOMPO OBJECT.')
+          CALL LCMSIX(MPCPO,'ADF',1)
+          CALL LCMEQU(MPCPO,IPMAC)
+          IF(IDF.EQ.1) THEN
+            CALL LCMLEN(IPMAC,'ALBS00',ILONG,ITYLCM)
+            IF(ILONG.GT.0) CALL LCMDEL(IPMAC,'ALBS00')
+            ADF2(:NMIX,:NGRP,:NTYPE)=0.0
+          ELSE IF((IDF.EQ.2).OR.(IDF.EQ.3)) THEN
+            CALL LCMGET(MPCPO,'NTYPE',NITMA)
+            IF(NITMA.NE.NTYPE) CALL XABORT('NCRAGF: INVALID NTYPE(1).')
+            IF(NTYPE.GT.0) THEN
+              CALL LCMGTC(MPCPO,'HADF',8,NTYPE,HADF)
+              DO ITYPE=1,NTYPE
+                CALL LCMLEN(IPMAC,HADF(ITYPE),ILONG,ITYLCM)
+                IF(ILONG.GT.0) CALL LCMDEL(IPMAC,HADF(ITYPE))
+              ENDDO
+            ENDIF
+            ADF2(:NMIX,:NGRP,:NTYPE)=0.0
+          ELSE IF(IDF.EQ.4) THEN
+            CALL LCMGET(MPCPO,'NTYPE',NITMA)
+            IF(NITMA.NE.NTYPE) CALL XABORT('NCRAGF: INVALID NTYPE(2).')
+            IF(NTYPE.GT.0) THEN
+              CALL LCMGTC(MPCPO,'HADF',8,NTYPE,HADF)
+              DO ITYPE=1,NTYPE
+                CALL LCMLEN(IPMAC,HADF(ITYPE),ILONG,ITYLCM)
+                IF(ILONG.GT.0) CALL LCMDEL(IPMAC,HADF(ITYPE))
+              ENDDO
+            ENDIF
+            ADF2M(:NMIX,:NGRP,:NGRP,:NTYPE)=0.0
+          ENDIF
+          CALL LCMSIX(MPCPO,' ',2)
+          CALL LCMSIX(IPMAC,' ',2)
+        ENDIF
+        IF(NGFF.NE.0) THEN
+          !copy GFF geom and FINF names from multicompo
+          CALL LCMSIX(IPMAC,'GFF',1)
+          CALL LCMLEN(MPCPO,'GFF',ILONG,ITYLCM)
+          IF(ILONG.EQ.0) CALL XABORT('NCRAGF: MISSING GFF DIRECTORY I'
+     1    //'N MULTICOMPO OBJECT.')
+          CALL LCMSIX(MPCPO,'GFF',1)
+          CALL LCMEQU(MPCPO,IPMAC)
+          IF(NFINF.GT.0) THEN
+            CALL LCMGET(IPMAC,'FINF_NUMBER ',FINF)
+            DO I=1,NFINF
+              WRITE(FINFN,'(5HFINF_,I3.3)') FINF(I)
+              CALL LCMLEN(IPMAC,FINFN,ILONG,ITYLCM)
+              IF(ILONG.GT.0) CALL LCMDEL(IPMAC,FINFN)
+            ENDDO
+          ENDIF
+          CALL LCMSIX(MPCPO,' ',2)
+          CALL LCMSIX(IPMAC,' ',2)
+          GFF(:NMIX,:NGFF,:NGRP,:2+NFINF)=0.0
+        ENDIF
+        IF((IDF.NE.0).OR.(NGFF.NE.0)) CALL LCMSIX(MPCPO,' ',2)
+        CALL LCMGET(IPMAC,'STATE-VECTOR',ISTATE)
+        ISTATE(8)=NALBP
+        ISTATE(12)=IDF
+        ISTATE(16)=NGFF
+        CALL LCMPUT(IPMAC,'STATE-VECTOR',NSTATE,1,ISTATE)
+        IACCS=1
+      ELSE !IACCS
+* Recover ADF, GFF and physical albedos previously computed
+        IF(NGFF.NE.0) THEN
+          CALL LCMSIX(IPMAC,'GFF',1)
+          CALL LCMGET(IPMAC,'NWT0',GFF(1,1,1,1))
+          CALL LCMGET(IPMAC,'H-FACTOR',GFF(1,1,1,2))
+          IF(NFINF.GT.0) THEN
+            CALL LCMGET(IPMAC,'FINF_NUMBER ',FINF)
+            DO I=1,NFINF
+              WRITE(FINFN,'(5HFINF_,I3.3)') FINF(I)
+              CALL LCMGET(IPMAC,FINFN,GFF(1,1,1,2+I))
+            ENDDO
+          ENDIF
+          DO IBM=1,NMIX
+            IF(MIXC(IBM).EQ.IBMOLD) GFF(IBM,:NGFF,:NGRP,:NFINF+2)=0.0
+          ENDDO
+          CALL LCMSIX(IPMAC,' ',2)
+        ENDIF
+        IF(IDF.NE.0) THEN
+          CALL LCMSIX(IPMAC,'ADF',1)
+          IF(IDF.EQ.1) THEN
+            DO IBM=1,NMIX
+              IF(MIXC(IBM).EQ.IBMOLD) ADF2(IBM,:NGRP,1)=0.0
+            ENDDO
+          ELSE IF((IDF.EQ.2).OR.(IDF.EQ.3)) THEN
+            CALL LCMGTC(IPMAC,'HADF',8,NTYPE,HADF)
+            DO ITYPE=1,NTYPE
+              CALL LCMGET(IPMAC,HADF(ITYPE),ADF2(1,1,ITYPE))
+              DO IBM=1,NMIX
+                IF(MIXC(IBM).EQ.IBMOLD) ADF2(IBM,:NGRP,ITYPE)=0.0
+              ENDDO
+            ENDDO
+          ELSE IF(IDF.EQ.4) THEN
+            CALL LCMGTC(IPMAC,'HADF',8,NTYPE,HADF)
+            DO ITYPE=1,NTYPE
+              CALL LCMGET(IPMAC,HADF(ITYPE),ADF2M(1,1,1,ITYPE))
+              DO IBM=1,NMIX
+                IF(MIXC(IBM).EQ.IBMOLD) ADF2M(IBM,:NGRP,:NGRP,ITYPE)=0.0
+              ENDDO
+            ENDDO
+          ENDIF
+          CALL LCMSIX(IPMAC,' ',2)
+        ENDIF
+        DO IBM=1,NMIX
+          IF(MIXC(IBM).EQ.IBMOLD) THEN
+            IF(NALBP.NE.0) ALBP2(IBM,:NALBP,:NGRP)=0.0
+            ZKINF(IBM)=0.0
+            ZKEFF(IBM)=0.0
+          ENDIF
+        ENDDO
+        CALL LCMGET(IPMAC,'STATE-VECTOR',ISTATE)
+        ISTATE(8)=NALBP
+        ISTATE(12)=IDF
+        ISTATE(16)=NGFF
+        CALL LCMPUT(IPMAC,'STATE-VECTOR',NSTATE,1,ISTATE)
+*
+      ENDIF  !IACCS
+*----
+*  OVERALL ELEMENTARY CALCULATION LOOP
+*----
+      DO 210 ICAL=1,NCAL
+      MPCPO=LCMGIL(LPCPO,ICAL)
+      DO 200 IBM=1,NMIX
+      WEIGHT=TERP(ICAL,IBM)
+      IF((MIXC(IBM).NE.IBMOLD).OR.(WEIGHT.EQ.0.0)) GO TO 200
+*----
+*  PERFORM INTERPOLATION
+*----
+*----
+*  PROCESS GROUP FORM FACTOR (GFF) INFORMATION
+*----
+      IF(NGFF.NE.0) THEN
+        CALL LCMSIX(MPCPO,'MACROLIB',1)
+        CALL LCMLEN(MPCPO,'GFF',ILONG,ITYLCM)
+        IF(ILONG.NE.0) THEN
+          CALL LCMSIX(MPCPO,'GFF',1)
+          CALL LCMLEN(MPCPO,'NWT0',ILONG,ITYLCM)
+          IF(ILONG.GT.NGFF*NGRP*(2+MAXIFX)) THEN
+            CALL LCMLIB(MPCPO)
+            WRITE(6,'(6H NGFF=,I6,6H NGRP=,I6,11H LEN(NWT0)=,I6)')
+     >      NGFF,NGRP,ILONG
+            CALL XABORT('NCRAGF: MAXIFX OVERFLOW.')
+          ENDIF
+          CALL LCMGET(MPCPO,'NWT0',GAR5(1,1,1))
+          CALL LCMGET(MPCPO,'H-FACTOR',GAR5(1,1,2))
+          CALL LCMLEN(MPCPO,'FINF_NUMBER ',NFINF,ITYLCM)
+          IF(NFINF.GT.0) THEN
+            CALL LCMGET(MPCPO,'FINF_NUMBER ',FINF)
+            DO I=1,NFINF
+              WRITE(FINFN,'(5HFINF_,I3.3)') FINF(I)
+              CALL LCMGET(MPCPO,FINFN,GAR5(1,1,2+I))
+            ENDDO
+          ENDIF
+          DO IGFF=1,NGFF
+            DO IGR=1,NGRP
+              GFF(IBM,IGFF,IGR,1)=GFF(IBM,IGFF,IGR,1)
+     1                            +WEIGHT*GAR5(IGFF,IGR,1)
+              GFF(IBM,IGFF,IGR,2)=GFF(IBM,IGFF,IGR,2)
+     1                            +WEIGHT*GAR5(IGFF,IGR,2)
+              DO I=1,NFINF
+                GFF(IBM,IGFF,IGR,2+I)=GFF(IBM,IGFF,IGR,2+I)
+     1                           +WEIGHT*GAR5(IGFF,IGR,2+I)
+              ENDDO
+            ENDDO
+          ENDDO
+          CALL LCMSIX(MPCPO,' ',2)
+        ENDIF
+        CALL LCMSIX(MPCPO,' ',2)
+      ENDIF
+*----
+*  PROCESS ADF INFORMATION
+*----
+      IF(IDF.NE.0) THEN
+        CALL LCMSIX(MPCPO,'MACROLIB',1)
+        CALL LCMLEN(MPCPO,'ADF',ILONG,ITYLCM)
+        IF(ILONG.NE.0) THEN
+          CALL LCMSIX(MPCPO,'ADF',1)
+          IF(IDF.EQ.1) THEN
+            GAR6(:NGRP,:2)=0.0
+            CALL LCMGET(MPCPO,'ALBS00',GAR6)
+            DO IGR=1,NGRP
+              ADF2(IBM,IGR,:2)=ADF2(IBM,IGR,:2)+WEIGHT*GAR6(IGR,:2)
+            ENDDO
+          ELSE IF((IDF.EQ.2).OR.(IDF.EQ.3)) THEN
+            CALL LCMGET(MPCPO,'NTYPE',NTYPE2)
+            ALLOCATE(HADF2(NTYPE2))
+            CALL LCMGTC(MPCPO,'HADF',8,NTYPE2,HADF2)
+            IF(NTYPE2.EQ.1) THEN
+*             assign the same ADF to all sides.
+              CALL LCMLEN(MPCPO,HADF2(1),ILONG,ITYLCM)
+              IF(ILONG.NE.NGRP) CALL XABORT('NCRAGF: INVALID ADF LENGT'
+     1        //'H(1).')
+              CALL LCMGET(MPCPO,HADF2(1),GAR4)
+              DO ITYPE=1,NTYPE
+                DO IGR=1,NGRP
+                  ADF2(IBM,IGR,ITYPE)=ADF2(IBM,IGR,ITYPE)+WEIGHT*
+     1            GAR4(IGR)
+                ENDDO
+              ENDDO
+            ELSE
+              IF(NTYPE2.GT.NTYPE) CALL XABORT('NCRAGF: NTYPE OVERFLOW.')
+              DO ITYP2=1,NTYPE2
+                ITYPE=0
+                DO JTYPE=1,NTYPE
+                  IF(HADF2(ITYP2).EQ.HADF(JTYPE)) THEN
+                    ITYPE=JTYPE
+                    GO TO 180
+                  ENDIF
+                ENDDO
+                WRITE(HSMG,'(18HNCRAGF: ADF NAMED ,A,11H NOT FOUND.)')
+     1          TRIM(HADF2(ITYP2))
+                CALL XABORT(HSMG)
+  180           CALL LCMLEN(MPCPO,HADF2(ITYP2),ILONG,ITYLCM)
+                IF(ILONG.NE.NGRP) CALL XABORT('NCRAGF: INVALID ADF LEN'
+     1          //'GTH(2).')
+                CALL LCMGET(MPCPO,HADF2(ITYP2),GAR4)
+                DO IGR=1,NGRP
+                  ADF2(IBM,IGR,ITYPE)=ADF2(IBM,IGR,ITYPE)+WEIGHT*
+     1            GAR4(IGR)
+                ENDDO
+              ENDDO
+            ENDIF
+            DEALLOCATE(HADF2)
+          ELSE IF(IDF.EQ.4) THEN
+            CALL LCMGET(MPCPO,'NTYPE',NTYPE2)
+            ALLOCATE(HADF2(NTYPE2))
+            CALL LCMGTC(MPCPO,'HADF',8,NTYPE2,HADF2)
+            IF(NTYPE2.EQ.1) THEN
+*             assign the same MADF to all sides.
+              CALL LCMLEN(MPCPO,HADF2(1),ILONG,ITYLCM)
+              IF(ILONG.NE.NGRP*NGRP) CALL XABORT('NCRAGF: INVALID ADFM'
+     1        //'LENGTH(1).')
+              CALL LCMGET(MPCPO,HADF2(1),GAR4)
+              DO ITYPE=1,NTYPE
+                DO JGR=1,NGRP
+                  DO IGR=1,NGRP
+                    ADF2M(IBM,IGR,JGR,ITYPE)=ADF2M(IBM,IGR,JGR,ITYPE)+
+     1              WEIGHT*GAR4((JGR-1)*NGRP+IGR)
+                  ENDDO
+                ENDDO
+              ENDDO
+            ELSE
+              IF(NTYPE2.GT.NTYPE) CALL XABORT('NCRAGF: NTYPE OVERFLOW.')
+              DO ITYP2=1,NTYPE2
+                ITYPE=0
+                DO JTYPE=1,NTYPE
+                  IF(HADF2(ITYP2).EQ.HADF(JTYPE)) THEN
+                    ITYPE=JTYPE
+                    GO TO 190
+                  ENDIF
+                ENDDO
+                WRITE(HSMG,'(19HNCRAGF: ADFM NAMED ,A,11H NOT FOUND.)')
+     1          TRIM(HADF2(ITYP2))
+                CALL XABORT(HSMG)
+                CALL LCMLEN(MPCPO,HADF2(ITYP2),ILONG,ITYLCM)
+  190           IF(ILONG.NE.NGRP*NGRP) CALL XABORT('NCRAGF: INVALID AD'
+     1          //'FM LENGTH(2).')
+                CALL LCMGET(MPCPO,HADF2(ITYP2),GAR4)
+                DO JGR=1,NGRP
+                  DO IGR=1,NGRP
+                    ADF2M(IBM,IGR,JGR,ITYPE)=ADF2M(IBM,IGR,JGR,ITYPE)+
+     1              WEIGHT*GAR4((JGR-1)*NGRP+IGR)
+                  ENDDO
+                ENDDO
+              ENDDO
+            ENDIF
+            DEALLOCATE(HADF2)
+          ENDIF
+          CALL LCMSIX(MPCPO,' ',2)
+        ENDIF
+        CALL LCMSIX(MPCPO,' ',2)
+      ENDIF
+*----
+*  PROCESS PHYSICAL ALBEDO INFORMATION
+*----
+      IF(NALBP.NE.0) THEN
+        CALL LCMSIX(MPCPO,'MACROLIB',1)
+        CALL LCMGET(MPCPO,'ALBEDO',ALBP)
+        DO IGR=1,NGRP
+          DO IAL=1,NALBP
+            FACTOR=(1.0-ALBP(IAL,IGR))/(1.0+ALBP(IAL,IGR))
+            ALBP2(IBM,IAL,IGR)=ALBP2(IBM,IAL,IGR)+WEIGHT*FACTOR
+          ENDDO
+        ENDDO
+        CALL LCMSIX(MPCPO,' ',2)
+      ENDIF
+*----
+*  PROCESS KINF
+*----
+      CALL LCMLEN(MPCPO,'K-INFINITY',IKINF,ITYLCM)
+      IF(IKINF.EQ.1) THEN
+        CALL LCMGET(MPCPO,'K-INFINITY',ZZZ)
+        ZKINF(IBM)=ZKINF(IBM)+WEIGHT*ZZZ
+      ENDIF
+*----
+*  PROCESS KEFF
+*----
+      CALL LCMLEN(MPCPO,'K-EFFECTIVE',IKEFF,ITYLCM)
+      IF(IKEFF.EQ.1) THEN
+        CALL LCMGET(MPCPO,'K-EFFECTIVE',ZZZ)
+        ZKEFF(IBM)=ZKEFF(IBM)+WEIGHT*ZZZ
+      ENDIF
+  200 CONTINUE
+  210 CONTINUE
+*----
+*  WRITE INTERPOLATED MACROLIB INFORMATION
+*----
+      IF(IDF.EQ.1) THEN
+        CALL LCMSIX(IPMAC,'ADF',1)
+        CALL LCMPUT(IPMAC,'ALBS00',NMIX*NGRP*2,2,ADF2(1,1,1))
+        CALL LCMSIX(IPMAC,' ',2)
+      ELSE IF((IDF.EQ.2).OR.(IDF.EQ.3)) THEN
+        CALL LCMSIX(IPMAC,'ADF',1)
+        CALL LCMGTC(IPMAC,'HADF',8,NTYPE,HADF)
+        DO ITYPE=1,NTYPE
+          CALL LCMPUT(IPMAC,HADF(ITYPE),NMIX*NGRP,2,
+     1    ADF2(1,1,ITYPE))
+        ENDDO
+        CALL LCMSIX(IPMAC,' ',2)
+        IF(IMPX.GT.1) THEN
+          DO IBM=1,NMIX
+            IF(MIXC(IBM).EQ.0) CYCLE
+            WRITE(6,'(/40H NCRAGF: DISCONTINUITY FACTORS - MIXTURE,I5)')
+     1      IBM
+            DO ITYPE=1,NTYPE
+              WRITE(6,'(1X,A,1H:,1P,(5X,10E12.4))') TRIM(HADF(ITYPE)),
+     1        (ADF2(IBM,IGR,ITYPE),IGR=1,NGRP)
+            ENDDO
+          ENDDO
+        ENDIF
+      ELSE IF(IDF.EQ.4) THEN
+        CALL LCMSIX(IPMAC,'ADF',1)
+        CALL LCMGTC(IPMAC,'HADF',8,NTYPE,HADF)
+        DO ITYPE=1,NTYPE
+          CALL LCMPUT(IPMAC,HADF(ITYPE),NMIX*NGRP*NGRP,2,
+     1    ADF2M(1,1,1,ITYPE))
+        ENDDO
+        CALL LCMSIX(IPMAC,' ',2)
+        IF(IMPX.GT.1) THEN
+          DO IBM=1,NMIX
+            IF(MIXC(IBM).EQ.0) CYCLE
+            WRITE(6,'(/40H NCRAGF: DISCONTINUITY FACTORS - MIXTURE,I5)')
+     1      IBM
+            DO ITYPE=1,NTYPE
+              WRITE(6,'(1X,A,1H:,1P,(5X,10E12.4))') TRIM(HADF(ITYPE)),
+     1        ((ADF2M(IBM,IGR,JGR,ITYPE),IGR=1,NGRP),JGR=1,NGRP)
+            ENDDO
+          ENDDO
+        ENDIF
+      ENDIF
+      IF(NGFF.NE.0) THEN
+        CALL LCMSIX(IPMAC,'GFF',1)
+        CALL LCMPUT(IPMAC,'NWT0',NMIX*NGFF*NGRP,2,GFF(1,1,1,1))
+        CALL LCMPUT(IPMAC,'H-FACTOR',NMIX*NGFF*NGRP,2,GFF(1,1,1,2))
+        IF(NFINF.GT.0) THEN
+          CALL LCMGET(IPMAC,'FINF_NUMBER ',FINF)
+          DO I=1,NFINF
+            WRITE(FINFN,'(5HFINF_,I3.3)') FINF(I)
+            CALL LCMPUT(IPMAC,FINFN,NMIX*NGFF*NGRP,2,GFF(1,1,1,2+I))
+          ENDDO
+        ENDIF
+        CALL LCMSIX(IPMAC,' ',2)
+      ENDIF
+      IACCS=1
+*----
+*  END OF OVERALL MULTICOMPO MIXTURE LOOP
+*----
+      IF(IMPX.GT.0) WRITE(IOUT,'(/33H NCRAGF: PROCESS MULTICOMPO MIXTU,
+     1 6HRE-OUT,I5)') IBMOLD
+  500 CONTINUE
+*----
+*  AVERAGE PHYSICAL ALBEDO INFORMATION
+*----
+      IF(NALBP.NE.0) THEN
+        ALLOCATE(VOL(NMIX))
+        CALL LCMGET(IPMAC,'VOLUME',VOL)
+        DO IGR=1,NGRP
+          DO IAL=1,NALBP
+            GAR1=0.0D0
+            GAR2=0.0D0
+            DO IBM=1,NMIX
+              GAR1=GAR1+ALBP2(IBM,IAL,IGR)*VOL(IBM)
+              GAR2=GAR2+VOL(IBM)
+            ENDDO
+            ALBP(IAL,IGR)=REAL((1.0D0-GAR1/GAR2)/(1.0D0+GAR1/GAR2))
+          ENDDO
+        ENDDO
+        DEALLOCATE(VOL)
+        CALL LCMPUT(IPMAC,'ALBEDO',NALBP*NGRP,2,ALBP(1,1))
+      ENDIF
+*----
+*  AVERAGE KINF
+*----
+      IF(IKINF.EQ.1) THEN
+        ALLOCATE(VOL(NMIX))
+        CALL LCMGET(IPMAC,'VOLUME',VOL)
+        GAR1=0.0D0
+        GAR2=0.0D0
+        DO IBM=1,NMIX
+          GAR1=GAR1+ZKINF(IBM)*VOL(IBM)
+          GAR2=GAR2+VOL(IBM)
+        ENDDO
+        ZZZ=REAL(GAR1/GAR2)
+        DEALLOCATE(VOL)
+        CALL LCMPUT(IPMAC,'K-INFINITY',1,2,ZZZ)
+      ENDIF
+*----
+*  AVERAGE KEFF
+*----
+      IF(IKEFF.EQ.1) THEN
+        ALLOCATE(VOL(NMIX))
+        CALL LCMGET(IPMAC,'VOLUME',VOL)
+        GAR1=0.0D0
+        GAR2=0.0D0
+        DO IBM=1,NMIX
+          GAR1=GAR1+ZKEFF(IBM)*VOL(IBM)
+          GAR2=GAR2+VOL(IBM)
+        ENDDO
+        ZZZ=REAL(GAR1/GAR2)
+        DEALLOCATE(VOL)
+        CALL LCMPUT(IPMAC,'K-EFFECTIVE',1,2,ZZZ)
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(ADF2M,ADF2,HADF,ZKEFF,ZKINF,ALBP2,ALBP,GAR5,GFF,GAR6,
+     1 GAR4)
+      RETURN
+      END
diff --git a/Donjon/src/NCRCAL.f90 b/Donjon/src/NCRCAL.f90
new file mode 100644
index 0000000..a080b73
--- /dev/null
+++ b/Donjon/src/NCRCAL.f90
@@ -0,0 +1,62 @@
+RECURSIVE INTEGER FUNCTION NCRCAL(II,NVP,NPTOT,DEBARB,ARBVAL,MUPLET) RESULT(ICAL)
+!
+!-----------------------------------------------------------------------
+!
+!Purpose:
+! find the position of an elementary calculation in the multicompo, Apex
+! file or in the Saphyb.
+!
+!Copyright:
+! Copyright (C) 2012 Ecole Polytechnique de Montreal
+!
+!Author(s): 
+! A. Hebert
+!
+!Parameters: input
+! II      position in DEBARB. Must be set to 1 in the first call.
+! NVP     number of nodes in the parameter tree.
+! NPTOT   number of parameters.
+! DEBARB  tree information
+! ARBVAL  tree information
+! MUPLET  tuple used to identify an elementary calculation.
+!
+!Parameters: output
+! ICAL    position of the elementary calculation (=0 if does not exist;
+!         =-1 if more than one exists).
+!
+!-----------------------------------------------------------------------
+!
+  IMPLICIT NONE
+  !----
+  !  SUBROUTINE ARGUMENTS
+  !----
+  INTEGER IKEEP, I, JICAL, NBOK
+  INTEGER II,NVP,NPTOT,DEBARB(NVP+1),ARBVAL(NVP),MUPLET(NPTOT)
+  !
+  IF(NPTOT==0) THEN
+    ICAL=DEBARB(II+1)
+    RETURN
+  ENDIF
+  NBOK=0
+  IKEEP=0
+  DO I=DEBARB(II),DEBARB(II+1)-1
+    IF((MUPLET(1)==0).OR.(MUPLET(1)==ARBVAL(I))) THEN
+      JICAL=NCRCAL(I,NVP,NPTOT-1,DEBARB,ARBVAL,MUPLET(2))
+      IF(JICAL > 0) THEN
+        IKEEP=JICAL
+        NBOK=NBOK+1
+      ELSE IF(JICAL==-1) THEN
+        NBOK=2
+      ENDIF
+    ENDIF
+  ENDDO
+  IF(NBOK > 1) THEN
+    ! Many elementary calculation exist for this tuple.
+    ICAL=-1
+  ELSE IF(NBOK==0) THEN
+    ! No elementary calculation exists for this tuple.
+    ICAL=0
+  ELSE
+    ICAL=IKEEP
+  ENDIF
+END FUNCTION NCRCAL
diff --git a/Donjon/src/NCRDRV.f b/Donjon/src/NCRDRV.f
new file mode 100644
index 0000000..c7203b8
--- /dev/null
+++ b/Donjon/src/NCRDRV.f
@@ -0,0 +1,482 @@
+*DECK NCRDRV
+      SUBROUTINE NCRDRV(IPCPO,LCUBIC,NMIX,IMPX,NMIL,NCAL,ITER,MAXNIS,
+     1 MIXC,TERP,NISO,LISO,HISO,CONC)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute TERP factors for multicompo interpolation. Use user-defined
+* global and local parameters.
+*
+*Copyright:
+* Copyright (C) 2006 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert and R. Chambon
+*
+*Parameters: input
+* IPCPO   address of the multicompo object.
+* LCUBIC  =.TRUE.: cubic Ceschino interpolation; =.FALSE: linear
+*         Lagrange interpolation.
+* NMIX    maximum number of material mixtures in the microlib.
+* IMPX    print parameter (equal to zero for no print).
+* NMIL    number of material mixtures in the multicompo.
+* NCAL    number of elementary calculations in the multicompo.
+*
+*Parameters: output
+* ITER    completion flag (=0: all over; =1: use another multicompo;
+*         =2 use another L_MAP + multicompo).
+* MAXNIS  maximum value of NISO(I) in user data.
+* MIXC    mixture index in the multicompo corresponding to each microlib
+*         mixture.
+* TERP    interpolation factors.
+* NISO    number of user-selected isotopes.
+* LISO    type of treatment (=.true.: ALL; =.false.: ONLY).
+* HISO    name of the user-selected isotopes.
+* CONC    user-defined number density of the user-selected isotopes. A
+*         value of -99.99 is set to indicate that the multicompo value
+*         is used.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER, PARAMETER::MAXISD=200
+      TYPE(C_PTR) IPCPO
+      INTEGER NMIX,IMPX,NMIL,NCAL,ITER,MAXNIS,MIXC(NMIX),
+     1 NISO(NMIX),HISO(2,NMIX,MAXISD)
+      REAL TERP(NCAL,NMIX),CONC(NMIX,MAXISD)
+      LOGICAL LCUBIC,LISO(NMIX)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXLIN=50
+      INTEGER, PARAMETER::MAXPAR=50
+      INTEGER, PARAMETER::MAXVAL=200
+      INTEGER, PARAMETER::NSTATE=40
+      REAL, PARAMETER::REPS=1.0E-4
+      REAL FLOTT, SUM
+      INTEGER I0, IBMOLD, IBM, ICAL, INDIC, IPAR, ITYLCM, ITYPE, I, 
+     & JBM, J, LENGTH, NCOMLI, NITMA, NLOC, NPAR
+      CHARACTER TEXT12*12,PARKEY(MAXPAR)*12,PARFMT(MAXPAR)*8,
+     1 PARKEL(MAXPAR)*12,HSMG*131,COMMEN(MAXLIN)*80,VALH(MAXPAR)*12,
+     2 RECNAM*12,VCHAR(MAXVAL)*12,HCUBIC*12
+      INTEGER ISTATE(NSTATE),VALI(MAXPAR),NVALUE(MAXPAR),VINTE(MAXVAL),
+     1 MUPLET(2*MAXPAR),MUTYPE(2*MAXPAR)
+      DOUBLE PRECISION DFLOTT
+      REAL VALR(2*MAXPAR,2),VREAL(MAXVAL)
+      LOGICAL LCUB2(MAXPAR)
+      TYPE(C_PTR) JPCPO,KPCPO,LPCPO
+      LOGICAL, ALLOCATABLE, DIMENSION(:) :: LDELTA
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(LDELTA(NMIX))
+*----
+*  RECOVER TABLE-OF-CONTENT INFORMATION FOR THE MULTICOMPO.
+*----
+      CALL LCMGET(IPCPO,'STATE-VECTOR',ISTATE)
+      NPAR=ISTATE(5)
+      NLOC=ISTATE(6)
+      NCOMLI=ISTATE(10)
+      CALL LCMGTC(IPCPO,'COMMENT',80,NCOMLI,COMMEN)
+      IF(NPAR.GT.0) THEN
+         CALL LCMSIX(IPCPO,'GLOBAL',1)
+         CALL LCMGTC(IPCPO,'PARKEY',12,NPAR,PARKEY)
+         CALL LCMGTC(IPCPO,'PARFMT',8,NPAR,PARFMT)
+         CALL LCMGET(IPCPO,'NVALUE',NVALUE)
+         IF(IMPX.GT.0)THEN
+           DO IPAR=1,NPAR
+             WRITE(RECNAM,'(''pval'',I8.8)') IPAR
+             IF(PARFMT(IPAR).EQ.'INTEGER') THEN
+               CALL LCMGET(IPCPO,RECNAM,VINTE)
+               WRITE(IOUT,'(13H NCRDRV: KEY=,A,18H TABULATED POINTS=,
+     1         1P,6I12/(43X,6I12))') PARKEY(IPAR),(VINTE(I),I=1,
+     2         NVALUE(IPAR))
+             ELSE IF(PARFMT(IPAR).EQ.'REAL') THEN
+               CALL LCMGET(IPCPO,RECNAM,VREAL)
+               WRITE(IOUT,'(13H NCRDRV: KEY=,A,18H TABULATED POINTS=,
+     1         1P,6E12.4/(43X,6E12.4))') PARKEY(IPAR),(VREAL(I),I=1,
+     2         NVALUE(IPAR))
+             ELSE IF(PARFMT(IPAR).EQ.'STRING') THEN
+               CALL LCMGTC(IPCPO,RECNAM,12,NVALUE(IPAR),VCHAR)
+               WRITE(IOUT,'(13H NCRDRV: KEY=,A,18H TABULATED POINTS=,
+     1         1P,6A12/(43X,6A12))') PARKEY(IPAR),(VCHAR(I),I=1,
+     2         NVALUE(IPAR))
+             ENDIF
+           ENDDO
+         ENDIF
+         CALL LCMSIX(IPCPO,' ',2)
+      ENDIF
+      IF(NLOC.GT.0) THEN
+         CALL LCMSIX(IPCPO,'LOCAL',1)
+         CALL LCMGTC(IPCPO,'PARKEY',12,NLOC,PARKEL)
+         CALL LCMSIX(IPCPO,' ',2)
+         JPCPO=LCMGID(IPCPO,'MIXTURES')
+         DO IBMOLD=1,NMIL
+           KPCPO=LCMGIL(JPCPO,IBMOLD)
+           LPCPO=LCMGID(KPCPO,'TREE')
+           CALL LCMGET(LPCPO,'NVALUE',NVALUE)
+           IF(IMPX.GT.0)THEN
+             WRITE(IOUT,'(17H NCRDRV: MIXTURE=,I6)') IBMOLD
+             DO IPAR=1,NLOC
+               WRITE(RECNAM,'(''pval'',I8.8)') IPAR
+               CALL LCMGET(LPCPO,RECNAM,VREAL)
+               WRITE(IOUT,'(13H NCRDRV: KEY=,A,18H TABULATED POINTS=,
+     1         1P,6E12.4/(43X,6E12.4))') PARKEL(IPAR),(VREAL(I),I=1,
+     2         NVALUE(IPAR))
+             ENDDO
+           ENDIF
+         ENDDO
+      ENDIF
+      IF(IMPX.GT.0) THEN 
+        WRITE(IOUT,'(43H NCRDRV: NUMBER OF CALCULATIONS IN MULTICOM,
+     1  3HPO=,I5)') NCAL
+        WRITE(IOUT,'(43H NCRDRV: NUMBER OF MATERIAL MIXTURES IN MUL,
+     1  8HTICOMPO=,I5)') NMIL
+        WRITE(IOUT,'(43H NCRDRV: NUMBER OF MATERIAL MIXTURES IN MIC,
+     1  6HROLIB=,I6)') NMIX
+        WRITE(IOUT,'(1X,A)') (COMMEN(I),I=1,NCOMLI)
+      ENDIF
+      TERP(:NCAL,:NMIX)=0.0
+      MIXC(:NMIX)=0
+*----
+*  READ (INTERP_DATA) AND SET VALI, VALR AND VALH PARAMETERS
+*  CORRESPONDING TO THE INTERPOLATION POINT. FILL MUPLET FOR
+*  PARAMETERS SET WITHOUT INTERPOLATION.
+*----
+      IBM=0
+      MAXNIS=0
+      NISO(:NMIX)=0
+      LISO(:NMIX)=.TRUE.
+      LDELTA(:NMIX)=.FALSE.
+   10 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+      IF(INDIC.NE.3) CALL XABORT('NCRDRV: CHARACTER DATA EXPECTED.')
+   20 IF(TEXT12.EQ.'MIX') THEN
+         MUPLET(:NPAR+NLOC)=0
+         MUTYPE(:NPAR+NLOC)=0
+         VALI(:NPAR)=0
+         VALR(:NPAR+NLOC,1)=0.0
+         VALR(:NPAR+NLOC,2)=0.0
+         DO 30 I=1,NPAR
+         VALH(I)=' '
+   30    CONTINUE
+         LCUB2(:NPAR+NLOC)=LCUBIC
+         CALL REDGET(INDIC,IBM,FLOTT,TEXT12,DFLOTT)
+         IF(INDIC.NE.1) CALL XABORT('NCRDRV: INTEGER DATA EXPECTED.')
+         IF(IBM.GT.NMIX) CALL XABORT('NCRDRV: NMIX OVERFLOW.')
+         IBMOLD=1
+         CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('NCRDRV: CHARACTER DATA EXPECTED.')
+         IF(TEXT12.EQ.'FROM') THEN
+            CALL REDGET(INDIC,IBMOLD,FLOTT,TEXT12,DFLOTT)
+            IF(INDIC.NE.1) CALL XABORT('NCRDRV: INTEGER DATA EXPECTED.')
+            IF(IBMOLD.GT.NMIL) CALL XABORT('NCRDRV: MPO MIX OVERFLOW'
+     1      //'(1).')
+            MIXC(IBM)=IBMOLD
+            GO TO 10
+         ELSE IF(TEXT12.EQ.'USE') THEN
+            IF(IBM.GT.NMIL) CALL XABORT('NCRDRV: MPO MIX OVERFLOW(2).')
+            MIXC(IBM)=IBM
+            GO TO 10
+         ENDIF
+         MIXC(IBM)=IBMOLD
+         GO TO 20
+      ELSE IF(TEXT12.EQ.'MICRO') THEN
+         IF(IBM.EQ.0) CALL XABORT('NCRDRV: MIX NOT SET (1).')
+         CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('NCRDRV: CHARACTER DATA EXPECTED.')
+         IF(TEXT12.EQ.'ALL') THEN
+            LISO(IBM)=.TRUE.
+         ELSE IF(TEXT12.EQ.'ONLY') THEN
+            LISO(IBM)=.FALSE.
+         ENDIF
+         CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('NCRDRV: CHARACTER DATA EXPECTED.')
+   40    IF(TEXT12.EQ.'ENDMIX') THEN
+            GO TO 20
+         ELSE
+            NISO(IBM)=NISO(IBM)+1
+            IF(NISO(IBM).GT.MAXISD) CALL XABORT('NCRDRV: MAXISD OVERFL'
+     1      //'OW.')
+            MAXNIS=MAX(MAXNIS,NISO(IBM))
+            READ(TEXT12,'(2A4)') (HISO(I0,IBM,NISO(IBM)),I0=1,2)
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+            IF(INDIC.EQ.2) THEN
+               CONC(IBM,NISO(IBM))=FLOTT
+            ELSE IF((INDIC.EQ.3).AND.(TEXT12.EQ.'*')) THEN
+               CONC(IBM,NISO(IBM))=-99.99
+            ELSE
+               CALL XABORT('NCRDRV: INVALID HISO DATA.')
+            ENDIF
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+            IF(INDIC.NE.3) CALL XABORT('NCRDRV: CHARACTER DATA EXPECTE'
+     1      //'D.')
+            GO TO 40
+         ENDIF
+      ELSE IF((TEXT12.EQ.'SET').OR.(TEXT12.EQ.'DELTA')) THEN
+         IF(IBM.EQ.0) CALL XABORT('NCRDRV: MIX NOT SET (2).')
+         ITYPE=0
+         IF(TEXT12.EQ.'SET') THEN
+            ITYPE=1
+         ELSE IF(TEXT12.EQ.'DELTA') THEN
+            ITYPE=2
+            LDELTA(IBM)=.TRUE.
+         ENDIF
+         CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('NCRDRV: CHARACTER DATA EXPECTED.')
+         IF((TEXT12.EQ.'LINEAR').OR.(TEXT12.EQ.'CUBIC')) THEN
+            HCUBIC=TEXT12
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+         ELSE
+            HCUBIC=' '
+         ENDIF
+         IF(INDIC.NE.3) CALL XABORT('NCRDRV: CHARACTER DATA EXPECTED.')
+         DO 50 I=1,NPAR
+         IF(TEXT12.EQ.PARKEY(I)) THEN
+            IPAR=I
+            GO TO 60
+         ENDIF
+   50    CONTINUE
+         GO TO 100
+   60    IF(HCUBIC.EQ.'LINEAR') THEN
+            LCUB2(IPAR)=.FALSE.
+         ELSE IF(HCUBIC.EQ.'CUBIC') THEN
+            LCUB2(IPAR)=.TRUE.
+         ENDIF
+         LPCPO=LCMGID(IPCPO,'GLOBAL')
+         CALL LCMGET(LPCPO,'NVALUE',NVALUE)
+         IF(NVALUE(IPAR).GT.MAXVAL) CALL XABORT('NCRDRV: MAXVAL OVERFL'
+     1   //'OW.')
+         WRITE(RECNAM,'(''pval'',I8.8)') IPAR
+         CALL LCMLEN(LPCPO,RECNAM,LENGTH,ITYLCM)
+         IF(LENGTH.EQ.0) THEN
+            WRITE(HSMG,'(25HNCRDRV: GLOBAL PARAMETER ,A,9H NOT SET.)')
+     1      PARKEY(IPAR)
+            CALL XABORT(HSMG)
+         ENDIF
+         IF(PARFMT(IPAR).EQ.'INTEGER') THEN
+            IF(ITYPE.NE.1) CALL XABORT('NCRDRV: SET MANDATORY WITH INT'
+     1      //'EGER PARAMETERS.')
+            CALL REDGET(INDIC,VALI(IPAR),FLOTT,TEXT12,DFLOTT)
+            IF(INDIC.NE.1) CALL XABORT('NCRDRV: INTEGER DATA EXPECTED.')
+            CALL LCMGET(LPCPO,RECNAM,VINTE)
+            DO 70 J=1,NVALUE(IPAR)
+            IF(VALI(IPAR).EQ.VINTE(J)) THEN
+               MUPLET(IPAR)=J
+               MUTYPE(IPAR)=ITYPE
+               GO TO 10
+            ENDIF
+   70       CONTINUE
+            WRITE(HSMG,'(26HNCRDRV: INTEGER PARAMETER ,A,11H WITH VALUE,
+     1      I5,34H NOT FOUND IN MULTICOMPO DATABASE.)') PARKEY(IPAR),
+     2      VALI(IPAR)
+            CALL XABORT(HSMG)
+         ELSE IF(PARFMT(IPAR).EQ.'REAL') THEN
+            CALL REDGET(INDIC,NITMA,VALR(IPAR,1),TEXT12,DFLOTT)
+            IF(INDIC.NE.2) CALL XABORT('NCRDRV: REAL DATA EXPECTED.')
+            VALR(IPAR,2)=VALR(IPAR,1)
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+            IF(INDIC.EQ.2) THEN
+               VALR(IPAR,2)=FLOTT
+               CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+            ENDIF
+            CALL LCMGET(LPCPO,RECNAM,VREAL)
+            IF(VALR(IPAR,1).EQ.VALR(IPAR,2)) THEN
+               DO 80 J=1,NVALUE(IPAR)
+               IF(ABS(VALR(IPAR,1)-VREAL(J)).LE.REPS*ABS(VREAL(J))) THEN
+                  MUPLET(IPAR)=J
+                  IF(ITYPE.NE.1) MUPLET(IPAR)=-1
+                  MUTYPE(IPAR)=ITYPE
+                  GO TO 20
+               ENDIF
+   80          CONTINUE
+            ENDIF
+            IF(VALR(IPAR,1).LT.VREAL(1)) THEN
+               WRITE(HSMG,'(23HNCRDRV: REAL PARAMETER ,A,10H WITH VALU,
+     1         1HE,1P,E12.4,25H IS OUTSIDE THE DOMAIN (<,E12.4,1H))')
+     2         PARKEY(IPAR),VALR(IPAR,1),VREAL(1)
+               CALL XABORT(HSMG)
+            ELSE IF(VALR(IPAR,2).GT.VREAL(NVALUE(IPAR))) THEN
+               WRITE(HSMG,'(23HNCRDRV: REAL PARAMETER ,A,10H WITH VALU,
+     1         1HE,1P,E12.4,25H IS OUTSIDE THE DOMAIN (>,E12.4,1H))')
+     2         PARKEY(IPAR),VALR(IPAR,1),VREAL(NVALUE(IPAR))
+               CALL XABORT(HSMG)
+            ELSE IF(VALR(IPAR,1).GT.VALR(IPAR,2)) THEN
+               WRITE(HSMG,'(23HNCRDRV: REAL PARAMETER ,A,9H IS DEFIN,
+     1         7HED WITH,1P,E12.4,2H >,E12.4,1H.)') PARKEY(IPAR),
+     2         VALR(IPAR,1),VALR(IPAR,2)
+               CALL XABORT(HSMG)
+            ENDIF
+            MUPLET(IPAR)=-1
+            MUTYPE(IPAR)=ITYPE
+            GO TO 20
+         ELSE IF(PARFMT(IPAR).EQ.'STRING') THEN
+            IF(ITYPE.NE.1) CALL XABORT('NCRDRV: SET MANDATORY WITH STR'
+     1      //'ING PARAMETERS.')
+            CALL REDGET(INDIC,NITMA,FLOTT,VALH(IPAR),DFLOTT)
+            IF(INDIC.NE.3) CALL XABORT('NCRDRV: STRING DATA EXPECTED.')
+            CALL LCMGTC(LPCPO,RECNAM,12,NVALUE(IPAR),VCHAR)
+            DO 90 J=1,NVALUE(IPAR)
+            IF(VALH(IPAR).EQ.VCHAR(J)) THEN
+               MUPLET(IPAR)=J
+               MUTYPE(IPAR)=ITYPE
+               GO TO 10
+            ENDIF
+   90       CONTINUE
+            WRITE(HSMG,'(25HNCRDRV: STRING PARAMETER ,A,12H WITH VALUE ,
+     1      A12,34H NOT FOUND IN MULTICOMPO DATABASE.)') PARKEY(IPAR),
+     2      VALH(IPAR)
+            CALL XABORT(HSMG)
+         ENDIF
+  100    DO 110 I=1,NLOC
+         IF(TEXT12.EQ.PARKEL(I)) THEN
+            IPAR=NPAR+I
+            GO TO 120
+         ENDIF
+  110    CONTINUE
+         CALL XABORT('NCRDRV: PARAMETER '//TEXT12//' NOT FOUND.')
+  120    LCUB2(IPAR)=LCUBIC
+         JPCPO=LCMGID(IPCPO,'MIXTURES')
+         IBMOLD=MIXC(IBM)
+         KPCPO=LCMGIL(JPCPO,IBMOLD)
+         LPCPO=LCMGID(KPCPO,'TREE')
+         CALL LCMGET(LPCPO,'NVALUE',NVALUE)
+         CALL REDGET(INDIC,NITMA,VALR(IPAR,1),TEXT12,DFLOTT)
+         IF(INDIC.NE.2) CALL XABORT('NCRDRV: REAL DATA EXPECTED.')
+         VALR(IPAR,2)=VALR(IPAR,1)
+         CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+         IF(INDIC.EQ.2) THEN
+            VALR(IPAR,2)=FLOTT
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+         ENDIF
+         WRITE(RECNAM,'(''pval'',I8.8)') IPAR-NPAR
+         CALL LCMLEN(LPCPO,RECNAM,LENGTH,ITYLCM)
+         IF(LENGTH.EQ.0) THEN
+            WRITE(HSMG,'(24HNCRDRV: LOCAL PARAMETER ,A,9H NOT SET.)')
+     1      PARKEL(IPAR-NPAR)
+            CALL XABORT(HSMG)
+         ELSE IF(LENGTH.GT.MAXVAL) THEN
+            CALL XABORT('NCRDRV: MAXVAL OVERFLOW.')
+         ENDIF
+         CALL LCMGET(LPCPO,RECNAM,VREAL)
+         IF(VALR(IPAR,1).EQ.VALR(IPAR,2)) THEN
+            DO 130 J=1,NVALUE(IPAR-NPAR)
+            IF(ABS(VALR(IPAR,1)-VREAL(J)).LE.REPS*ABS(VREAL(J))) THEN
+               MUPLET(IPAR)=J
+               IF(ITYPE.NE.1) MUPLET(IPAR)=-1
+               MUTYPE(IPAR)=ITYPE
+               GO TO 20
+            ENDIF
+  130       CONTINUE
+         ENDIF
+         IF(VALR(IPAR,1).LT.VREAL(1)) THEN
+            WRITE(HSMG,'(23HNCRDRV: REAL PARAMETER ,A,11H WITH VALUE,
+     1      1P,E12.4,25H IS OUTSIDE THE DOMAIN (<,E12.4,1H))')
+     2      PARKEL(IPAR-NPAR),VALR(IPAR,1),VREAL(1)
+            CALL XABORT(HSMG)
+         ELSE IF(VALR(IPAR,2).GT.VREAL(NVALUE(IPAR-NPAR))) THEN
+            WRITE(HSMG,'(23HNCRDRV: REAL PARAMETER ,A,11H WITH VALUE,
+     1      1P,E12.4,25H IS OUTSIDE THE DOMAIN (>,E12.4,1H))')
+     2      PARKEL(IPAR-NPAR),VALR(IPAR,2),VREAL(NVALUE(IPAR-NPAR))
+            CALL XABORT(HSMG)
+         ELSE IF(VALR(IPAR,1).GT.VALR(IPAR,2)) THEN
+            WRITE(HSMG,'(23HNCRDRV: REAL PARAMETER ,A,9H IS DEFIN,
+     1      7HED WITH,1P,E12.4,2H >,E12.4,1H.)') PARKEL(IPAR-NPAR),
+     2      VALR(IPAR,1),VALR(IPAR,2)
+            CALL XABORT(HSMG)
+         ENDIF
+         MUPLET(IPAR)=-1
+         MUTYPE(IPAR)=ITYPE
+         GO TO 20
+      ELSE IF(TEXT12.EQ.'ENDMIX') THEN
+*----
+*  COMPUTE THE TERP FACTORS USING TABLE-OF-CONTENT INFORMATION.
+*----
+         IF(IMPX.GT.0) THEN
+           DO IPAR=1,NPAR
+             IF(PARFMT(IPAR).EQ.'REAL')THEN
+               IF(LCUB2(IPAR)) THEN
+                 WRITE(IOUT,'(26H NCRDRV: GLOBAL PARAMETER:,A12,5H ->CU,
+     1           18HBIC INTERPOLATION.)') PARKEY(IPAR)
+               ELSE
+                 WRITE(IOUT,'(26H NCRDRV: GLOBAL PARAMETER:,A12,5H ->LI,
+     1           19HNEAR INTERPOLATION.)') PARKEY(IPAR)
+               ENDIF
+             ENDIF
+           ENDDO
+           DO IPAR=1,NLOC
+             IF(LCUB2(NPAR+IPAR)) THEN
+               WRITE(IOUT,'(25H NCRDRV: LOCAL PARAMETER:,A12,8H ->CUBIC,
+     1         14HINTERPOLATION.)') PARKEL(IPAR)
+             ELSE
+               WRITE(IOUT,'(25H NCRDRV: LOCAL PARAMETER:,A12,8H ->LINEA,
+     1         16HR INTERPOLATION.)') PARKEL(IPAR)
+             ENDIF
+           ENDDO
+         ENDIF
+         IF(IBMOLD.GT.NMIL) CALL XABORT('NCRDRV: MPO MIX OVERFLOW(3).')
+         IF(IBM.GT.NMIX) CALL XABORT('NCRDRV: MIX OVERFLOW (MICROLIB).')
+         IF(NCAL.EQ.1) THEN
+           TERP(1,IBM)=1.0
+         ELSE
+           CALL NCRTRP(IPCPO,LCUB2,IMPX,IBMOLD,NPAR,NLOC,NCAL,MUPLET,
+     1     MUTYPE,VALR,0.0,TERP(1,IBM))
+         ENDIF
+         IBM=0
+      ELSE IF((TEXT12.EQ.'COMPO').OR.(TEXT12.EQ.'TABLE').OR.
+     1   (TEXT12.EQ.';')) THEN
+*----
+*  CHECK TERP FACTORS AND RETURN
+*----
+         IF(TEXT12.EQ.';') ITER=0
+         IF(TEXT12.EQ.'COMPO') ITER=1
+         IF(TEXT12.EQ.'TABLE') ITER=2
+         DO 150 IBM=1,NMIX
+         IBMOLD=MIXC(IBM)
+         IF(IBMOLD.EQ.0) GO TO 150
+         IF(NISO(IBM).GT.MAXNIS) CALL XABORT('NCRDRV: MAXNIS OVERFLOW.')
+         IF(LDELTA(IBM)) THEN
+            SUM=0.0
+         ELSE
+            SUM=1.0
+         ENDIF
+         DO 140 ICAL=1,NCAL
+            SUM=SUM-TERP(ICAL,IBM)
+  140    CONTINUE
+         IF(ABS(SUM).GT.1.0E-4) THEN
+            WRITE(HSMG,'(43HNCRDRV: INVALID INTERPOLATION FACTORS IN MI,
+     1      5HXTURE,I4,1H.)') IBM
+            CALL XABORT(HSMG)
+         ENDIF
+  150    CONTINUE
+         GO TO 160
+      ELSE
+         CALL XABORT('NCRDRV: '//TEXT12//' IS AN INVALID KEYWORD.')
+      ENDIF
+      GO TO 10
+*----
+*  PRINT INTERPOLATION (TERP) FACTORS
+*----
+  160 IF(IMPX.GT.2) THEN
+        WRITE(IOUT,'(/30H NCRDRV: INTERPOLATION FACTORS)')
+        DO ICAL=1,NCAL
+          DO IBM=1,NMIX
+            IF(TERP(ICAL,IBM).NE.0.0) THEN
+              WRITE(IOUT,170) ICAL,(TERP(ICAL,JBM),JBM=1,NMIX)
+              EXIT
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(LDELTA)
+      RETURN
+  170 FORMAT(6H CALC=,I8,6H TERP=,1P,8E13.5/(20X,8E13.5))
+      END
diff --git a/Donjon/src/NCRISO.f b/Donjon/src/NCRISO.f
new file mode 100644
index 0000000..bce4633
--- /dev/null
+++ b/Donjon/src/NCRISO.f
@@ -0,0 +1,338 @@
+*DECK NCRISO
+      SUBROUTINE NCRISO(IPLIB,LPCPO,NBISO1,IMICR,HNAME,JSO,IBM,NCAL,
+     1 NGRP,NL,NW,NED,HVECT,NDEL,NBESP,NDFI,IMPX,FACT,TERP,LPURE)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover nuclear data from a single isotopic directory.
+*
+*Copyright:
+* Copyright (C) 2006 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPLIB   address of the microlib LCM object.
+* LPCPO   address of the 'CALCULATIONS' tree in the multidimensional
+*         multicompo object.
+* NBISO1  number of multicompo isotopes.
+* IMICR   index of microlib isotope corresponding to each multicompo
+*         isotope in mixture IBM.
+* HNAME   character*12 name of the multicompo isotope been processed.
+* JSO     index of the multicompo isotope been processed.
+* IBM     mixture index.
+* NCAL    number of elementary calculations in the multicompo object.
+* NGRP    number of energy groups.
+* NL      number of Legendre orders.
+* NW      type of weighting for P1 cross section info (=0 P0; =1 P1).
+* NED     number of extra vector edits.
+* HVECT   character names of the extra vector edits.
+* NDEL    number of delayed precursor groups.
+* NBESP   number of energy-dependent fission spectra.
+* NDFI    number of fissile isotopes.
+* IMPX    print parameter (equal to zero for no print).
+* FACT    number density factors.
+* TERP    interpolation weights.
+* LPURE   flag set to .true. to avoid non-linear interpolation effects.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPLIB,LPCPO
+      INTEGER NBISO1,IMICR(NBISO1),JSO,IBM,NCAL,NGRP,NL,NW,NED,NDEL,
+     1 NBESP,NDFI,IMPX
+      REAL FACT(NCAL),TERP(NCAL)
+      CHARACTER HNAME*12,HVECT(NED)*(*)
+      LOGICAL LPURE
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      REAL AWR, DECAY, EMEVF, EMEVG, FACT0, TAUXFI, TAUXF, WEIGHT
+      INTEGER ICAL, IDEL, ISP, IED, IFI, IG1, IG2, IG, ILENG, IL,
+     & ITYLCM, J, LENGTH, IW, MAXH, IOF, IOF2H
+      LOGICAL LAWR,LMEVF,LMEVG,LDECA,LWD,LYIELD,LPIFI
+      CHARACTER CM*2,TEXT12*12
+      TYPE(C_PTR) MPCPO,NPCPO,OPCPO
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: JPIF1,JPIF2,ITYPR
+      REAL, ALLOCATABLE, DIMENSION(:) :: YIEL1,PYIE1,YIEL2,PYIE2,WDLA
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: GAR1,GAR2
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: WSCA1,WSCA2
+      CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: HMAKE
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      MAXH=9+3*NW+NL+NED+2*NDEL+NBESP
+      ALLOCATE(JPIF1(NDFI),JPIF2(NDFI),ITYPR(NL))
+      ALLOCATE(GAR1(NGRP,MAXH),YIEL1(NGRP+1),PYIE1(NDFI),
+     1 WSCA1(NGRP,NGRP,NL),GAR2(NGRP,MAXH),YIEL2(NGRP+1),PYIE2(NDFI),
+     2 WSCA2(NGRP,NGRP,NL),WDLA(NDEL))
+      ALLOCATE(HMAKE(MAXH+NL))
+*----
+*  RECOVER GENERIC ISOTOPIC DATA FROM THE MULTICOMPO
+*----
+      LAWR=.FALSE.
+      LMEVF=.FALSE.
+      LMEVG=.FALSE.
+      LDECA=.FALSE.
+      LYIELD=.FALSE.
+      LPIFI=.FALSE.
+      LWD=.FALSE.
+      DO 10 ICAL=1,NCAL
+      MPCPO=LCMGIL(LPCPO,ICAL)
+      CALL LCMLEN(MPCPO,'ISOTOPESLIST',LENGTH,ITYLCM)
+      IF(LENGTH.EQ.0) GO TO 10
+      NPCPO=LCMGID(MPCPO,'ISOTOPESLIST')
+      CALL LCMLEL(NPCPO,JSO,ILENG,ITYLCM)
+      IF(ILENG.EQ.0) GO TO 10
+      OPCPO=LCMGIL(NPCPO,JSO)
+      CALL LCMGTC(OPCPO,'ALIAS',12,TEXT12)
+      IF(TEXT12(:8).NE.HNAME(:8)) GO TO 10
+      CALL LCMLEN(OPCPO,'AWR',LENGTH,ITYLCM)
+      IF(LENGTH.EQ.1) CALL LCMGET(OPCPO,'AWR',AWR)
+      LAWR=(LENGTH.EQ.1)
+      CALL LCMLEN(OPCPO,'MEVF',LENGTH,ITYLCM)
+      IF(LENGTH.EQ.1) CALL LCMGET(OPCPO,'MEVF',EMEVF)
+      LMEVF=(LENGTH.EQ.1)
+      CALL LCMLEN(OPCPO,'MEVG',LENGTH,ITYLCM)
+      IF(LENGTH.EQ.1) CALL LCMGET(OPCPO,'MEVG',EMEVG)
+      LMEVG=(LENGTH.EQ.1)
+      CALL LCMLEN(OPCPO,'DECAY',LENGTH,ITYLCM)
+      IF(LENGTH.EQ.1) CALL LCMGET(OPCPO,'DECAY',DECAY)
+      LDECA=(LENGTH.EQ.1)
+      CALL LCMLEN(OPCPO,'LAMBDA-D',LENGTH,ITYLCM)
+      LWD=(LENGTH.EQ.NDEL).AND.(NDEL.GT.0)
+      IF(LWD) CALL LCMGET(OPCPO,'LAMBDA-D',WDLA)
+      GO TO 15
+   10 CONTINUE
+      WRITE(6,170) IBM,HNAME
+      CALL XABORT('NCRISO: UNABLE TO FIND AN ISOTOPE DIRECTORY.')
+*----
+*  LOOP OVER ELEMENTARY CALCULATIONS
+*----
+   15 DO J=1,MAXH+NL
+         HMAKE(J)=' '
+      ENDDO
+      GAR2(:NGRP,:MAXH)=0.0
+      WSCA2(:NGRP,:NGRP,:NL)=0.0
+      YIEL2(:NGRP+1)=0.0
+      PYIE2(:NDFI)=0.0
+      JPIF2(:NDFI)=0
+      TAUXFI=0.0
+      DO 120 ICAL=1,NCAL
+      WEIGHT=TERP(ICAL)
+      IF(WEIGHT.EQ.0.0) GO TO 120
+      FACT0=FACT(ICAL)
+      MPCPO=LCMGIL(LPCPO,ICAL)
+      IF(IMPX.GT.4) THEN
+         WRITE(IOUT,'(39H NCRISO: MULTICOMPO ACCESS FOR ISOTOPE ,A,
+     1   16H AND CALCULATION,I5,1H.)') HNAME,ICAL
+         IF(IMPX.GT.50) CALL LCMLIB(MPCPO)
+      ENDIF
+      NPCPO=LCMGID(MPCPO,'ISOTOPESLIST')
+      CALL LCMLEL(NPCPO,JSO,ILENG,ITYLCM)
+      IF(ILENG.EQ.0) GO TO 120
+      OPCPO=LCMGIL(NPCPO,JSO)
+*----
+*  RECOVER CALCULATION-SPECIFIC ISOTOPIC DATA FROM THE MULTICOMPO
+*----
+      DO IW=1,MIN(NW+1,10)
+         WRITE(TEXT12,'(3HNWT,I1)') IW-1
+         CALL LCMLEN(OPCPO,TEXT12,LENGTH,ITYLCM)
+         IF(LENGTH.EQ.NGRP) THEN
+            CALL LCMGET(OPCPO,TEXT12,GAR1(1,IW))
+            HMAKE(IW)=TEXT12
+         ENDIF
+         WRITE(TEXT12,'(4HNWAT,I1)') IW-1
+         CALL LCMLEN(OPCPO,TEXT12,LENGTH,ITYLCM)
+         IF(LENGTH.EQ.NGRP)  THEN
+            CALL LCMGET(OPCPO,TEXT12,GAR1(1,1+NW+IW))
+            HMAKE(1+NW+IW)=TEXT12
+         ENDIF
+         WRITE(TEXT12,'(4HNTOT,I1)') IW-1
+         CALL LCMLEN(OPCPO,TEXT12,LENGTH,ITYLCM)
+         IF(LENGTH.EQ.NGRP)  THEN
+            CALL LCMGET(OPCPO,TEXT12,GAR1(1,2+2*NW+IW))
+            HMAKE(2+2*NW+IW)=TEXT12
+         ENDIF
+      ENDDO
+      CALL XDRLGS(OPCPO,-1,IMPX,0,NL-1,1,NGRP,GAR1(1,4+3*NW),WSCA1,
+     1 ITYPR)
+      DO IL=0,NL-1
+         IF(ITYPR(IL+1).NE.0) THEN
+            WRITE (CM,'(I2.2)') IL
+            HMAKE(4+3*NW+IL)='SIGS'//CM
+         ENDIF
+      ENDDO
+      CALL LCMLEN(OPCPO,'NUSIGF',LENGTH,ITYLCM)
+      IF(LENGTH.EQ.NGRP) THEN
+         CALL LCMGET(OPCPO,'NUSIGF',GAR1(1,4+3*NW+NL))
+         HMAKE(4+3*NW+NL)='NUSIGF'
+         CALL LCMGET(OPCPO,'CHI',GAR1(1,5+3*NW+NL))
+         HMAKE(5+3*NW+NL)='CHI'
+      ENDIF
+      IF(NDEL.GT.0) THEN
+         WRITE(TEXT12,'(6HNUSIGF,I2.2)') NDEL
+         CALL LCMLEN(OPCPO,TEXT12,LENGTH,ITYLCM)
+         IF(LENGTH.EQ.NGRP) THEN
+            DO IDEL=1,NDEL
+               WRITE(TEXT12,'(6HNUSIGF,I2.2)') IDEL
+               CALL LCMGET(OPCPO,TEXT12,GAR1(1,5+3*NW+NL+IDEL))
+               HMAKE(5+3*NW+NL+IDEL)=TEXT12
+            ENDDO
+         ENDIF
+         WRITE(TEXT12,'(3HCHI,I2.2)') NDEL
+         CALL LCMLEN(OPCPO,TEXT12,LENGTH,ITYLCM)
+         IF(LENGTH.EQ.NGRP) THEN
+            DO IDEL=1,NDEL
+               WRITE(TEXT12,'(3HCHI,I2.2)') IDEL
+               CALL LCMGET(OPCPO,TEXT12,GAR1(1,5+3*NW+NL+NDEL+IDEL))
+               HMAKE(5+3*NW+NL+NDEL+IDEL)=TEXT12
+            ENDDO
+         ENDIF
+      ENDIF
+      IOF2H=9+NED+NL+3*NW+2*NDEL
+      DO ISP=1,NBESP
+         WRITE(TEXT12,'(5HCHI--,I2.2)') ISP
+         CALL LCMLEN(OPCPO,TEXT12,LENGTH,ITYLCM)
+         IF(LENGTH.EQ.NGRP) THEN
+           CALL LCMGET(OPCPO,TEXT12,GAR1(1,IOF2H+ISP))
+           HMAKE(IOF2H+ISP)=TEXT12
+         ENDIF
+      ENDDO
+      CALL LCMLEN(OPCPO,'H-FACTOR',LENGTH,ITYLCM)
+      IF(LENGTH.EQ.NGRP) THEN
+         CALL LCMGET(OPCPO,'H-FACTOR',GAR1(1,6+3*NW+NL+2*NDEL))
+         HMAKE(6+3*NW+NL+2*NDEL)='H-FACTOR'
+      ENDIF
+      CALL LCMLEN(OPCPO,'OVERV',LENGTH,ITYLCM)
+      IF(LENGTH.EQ.NGRP) THEN
+         CALL LCMGET(OPCPO,'OVERV',GAR1(1,7+3*NW+NL+2*NDEL))
+         HMAKE(7+3*NW+NL+2*NDEL)='OVERV'
+      ENDIF
+      CALL LCMLEN(OPCPO,'TRANC',LENGTH,ITYLCM)
+      IF(LENGTH.EQ.NGRP) THEN
+         CALL LCMGET(OPCPO,'TRANC',GAR1(1,8+3*NW+NL+2*NDEL))
+         HMAKE(8+3*NW+NL+2*NDEL)='TRANC'
+      ENDIF
+      DO IED=1,NED
+         CALL LCMLEN(OPCPO,HVECT(IED),LENGTH,ITYLCM)
+         IF((LENGTH.GT.0).AND.(HVECT(IED).NE.'TRANC')) THEN
+            CALL LCMGET(OPCPO,HVECT(IED),GAR1(1,8+3*NW+NL+2*NDEL+IED))
+            HMAKE(8+3*NW+NL+2*NDEL+IED)=HVECT(IED)
+         ENDIF
+      ENDDO
+      CALL LCMLEN(OPCPO,'STRD',LENGTH,ITYLCM)
+      IF(LENGTH.EQ.NGRP) THEN
+         CALL LCMGET(OPCPO,'STRD',GAR1(1,9+3*NW+NL+NED+2*NDEL))
+         HMAKE(9+3*NW+NL+NED+2*NDEL)='STRD'
+      ENDIF
+*----
+*  RECOVER FISSION YIELD DATA
+*----
+      CALL LCMLEN(OPCPO,'YIELD',LENGTH,ITYLCM)
+      IF(LENGTH.EQ.NGRP+1) THEN
+         CALL LCMGET(OPCPO,'YIELD',YIEL1)
+         LYIELD=.TRUE.
+         DO IG=1,NGRP+1
+           YIEL2(IG)=YIEL2(IG)+WEIGHT*YIEL1(IG)
+         ENDDO
+      ENDIF
+      CALL LCMLEN(OPCPO,'PYIELD',LENGTH,ITYLCM)
+      IF((LENGTH.GT.0).AND.(LENGTH.EQ.NDFI)) THEN
+         CALL LCMGET(OPCPO,'PIFI',JPIF1)
+         CALL LCMGET(OPCPO,'PYIELD',PYIE1)
+         LPIFI=.TRUE.
+         DO IFI=1,NDFI
+            IF(JPIF1(IFI).GT.0) JPIF2(IFI)=IMICR(JPIF1(IFI))
+            PYIE2(IFI)=PYIE2(IFI)+WEIGHT*PYIE1(IFI)
+         ENDDO
+      ENDIF
+*----
+*  COMPUTE FISSION RATE FOR A SINGLE ELEMENTARY CALCULATION
+*----
+      TAUXF=0.0
+      IF(HMAKE(4+3*NW+NL).EQ.'NUSIGF') THEN
+        DO IG=1,NGRP
+           TAUXF=TAUXF+GAR1(IG,4+3*NW+NL)*GAR1(IG,1)
+        ENDDO
+        TAUXFI=TAUXFI+FACT0*WEIGHT*TAUXF
+      ENDIF
+*----
+*  ADD CONTRIBUTIONS FROM A SINGLE ELEMENTARY CALCULATION
+*----
+      DO J=1,MAXH
+         IF((HMAKE(J).NE.' ').AND.(HMAKE(J)(:4).NE.'SIGS')) THEN
+            DO IG=1,NGRP
+               IF((HMAKE(J)(:2).EQ.'NW').OR.(HMAKE(J).EQ.'OVERV')) THEN
+                  GAR2(IG,J)=GAR2(IG,J)+WEIGHT*GAR1(IG,J)
+               ELSE IF((HMAKE(J)(:3).EQ.'CHI').AND.(.NOT.LPURE)) THEN
+                  GAR2(IG,J)=GAR2(IG,J)+FACT0*WEIGHT*TAUXF*GAR1(IG,J)
+               ELSE
+                  GAR2(IG,J)=GAR2(IG,J)+FACT0*WEIGHT*GAR1(IG,J)
+               ENDIF
+            ENDDO
+         ENDIF
+      ENDDO
+      DO IL=1,NL
+         IOF=3+3*NW+IL
+         ITYPR(IL)=0
+         IF(HMAKE(MAXH+IL).NE.' ') ITYPR(IL)=1
+         DO IG2=1,NGRP
+            GAR2(IG2,IOF)=GAR2(IG2,IOF)+FACT0*WEIGHT*GAR1(IG2,IOF)
+            DO IG1=1,NGRP
+               WSCA2(IG1,IG2,IL)=WSCA2(IG1,IG2,IL)+FACT0*WEIGHT*
+     1         WSCA1(IG1,IG2,IL)
+            ENDDO
+         ENDDO
+      ENDDO
+  120 CONTINUE
+*----
+*  NORMALIZE FISSION SPECTRA
+*----
+      IF(.NOT.LPURE) THEN
+        DO J=1,MAXH
+           IF(HMAKE(J)(:3).EQ.'CHI') THEN
+              DO IG=1,NGRP
+                 IF(GAR2(IG,J).NE.0.0) GAR2(IG,J)=GAR2(IG,J)/TAUXFI
+              ENDDO
+           ENDIF
+        ENDDO
+      ENDIF
+*----
+*  SAVE ISOTOPIC DATA IN THE MICROLIB
+*----
+      CALL LCMPTC(IPLIB,'ALIAS',12,HNAME)
+      IF(LAWR) CALL LCMPUT(IPLIB,'AWR',1,2,AWR)
+      IF(LMEVF) CALL LCMPUT(IPLIB,'MEVF',1,2,EMEVF)
+      IF(LMEVG) CALL LCMPUT(IPLIB,'MEVG',1,2,EMEVG)
+      IF(LDECA) CALL LCMPUT(IPLIB,'DECAY',1,2,DECAY)
+      IF(LYIELD) CALL LCMPUT(IPLIB,'YIELD',NGRP+1,2,YIEL2)
+      IF(LPIFI) THEN
+         CALL LCMPUT(IPLIB,'PYIELD',NDFI,2,PYIE2)
+         CALL LCMPUT(IPLIB,'PIFI',NDFI,1,JPIF2)
+      ENDIF
+      IF(LWD) CALL LCMPUT(IPLIB,'LAMBDA-D',NDEL,2,WDLA)
+      DO J=1,MAXH
+         IF((HMAKE(J).NE.' ').AND.(HMAKE(J)(:4).NE.'SIGS')) THEN
+            CALL LCMPUT(IPLIB,HMAKE(J),NGRP,2,GAR2(1,J))
+         ENDIF
+      ENDDO
+      CALL XDRLGS(IPLIB,1,IMPX,0,NL-1,1,NGRP,GAR2(1,4+3*NW),WSCA2,ITYPR)
+      IF(IMPX.GT.50) CALL LCMLIB(IPLIB)
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(HMAKE)
+      DEALLOCATE(WDLA,WSCA2,PYIE2,YIEL2,GAR2,WSCA1,PYIE1,YIEL1,GAR1)
+      DEALLOCATE(ITYPR,JPIF2,JPIF1)
+      RETURN
+*
+  170 FORMAT(17H NCRISO: MIXTURE=,I5,10H ISOTOPE=',A12,2H'.)
+      END
diff --git a/Donjon/src/NCRLIB.f b/Donjon/src/NCRLIB.f
new file mode 100644
index 0000000..f207ed5
--- /dev/null
+++ b/Donjon/src/NCRLIB.f
@@ -0,0 +1,575 @@
+*DECK NCRLIB
+      SUBROUTINE NCRLIB(MAXNIS,MAXISO,MAXFEL,IPLIB,IPCPO,IACCS,NMIL,
+     1 NMIX,NGRP,NGFF,NALBP,IDF,IMPX,NCAL,TERP,NISO,LISO,HISO,CONC,
+     2 MIXC,LXS,LRES,LPURE,B2)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Build the microlib by scanning the NCAL elementary calculations and
+* weighting them with TERP factors.
+*
+*Copyright:
+* Copyright (C) 2006 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* MAXNIS  maximum value of NISO(I) in user data.
+* MAXISO  maximum allocated space for output microlib TOC information.
+* MAXFEL  number of fuel rings used for the micro-depletion.
+* IPLIB   address of the output microlib LCM object.
+* IPCPO   address of the multicompo object.
+* IACCS   =0 microlib is created; =1 ... is updated.
+* NMIL    number of material mixtures in the multicompo.
+* NMIX    maximum number of material mixtures in the microlib.
+* NGRP    number of energy groups.
+* NGFF    number of group form factors per energy group.
+* NALBP   number of physical albedos per energy group.
+* IDF     ADF type, 0 = none, 1 = Albedo, 2 = FD_B/FD_C/..., 3 = ADF.
+* IMPX    print parameter (equal to zero for no print).
+* NCAL    number of elementary calculations in the multicompo.
+* TERP    interpolation factors.
+* NISO    number of user-selected isotopes.
+* LISO    type of treatment (=.true.: ALL; =.false.: ONLY).
+* HISO    name of the user-selected isotopes.
+* CONC    user-defined number density of the user-selected isotopes.
+*         A value of -99.99 is set to indicate that the multicompo value
+*         is used.
+* MIXC    mixture index in the multicompo corresponding to each microlib
+*         mixture. Equal to zero if a microlib mixture is not updated.
+* LXS     =.true. if keyword 'ALLX' is specified
+* LRES    =.true. if the interpolation is done without updating isotopic 
+*         densities
+* LPURE   =.true. if the interpolation is a pure linear interpolation 
+*         with TERP factors.
+* B2      buckling
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPLIB,IPCPO
+      INTEGER MAXNIS,MAXISO,MAXFEL,IACCS,NMIL,NMIX,NGRP,NGFF,NALBP,
+     1 IDF,IMPX,NCAL,NISO(NMIX),HISO(2,NMIX,MAXNIS),MIXC(NMIX)
+      REAL TERP(NCAL,NMIX),CONC(NMIX,MAXNIS),B2
+      LOGICAL LISO(NMIX),LXS,LRES,LPURE
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXED=50
+      INTEGER, PARAMETER::NSTATE=40
+      INTEGER I0, IACCOLD, IBMOLD, IBM, ICAL, IED1, IED2, IGR,  ILONG,
+     & ISO, ITRANC, ITYLCM, I, JSO1, JSO, J, KSO1, KSO, NBISO1, NBISO2,
+     & NBISOT2, NBISOT, NBRG, NCOMB2, NCOMB, NDEL, NBESP, NDEPL, NDFI, 
+     & NED1, NED2, NFINF, NL, NW, NTYPE
+      REAL WEIGHT
+      CHARACTER TEXT12*12,HNAME*12,HSMG*131,HVECT1(MAXED)*8,
+     1 HVECT2(MAXED)*8,CHAR1*4,CHAR2*4,HHISO*8
+      INTEGER ISTATE(NSTATE)
+      LOGICAL LUSER
+      TYPE(C_PTR) JPCPO,KPCPO,LPCPO,MPCPO,JPLIB,KPLIB
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: ITYP1,ITOD1,IMIX2,ITYP2,
+     1 ITOD2,MILVO,IMICR
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: HUSE1,HNAM1,HUSE2,HNAM2
+      REAL, ALLOCATABLE, DIMENSION(:) :: TEMP1,VOL1,DENS2,TEMP2,VOL2,
+     1 DENS3,TEMP3,VOL3,ENER,DELT,VOLMI2,GAR1,GAR2
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: FACT,DENS1
+      TYPE(C_PTR), ALLOCATABLE, DIMENSION(:) :: IPLIST
+      INTEGER NBISS
+      CHARACTER ISTMPN*12
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(HUSE1(3,MAXISO),HNAM1(3,MAXISO),ITYP1(MAXISO),
+     1 ITOD1(MAXISO),IMIX2(MAXISO),ITYP2(MAXISO),ITOD2(MAXISO),
+     2 HUSE2(3,MAXISO),HNAM2(3,MAXISO),MILVO(NMIX))
+      ALLOCATE(TEMP1(MAXISO),VOL1(MAXISO),DENS2(MAXISO),TEMP2(MAXISO),
+     1 VOL2(MAXISO),ENER(NGRP+1),DELT(NGRP),VOLMI2(NMIX),IPLIST(MAXISO))
+      IACCOLD=IACCS ! for ADF and GFF 
+*----
+*  MICROLIB INITIALIZATION
+*----
+      ITRANC=0
+      VOLMI2(:NMIX)=0.0
+      DENS2(:MAXISO)=0.0
+      VOL2(:MAXISO)=0.0
+      TEMP2(:MAXISO)=0.0
+      IMIX2(:MAXISO)=0
+      ITYP2(:MAXISO)=0
+      ITOD2(:MAXISO)=0
+      IPLIST(:MAXISO)=C_NULL_PTR
+      IF(IACCS.EQ.0) THEN
+         IF(LRES) CALL XABORT('NCRLIB: RES OPTION IS INVALID.')
+         NBISO2=0
+         NCOMB2=0
+         NED2=0
+         TEXT12='L_LIBRARY'
+         CALL LCMPTC(IPLIB,'SIGNATURE',12,TEXT12)
+      ELSE
+         CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+         IF(ISTATE(1).NE.NMIX) CALL XABORT('NCRLIB: INVALID NUMBER OF '
+     1   //'MATERIAL MIXTURES IN THE MICROLIB.')
+         IF(ISTATE(3).NE.NGRP) CALL XABORT('NCRLIB: INVALID NUMBER OF '
+     1   //'ENERGY GROUPS IN THE MICROLIB.')
+         NBISO2=ISTATE(2)
+         NCOMB2=ISTATE(12)
+         IF(NBISO2.GT.MAXISO) CALL XABORT('NCRLIB: MAXISO OVERFLOW(1).')
+         NED2=ISTATE(13)
+         IF(NED2.GT.MAXED) CALL XABORT('NCRLIB: MAXED OVERFLOW.')
+         CALL LCMLEN(IPLIB,'MIXTURESVOL',ILONG,ITYLCM)
+         IF(ILONG.GT.0) THEN
+           CALL LCMGET(IPLIB,'MIXTURESVOL',VOLMI2)
+         ELSE
+           VOLMI2(:NMIX)=0.0
+         ENDIF
+         CALL LCMGET(IPLIB,'ISOTOPESUSED',HUSE2)
+         CALL LCMGET(IPLIB,'ISOTOPERNAME',HNAM2)
+         CALL LCMGET(IPLIB,'ISOTOPESTYPE',ITYP2)
+         CALL LCMGET(IPLIB,'ISOTOPESTODO',ITOD2)
+         CALL LCMGET(IPLIB,'ISOTOPESDENS',DENS2)
+         CALL LCMGET(IPLIB,'ISOTOPESVOL',VOL2)
+         CALL LCMGET(IPLIB,'ISOTOPESMIX',IMIX2)
+         CALL LCMGET(IPLIB,'ISOTOPESTEMP',TEMP2)
+         IF(NED2.GT.0) CALL LCMGTC(IPLIB,'ADDXSNAME-P0',8,NED2,HVECT2)
+         CALL LCMGET(IPLIB,'ENERGY',ENER)
+         CALL LCMGET(IPLIB,'DELTAU',DELT)
+      ENDIF
+*----
+*  RECOVER NDEPL
+*----
+      NDEPL=0
+      CALL LCMLEN(IPCPO,'DEPL-CHAIN',ILONG,ITYLCM)
+      IF(ILONG.NE.0) THEN
+        CALL LCMSIX(IPCPO,'DEPL-CHAIN',1)
+        CALL LCMGET(IPCPO,'STATE-VECTOR',ISTATE)
+        NDEPL=ISTATE(1)
+        CALL LCMSIX(IPCPO,' ',2)
+      ENDIF
+*----
+*  LOOP OVER MICROLIB MIXTURES
+*----
+      ALLOCATE(DENS3(MAXISO),TEMP3(MAXISO),VOL3(MAXISO))
+      MILVO(:NMIX)=0
+      NCOMB=0
+      JPCPO=LCMGID(IPCPO,'MIXTURES')
+      NBISS=0
+      DO 190 IBM=1,NMIX
+      IBMOLD=MIXC(IBM)
+      IF(IBMOLD.EQ.0) GO TO 190
+      IF(NISO(IBM).GT.MAXNIS) CALL XABORT('NCRLIB: MAXNIS OVERFLOW.')
+      KPCPO=LCMGIL(JPCPO,IBMOLD)
+      LPCPO=LCMGID(KPCPO,'CALCULATIONS')
+*----
+*  FIND THE VALUE OF NBISO1 IN MIXTURE IBM
+*----
+      DO ICAL=1,NCAL
+        IF(TERP(ICAL,IBM).EQ.0.0) CYCLE
+        MPCPO=LCMGIL(LPCPO,ICAL)
+        CALL LCMGET(MPCPO,'STATE-VECTOR',ISTATE)
+        NBISO1=ISTATE(2)
+        CALL LCMGET(MPCPO,'ISOTOPESUSED',HUSE1)
+        CALL LCMGET(MPCPO,'ISOTOPERNAME',HNAM1)
+        EXIT
+      ENDDO
+      ALLOCATE(FACT(NCAL,NBISO1),DENS1(NBISO1,NCAL))
+*----
+*  LOOP OVER ELEMENTARY CALCULATIONS
+*----
+      JSO1=0
+      DENS3(:NBISO1)=0.0
+      VOL3(:NBISO1)=0.0
+      TEMP3(:NBISO1)=0.0
+      DO 50 ICAL=1,NCAL
+      WEIGHT=TERP(ICAL,IBM)
+      IF(WEIGHT.EQ.0.0) GO TO 50
+      MPCPO=LCMGIL(LPCPO,ICAL)
+      IF(IMPX.GT.0) THEN
+         WRITE(IOUT,'(38H NCRLIB: MULTICOMPO ACCESS FOR MIXTURE,I8,
+     1   5H (<==,I4,17H) AND CALCULATION,I8,9H. WEIGHT=,1P,E12.4)')
+     2   IBM,IBMOLD,ICAL,WEIGHT
+         IF(IMPX.GT.50) CALL LCMLIB(MPCPO)
+      ENDIF
+      CALL LCMGET(MPCPO,'STATE-VECTOR',ISTATE)
+      IF(ISTATE(1).NE.1) CALL XABORT('NCRLIB: INVALID NUMBER OF MATERI'
+     1 //'AL MIXTURES IN THE MULTICOMPO.')
+      IF(ISTATE(2).NE.NBISO1) CALL XABORT('NCRLIB: INVALID NBISO1.')
+      IF(ISTATE(3).NE.NGRP) CALL XABORT('NCRLIB: INVALID NUMBER OF ENE'
+     1 //'RGY GROUPS IN THE MULTICOMPO.')
+      NL=ISTATE(4)
+      ITRANC=ISTATE(5)
+      NDEPL=MAX(ISTATE(11),NDEPL)
+      NED1=ISTATE(13)
+      NBESP=ISTATE(16)
+      NDEL=ISTATE(19)
+      NDFI=ISTATE(20)
+      NW=ISTATE(25)
+      IF(NED1.GT.MAXED) CALL XABORT('NCRLIB: MAXED OVERFLOW.')
+      CALL LCMLEN(MPCPO,'MIXTURESVOL',ILONG,ITYLCM)
+      IF(ILONG.GT.0) CALL LCMGET(MPCPO,'MIXTURESVOL',VOLMI2(IBM))
+      CALL LCMGET(MPCPO,'ISOTOPESDENS',DENS1(1,ICAL))
+      CALL LCMGET(MPCPO,'ISOTOPESTYPE',ITYP1)
+      CALL LCMGET(MPCPO,'ISOTOPESTODO',ITOD1)
+      CALL LCMGET(MPCPO,'ISOTOPESVOL',VOL1)
+      CALL LCMGET(MPCPO,'ISOTOPESTEMP',TEMP1)
+      IF(NED1.GT.0) CALL LCMGTC(MPCPO,'ADDXSNAME-P0',8,NED1,HVECT1)
+      CALL LCMGET(MPCPO,'ENERGY',ENER)
+      CALL LCMGET(MPCPO,'DELTAU',DELT)
+      DO 30 IED1=1,NED1
+      DO 20 IED2=1,NED2
+      IF(HVECT1(IED1).EQ.HVECT2(IED2)) GO TO 30
+   20 CONTINUE
+      NED2=NED2+1
+      IF(NED2.GT.MAXED) CALL XABORT('NCRLIB: MAXED OVERFLOW.')
+      HVECT2(NED2)=HVECT1(IED1)
+   30 CONTINUE
+      DO 49 ISO=1,NBISO1 ! multicompo isotope
+      WRITE(TEXT12,'(2A4)') (HUSE1(I,ISO),I=1,2)
+      IF(LXS) THEN
+        WRITE(CHAR1,'(A4)') HUSE1(3,ISO)
+        READ(CHAR1,'(I4)') NBRG
+        NBISOT=NBRG+MAXFEL*(IBM-1)
+        IF(NBISOT.GT.9999) CALL XABORT('NCRLIB: NBISOT OVERFLOW.')
+        WRITE(TEXT12,'(2A4,I4.4)') (HUSE1(I,ISO),I=1,2),NBISOT
+      ENDIF
+      KSO1=0
+      DO 40 KSO=1,NISO(IBM) ! user-selected isotope
+      WRITE(HHISO,'(2A4)') (HISO(I0,IBM,KSO),I0=1,2)
+      IF(TEXT12(:8).EQ.HHISO) THEN
+        KSO1=KSO
+        GO TO 45
+      ENDIF
+   40 CONTINUE
+   45 LUSER=.FALSE.
+      IF(KSO1.GT.0) LUSER=(CONC(IBM,KSO1).NE.-99.99)
+      IF(LUSER) DENS1(ISO,ICAL)=CONC(IBM,KSO1)
+      DENS3(ISO)=DENS3(ISO)+WEIGHT*DENS1(ISO,ICAL)
+      VOL3(ISO)=VOL3(ISO)+WEIGHT*VOL1(ISO)
+      TEMP3(ISO)=TEMP3(ISO)+WEIGHT*TEMP1(ISO)
+   49 CONTINUE
+   50 CONTINUE
+      FACT(:NCAL,:NBISO1)=1.0
+      IF(.NOT.LPURE) THEN
+        DO ICAL=1,NCAL
+          IF(TERP(ICAL,IBM).EQ.0.0) CYCLE
+          DO ISO=1,NBISO1 ! multicompo isotope
+            IF(DENS3(ISO).GT.DENS1(ISO,ICAL)*1.0E-9) THEN
+              FACT(ICAL,ISO)=DENS1(ISO,ICAL)/DENS3(ISO)
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDIF
+      DEALLOCATE(DENS1)
+*----
+*  SET NUMBER DENSITIES AND VOLUMES IN OUTPUT MICROLIB
+*----
+      IF(LRES) THEN
+*       -- Number densities are left unchanged except if they are
+*       -- listed in HISO array.
+        DO 60 KSO=1,NISO(IBM) ! user-selected isotope
+          DO JSO=1,NBISO2 ! microlib isotope
+            IF(IMIX2(JSO).NE.IBM) CYCLE
+            IF((HISO(1,IBM,KSO).EQ.HUSE2(1,JSO)).AND.
+     1         (HISO(2,IBM,KSO).EQ.HUSE2(2,JSO))) THEN
+              IF(CONC(IBM,KSO).EQ.-99.99) THEN
+*               -- Only number densities of isotopes set with "MICR" and
+*               -- "*" keywords are interpolated
+                DENS2(JSO)=0.0
+                DO ISO=1,NBISO1 ! multicompo isotope
+                  JSO1=0
+                  IF((HUSE1(1,ISO).EQ.HUSE2(1,JSO)).AND.
+     1               (HUSE1(2,ISO).EQ.HUSE2(2,JSO))) THEN
+                    IF(ITYP1(ISO).NE.ITYP2(JSO)) THEN
+                      WRITE(HSMG,500) 'ITYP',ISO,ITYP1(ISO),ITYP2(JSO)
+                      CALL XABORT(HSMG)
+                    ENDIF
+                    IF(LXS) THEN
+                      WRITE(CHAR1,'(A4)') HUSE1(3,ISO)
+                      WRITE(CHAR2,'(A4)') HUSE2(3,JSO)
+                      READ(CHAR2,'(I4.4)') NBISOT2
+                      NBISOT2=NBISOT2-MAXFEL*(IBM-1)
+                      WRITE(CHAR2,'(I4.4)') NBISOT2
+                      IF(CHAR1.EQ.CHAR2) THEN
+                        JSO1=JSO
+                        GO TO 55
+                      ENDIF
+                    ELSE
+                      JSO1=JSO
+                      GO TO 55
+                    ENDIF
+   55               IF(JSO1.EQ.0) CALL XABORT('NCRLIB: JSO1=0')
+                    DENS2(JSO1)=DENS2(JSO1)+DENS3(ISO)
+                    TEMP2(JSO1)=TEMP3(ISO)
+                  ENDIF
+                ENDDO
+              ELSE IF(CONC(IBM,KSO).NE.-99.99) THEN
+*               -- Number densities of isotopes set with "MICR" and
+*               -- fixed value are forced to this value
+                DENS2(JSO)=CONC(IBM,KSO)
+              ENDIF
+              GO TO 60
+            ENDIF
+          ENDDO
+          WRITE(HSMG,'(31HNCRLIB: UNABLE TO FIND ISOTOPE ,2A4,6H IN MI,
+     1    5HXTURE,I8,1H.)') HISO(1,IBM,KSO),HISO(2,IBM,KSO),IBM
+          CALL XABORT(HSMG)
+   60   CONTINUE
+      ELSE
+*       -- Number densities are interpolated or not according to
+*       -- ALL/ONLY option
+        DO JSO=1,NBISO2 ! microlib isotope
+          IF(IBM.EQ.IMIX2(JSO)) THEN
+            DO ISO=1,NBISO1 ! multicompo isotope
+              IF((HUSE1(1,ISO).EQ.HUSE2(1,JSO)).AND.
+     1           (HUSE1(2,ISO).EQ.HUSE2(2,JSO))) THEN
+                DENS2(JSO)=0.0
+                VOL2(JSO)=0.0
+                CYCLE
+              ENDIF
+            ENDDO
+          ENDIF
+        ENDDO
+        DO 110 ISO=1,NBISO1 ! multicompo isotope
+        WRITE(TEXT12,'(2A4)') (HUSE1(I,ISO),I=1,2)
+        IF(LXS) THEN
+          WRITE(CHAR1,'(A4)') HUSE1(3,ISO)
+          READ(CHAR1,'(I4)') NBRG
+          NBISOT=NBRG+MAXFEL*(IBM-1)
+          IF(NBISOT.GT.9999) CALL XABORT('NCRLIB: NBISOT OVERFLOW.')
+          WRITE(TEXT12,'(2A4,I4.4)') (HUSE1(I,ISO),I=1,2),NBISOT
+        ENDIF
+        IF(.NOT.LISO(IBM)) THEN
+*         --ONLY option
+          DO KSO=1,NISO(IBM) ! user-selected isotope
+            WRITE(HHISO,'(2A4)') (HISO(I0,IBM,KSO),I0=1,2)
+            IF(TEXT12(:8).EQ.HHISO) GO TO 65
+          ENDDO
+          GO TO 110
+        ENDIF
+   65   DO 70 JSO=1,NBISO2 ! microlib isotope
+        JSO1=0
+        IF((HUSE1(1,ISO).EQ.HUSE2(1,JSO)).AND.(HUSE1(2,ISO).EQ.
+     1  HUSE2(2,JSO)).AND.(IMIX2(JSO).EQ.IBM)) THEN
+          IF(ITYP1(ISO).NE.ITYP2(JSO)) THEN
+            WRITE(HSMG,500) 'ITYP',ISO,ITYP1(ISO),ITYP2(JSO)
+            CALL XABORT(HSMG)
+          ENDIF
+          IF(LXS) THEN
+            WRITE(CHAR1,'(A4)') HUSE1(3,ISO)
+            WRITE(CHAR2,'(A4)') HUSE2(3,JSO)
+            READ(CHAR2,'(I4.4)') NBISOT2
+            NBISOT2=NBISOT2-MAXFEL*(IBM-1)
+            WRITE(CHAR2,'(I4.4)') NBISOT2
+            IF(CHAR1.EQ.CHAR2) THEN
+              JSO1=JSO
+              GO TO 100
+            ENDIF
+          ELSE
+            JSO1=JSO
+            GO TO 100
+          ENDIF
+        ENDIF
+   70   CONTINUE
+        NBISO2=NBISO2+1
+        IF(NBISO2.GT.MAXISO) THEN
+          WRITE(IOUT,'(/16H NCRLIB: NBISO2=,I6,8H MAXISO=,I6)') NBISO2,
+     1    MAXISO
+          CALL XABORT('NCRLIB: MAXISO OVERFLOW(2).')
+        ENDIF
+        READ(TEXT12,'(3A4)') (HUSE2(I0,NBISO2),I0=1,3)
+        DO 80 I0=1,3
+        HNAM2(I0,NBISO2)=HNAM1(I0,ISO)
+   80   CONTINUE
+        IMIX2(NBISO2)=IBM
+        ITYP2(NBISO2)=ITYP1(ISO)
+        ITOD2(NBISO2)=ITOD1(ISO)
+        IF(ITYP2(NBISO2).EQ.1) ITOD2(NBISO2)=1
+        JSO1=NBISO2
+        IF(ITOD2(NBISO2).NE.1) THEN
+          DO 90 J=1,NCOMB
+          IF(IBM.EQ.MILVO(J)) GO TO 100
+   90     CONTINUE
+          NCOMB=NCOMB+1
+          IF(NCOMB.GT.NMIX) CALL XABORT('NCRLIB: MILVO OVERFLOW.')
+          MILVO(NCOMB)=IBM
+        ENDIF
+  100   DENS2(JSO1)=DENS2(JSO1)+DENS3(ISO)
+        VOL2(JSO1)=VOL2(JSO1)+VOL3(ISO)
+        TEMP2(JSO1)=TEMP3(ISO)
+  110   CONTINUE
+      ENDIF
+*----
+*  SELECT MICROLIB ISOTOPES CORRESPONDING TO MULTICOMPO ISOTOPES
+*----
+      ALLOCATE(IMICR(NBISO1))
+      IMICR(:NBISO1)=0
+      DO 130 ISO=1,NBISO2 ! microlib isotope
+      IF(IMIX2(ISO).NE.IBM) GO TO 130
+      DO 120 JSO=1,NBISO1 ! multicompo isotope
+      IF((HUSE1(1,JSO).EQ.HUSE2(1,ISO)).AND.(HUSE1(2,JSO).EQ.
+     1 HUSE2(2,ISO))) THEN
+        IF(LXS) THEN
+          WRITE(CHAR1,'(A4)') HUSE1(3,JSO)
+          WRITE(CHAR2,'(A4)') HUSE2(3,ISO)
+          READ(CHAR1,'(I4.4)') NBRG
+          NBISOT=NBRG+MAXFEL*(IBM-1)
+          READ(CHAR2,'(I4.4)') NBISOT2
+          IF(NBISOT.EQ.NBISOT2) THEN
+            IMICR(JSO)=ISO
+            GO TO 130
+          ENDIF
+        ELSE
+          IMICR(JSO)=ISO
+          GO TO 130
+        ENDIF
+      ENDIF
+  120 CONTINUE
+      WRITE(TEXT12,'(3A4)') (HUSE2(I0,ISO),I0=1,3)
+      CALL XABORT('NCRLIB: UNABLE TO FIND '//TEXT12//'.')
+  130 CONTINUE
+*----
+*  PROCESS ISOTOPE DIRECTORIES FOR MICROLIB MIXTURE IBM
+*----
+      DO 180 JSO=1,NBISO1 ! multicompo isotope
+      ISO=IMICR(JSO) ! microlib isotope
+      IF(ISO.EQ.0) GO TO 180
+      NBISS=NBISS+1
+      WRITE(HNAME,'(3A4)') (HUSE1(I0,JSO),I0=1,3)
+      WRITE(ISTMPN,'(A4,I6.6,A2)') '*ISO',NBISS,' *'
+      CALL LCMOP(KPLIB,ISTMPN,0,1,0)
+      IPLIST(ISO)=KPLIB ! set isot ISO
+      CALL NCRISO(KPLIB,LPCPO,NBISO1,IMICR,HNAME,JSO,IBMOLD,NCAL,NGRP,
+     1 NL,NW,NED2,HVECT2,NDEL,NBESP,NDFI,IMPX,FACT(1,JSO),TERP(1,IBM),
+     2 LPURE)
+  180 CONTINUE
+      DEALLOCATE(IMICR,FACT)
+  190 CONTINUE
+      DEALLOCATE(VOL3,TEMP3,DENS3)
+      DEALLOCATE(VOL1,TEMP1,MILVO,ITOD1,ITYP1,HNAM1,HUSE1)
+*----
+*  CREATE ISOTOPE LIST DIRECTORY IN MICROLIB
+*----
+      JPLIB=LCMLID(IPLIB,'ISOTOPESLIST',NBISO2)
+      DO 195 ISO=1,NBISO2 ! microlib isotope
+      IF(C_ASSOCIATED(IPLIST(ISO))) THEN
+        KPLIB=LCMDIL(JPLIB,ISO) ! step up isot ISO
+        CALL LCMEQU(IPLIST(ISO),KPLIB)
+        CALL LCMCL(IPLIST(ISO),2)
+      ENDIF
+  195 CONTINUE
+      DEALLOCATE(IPLIST)
+*----
+*  MICROLIB FINALIZATION
+*----
+      IF(.NOT.LRES) THEN
+        ISTATE(:NSTATE)=0
+        ISTATE(1)=NMIX
+        ISTATE(2)=NBISO2
+        ISTATE(3)=NGRP
+        ISTATE(4)=NL
+        ISTATE(5)=ITRANC
+        ISTATE(7)=1
+        ISTATE(11)=NDEPL
+        ISTATE(12)=NCOMB+NCOMB2
+        ISTATE(13)=NED2
+        ISTATE(14)=NMIX
+        ISTATE(18)=1
+        ISTATE(19)=NDEL
+        ISTATE(20)=NDFI
+        ISTATE(22)=MAXISO/NMIX
+        IF(NBISO2.EQ.0) CALL XABORT('NCRLIB: NBISO2=0.')
+        CALL LCMPUT(IPLIB,'STATE-VECTOR',NSTATE,1,ISTATE)
+        CALL LCMPUT(IPLIB,'MIXTURESVOL',NMIX,2,VOLMI2)
+        CALL LCMPUT(IPLIB,'ISOTOPESUSED',3*NBISO2,3,HUSE2)
+        CALL LCMPUT(IPLIB,'ISOTOPERNAME',3*NBISO2,3,HNAM2)
+        CALL LCMPUT(IPLIB,'ISOTOPESDENS',NBISO2,2,DENS2)
+        CALL LCMPUT(IPLIB,'ISOTOPESMIX',NBISO2,1,IMIX2)
+        CALL LCMPUT(IPLIB,'ISOTOPESTYPE',NBISO2,1,ITYP2)
+        CALL LCMPUT(IPLIB,'ISOTOPESTODO',NBISO2,1,ITOD2)
+        CALL LCMPUT(IPLIB,'ISOTOPESVOL',NBISO2,2,VOL2)
+        CALL LCMPUT(IPLIB,'ISOTOPESTEMP',NBISO2,2,TEMP2)
+        IF(NED2.GT.0) CALL LCMPTC(IPLIB,'ADDXSNAME-P0',8,NED2,HVECT2)
+        CALL LCMPUT(IPLIB,'ENERGY',NGRP+1,2,ENER)
+        CALL LCMPUT(IPLIB,'DELTAU',NGRP,2,DELT)
+      ELSE
+        CALL LCMPUT(IPLIB,'ISOTOPESDENS',NBISO2,2,DENS2)
+        CALL LCMPUT(IPLIB,'ISOTOPESVOL',NBISO2,2,VOL2)
+        CALL LCMPUT(IPLIB,'ISOTOPESTEMP',NBISO2,2,TEMP2)
+      ENDIF
+      IF(IMPX.GT.5) CALL LCMLIB(IPLIB)
+      IACCS=1
+      DEALLOCATE(VOLMI2,DELT,ENER,VOL2,TEMP2,DENS2,HNAM2,HUSE2,ITOD2,
+     1 ITYP2,IMIX2)
+*----
+*  BUILD EMBEDDED MACROLIB
+*----
+      CALL SPHEMB(IPLIB,IPCPO,NGRP,NMIX,MIXC,IMPX)
+*----
+*  INCLUDE LEAKAGE IN THE MACROLIB (USED ONLY FOR NON-REGRESSION TESTS)
+*----
+      IF(B2.NE.0.0) THEN
+        IF(IMPX.GT.0) WRITE(6,'(/34H NCRLIB: INCLUDE LEAKAGE IN THE MA,
+     1  11HCROLIB (B2=,1P,E12.5,2H).)') B2
+        CALL LCMSIX(IPLIB,'MACROLIB',1)
+        JPLIB=LCMGID(IPLIB,'GROUP')
+        ALLOCATE(GAR1(NMIX),GAR2(NMIX))
+        DO 210 IGR=1,NGRP
+          KPLIB=LCMGIL(JPLIB,IGR)
+          CALL LCMGET(KPLIB,'NTOT0',GAR1)
+          CALL LCMGET(KPLIB,'DIFF',GAR2)
+          DO 200 IBM=1,NMIX
+            IF(MIXC(IBM).NE.0) GAR1(IBM)=GAR1(IBM)+B2*GAR2(IBM)
+  200     CONTINUE
+          CALL LCMPUT(KPLIB,'NTOT0',NMIX,2,GAR1)
+  210   CONTINUE
+        DEALLOCATE(GAR2,GAR1)
+        CALL LCMSIX(IPLIB,' ',2)
+      ENDIF
+*----
+*  PROCESS ADF, GFF and physical albedos (if required)
+*----
+      JPCPO=LCMGID(IPCPO,'MIXTURES')
+      KPCPO=LCMGIL(JPCPO,1)
+      LPCPO=LCMGID(KPCPO,'CALCULATIONS')
+      MPCPO=LCMGIL(LPCPO,1)
+      CALL LCMGET(MPCPO,'STATE-VECTOR',ISTATE)
+      IDF=ISTATE(24)
+      NTYPE=0
+      IF(IDF.EQ.1) THEN
+        NTYPE=2
+      ELSE IF(IDF.GE.2) THEN
+        CALL LCMSIX(MPCPO,'MACROLIB',1)
+        CALL LCMLEN(MPCPO,'ADF',ILONG,ITYLCM)
+        IF(ILONG.EQ.0) CALL XABORT('NCRLIB: MISSING ADF DIRECTORY I'
+     1  //'N MULTICOMPO OBJECT.')
+        CALL LCMSIX(MPCPO,'ADF',1)
+        CALL LCMGET(MPCPO,'NTYPE',NTYPE)
+        CALL LCMSIX(MPCPO,' ',2)
+        CALL LCMSIX(MPCPO,' ',2)
+      ENDIF
+      IF(NGFF.GT.0) THEN
+        CALL LCMSIX(MPCPO,'MACROLIB',1)
+        CALL LCMLEN(MPCPO,'GFF',ILONG,ITYLCM)
+        IF(ILONG.EQ.0) CALL XABORT('NCRLIB: MISSING GFF DIRECTORY I'
+     1  //'N MULTICOMPO OBJECT.')
+        CALL LCMSIX(MPCPO,'GFF',1)
+        CALL LCMLEN(MPCPO,'FINF_NUMBER ',NFINF,ITYLCM)
+        CALL LCMSIX(MPCPO,' ',2)
+        CALL LCMSIX(MPCPO,' ',2)
+      ENDIF
+      CALL LCMSIX(IPLIB,'MACROLIB',1)
+      CALL NCRAGF(IPLIB,IPCPO,IACCOLD,NMIL,NMIX,NGRP,NGFF,NALBP,IMPX,
+     1 NCAL,TERP,MIXC,IDF,NTYPE,NFINF)
+      CALL LCMSIX(IPLIB,' ',2)
+      RETURN
+*
+  500 FORMAT(8HNCRLIB: ,A,1H(,I4,2H)=,2I5)
+      END
diff --git a/Donjon/src/NCRMAC.f b/Donjon/src/NCRMAC.f
new file mode 100644
index 0000000..6a7aa21
--- /dev/null
+++ b/Donjon/src/NCRMAC.f
@@ -0,0 +1,618 @@
+*DECK NCRMAC
+      SUBROUTINE NCRMAC(MAXNIS,IPMAC,IPCPO,IACCS,NMIL,NMIX,NGRP,NGFF,
+     1 NALBP,IDF,IMPX,NCAL,TERP,NISO,LISO,HISO,CONC,MIXC,LRES,LPURE,
+     2 B2)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Build the macrolib by scanning the NCAL elementary calculations and
+* weighting them with TERP factors.
+*
+*Copyright:
+* Copyright (C) 2012 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* MAXNIS  maximum value of NISO(I) in user data.
+* IPMAC   address of the output macrolib LCM object.
+* IPCPO   address of the multicompo object.
+* IACCS   =0 macrolib is created; =1 ... is updated.
+* NMIL    number of material mixtures in the multicompo.
+* NMIX    maximum number of material mixtures in the macrolib.
+* NGRP    number of energy groups.
+* NGFF    number of group form factors per energy group.
+* NALBP   number of physical albedos per energy group.
+* IDF     ADF type, 0 = none, 1 = Albedo, 2 = FD_B/FD_C/..., 3 = ADF.
+* IMPX    print parameter (equal to zero for no print).
+* NCAL    number of elementary calculations in the multicompo.
+* TERP    interpolation factors.
+* NISO    number of user-selected isotopes.
+* LISO    type of treatment (=.true.: ALL; =.false.: ONLY).
+* HISO    name of the user-selected isotopes.
+* CONC    user-defined number density of the user-selected isotopes.
+*         A value of -99.99 is set to indicate that the multicompo value
+*         is used.
+* MIXC    mixture index in the multicompo corresponding to each macrolib
+*         mixture. Equal to zero if a macrolib mixture is not updated.
+* LRES    =.true. if the interpolation is done without updating isotopic 
+*         densities
+* LPURE   =.true. if the interpolation is a pure linear interpolation 
+*         with TERP factors.
+* B2      buckling
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAC,IPCPO
+      INTEGER MAXNIS,IACCS,NMIL,NMIX,NGRP,NGFF,NALBP,IDF,IMPX,NCAL,
+     1 NISO(NMIX),HISO(2,NMIX,MAXNIS),MIXC(NMIX)
+      REAL TERP(NCAL,NMIX),CONC(NMIX,MAXNIS),B2
+      LOGICAL LISO(NMIX),LRES,LPURE
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXED=30
+      INTEGER, PARAMETER::MAX1D=40
+      INTEGER, PARAMETER::MAX2D=20
+      INTEGER, PARAMETER::MAXIFX=5
+      INTEGER, PARAMETER::MAXNFI=50
+      INTEGER, PARAMETER::MAXNL=6
+      INTEGER, PARAMETER::NSTATE=40
+      REAL FLOTVA, VOLMIX, WEIGHT
+      INTEGER I0, I1D, I2D, IBMOLD, IBM, ICAL, IDEL, IED, IGMAX, IGMIN,
+     & ILONG, IL, IPOSDE, ISOT, ISO, ITRAN, ITSTMP, ITYLCM, IGR, I, JGR,
+     & KSO1, KSO, MAXMIX, N1D, N2D, NBISO, NDEL, NED, NF, NL, IW, NW,
+     & NTYPE
+      INTEGER ISTATE(NSTATE),NFINF,IACCOLD
+      REAL TMPDAY(3)
+      LOGICAL LUSER,LMAKE1(MAX1D),LMAKE2(MAX2D),LFAST
+      CHARACTER TEXT8*8,TEXT12*12,HHISO*8,CM*2,HMAK1(MAX1D)*12,
+     1 HMAK2(MAX2D)*12,HVECT(MAXED)*8
+      TYPE(C_PTR) JPCPO,KPCPO,LPCPO,MPCPO,NPCPO,OPCPO,IPTMP,JPTMP,KPTMP,
+     1 JPMAC,KPMAC
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IJJ,NJJ,IPOS,ISOMI
+      REAL, ALLOCATABLE, DIMENSION(:) :: GAR4,XVOLM,WORK1,WORK2,ENERGY,
+     1 WDLA
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: FLUX
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: GAR1
+      REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: GAR2,GAR3
+      LOGICAL, ALLOCATABLE, DIMENSION(:) :: MASKL,LWT
+      CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: HNAMIS
+      INTEGER, POINTER, DIMENSION(:) :: ISONA
+      REAL, POINTER, DIMENSION(:) :: DENIS,FLOT,NWT
+      TYPE(C_PTR) ISONA_PTR,DENIS_PTR,FLOT_PTR,NWT_PTR
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(IJJ(NMIX),NJJ(NMIX),IPOS(NMIX))
+      ALLOCATE(GAR1(NMIX,NGRP,MAX1D),GAR2(NMIX,MAXNFI,NGRP,MAX2D),
+     1 GAR3(NMIX,NGRP,NGRP,MAXNL),GAR4(NMIX*NGRP))
+      IACCOLD=IACCS ! for ADF and GFF 
+*----
+*  OVERALL MULTICOMPO MIXTURE LOOP
+*----
+      NTYPE=0
+      NFINF=0
+      JPCPO=LCMGID(IPCPO,'MIXTURES')
+      DO 500 IBMOLD=1,NMIL
+      IF(IMPX.GT.0) WRITE(IOUT,'(/33H NCRMAC: PROCESS MULTICOMPO MIXTU,
+     1 2HRE,I5)') IBMOLD
+      KPCPO=LCMGIL(JPCPO,IBMOLD)
+      LPCPO=LCMGID(KPCPO,'CALCULATIONS')
+*----
+*  MACROLIB INITIALIZATION
+*----
+      IF(IACCS.EQ.0) THEN
+         MPCPO=LCMGIL(LPCPO,1)
+         CALL LCMGET(MPCPO,'STATE-VECTOR',ISTATE)
+         IF(ISTATE(1).NE.1) THEN
+            CALL XABORT('NCRMAC: INVALID NUMBER OF MIXTURES(1).')
+         ELSE IF(ISTATE(3).NE.NGRP) THEN
+            CALL XABORT('NCRMAC: INVALID NUMBER OF ENERGY GROUPS(1).')
+         ENDIF
+         NBISO=ISTATE(2)
+         NL=ISTATE(4)
+         NF=0
+         ITRAN=ISTATE(5)
+         NED=ISTATE(13)
+         NDEL=ISTATE(19)
+         IDF=ISTATE(24)
+         NW=ISTATE(25)
+         IF(NED.GT.MAXED) CALL XABORT('NCRMAC: MAXED OVERFLOW(1).')
+         ALLOCATE(ENERGY(NGRP+1))
+         IF(NED.GT.0) CALL LCMGTC(MPCPO,'ADDXSNAME-P0',8,NED,HVECT)
+         CALL LCMGET(MPCPO,'ENERGY',ENERGY)
+         TEXT12='L_MACROLIB'
+         CALL LCMPTC(IPMAC,'SIGNATURE',12,TEXT12)
+         ISTATE(:NSTATE)=0
+         ISTATE(1)=NGRP
+         ISTATE(2)=NMIX
+         ISTATE(3)=NL
+         ISTATE(5)=NED
+         ISTATE(6)=ITRAN
+         ISTATE(7)=NDEL
+         ISTATE(8)=NALBP
+         ISTATE(10)=NW
+         ISTATE(12)=IDF
+         ISTATE(16)=NGFF
+         CALL LCMPUT(IPMAC,'STATE-VECTOR',NSTATE,1,ISTATE)
+         CALL LCMPUT(IPMAC,'ENERGY',NGRP+1,2,ENERGY)
+         IF(NED.GT.0) CALL LCMPTC(IPMAC,'ADDXSNAME-P0',8,NED,HVECT)
+         DEALLOCATE(ENERGY)
+         IF(NBISO.GT.0) THEN
+           ALLOCATE(HNAMIS(NBISO))
+           CALL LCMGTC(MPCPO,'ISOTOPESUSED',12,NBISO,HNAMIS)
+           NPCPO=LCMGID(MPCPO,'ISOTOPESLIST')
+           DO ISO=1,NBISO
+             OPCPO=LCMGIL(NPCPO,ISO)
+             CALL LCMLEN(OPCPO,'LAMBDA-D',ILONG,ITYLCM)
+             IF((ILONG.EQ.NDEL).AND.(NDEL.GT.0)) THEN
+               ALLOCATE(WDLA(NDEL))
+               CALL LCMGET(OPCPO,'LAMBDA-D',WDLA)
+               CALL LCMPUT(IPMAC,'LAMBDA-D',NDEL,2,WDLA)
+               DEALLOCATE(WDLA)
+               IF(HNAMIS(ISO).EQ.'U235') GO TO 10
+               IF(HNAMIS(ISO).EQ.'*MAC*RES') GO TO 10
+             ENDIF
+           ENDDO
+   10      DEALLOCATE(HNAMIS)
+         ENDIF
+         IF(IDF.EQ.1) THEN
+           NTYPE=2
+         ELSE IF(IDF.GE.2) THEN
+           CALL LCMSIX(MPCPO,'MACROLIB',1)
+           CALL LCMLEN(MPCPO,'ADF',ILONG,ITYLCM)
+           IF(ILONG.EQ.0) CALL XABORT('NCRMAC: MISSING ADF DIRECTORY I'
+     1     //'N MULTICOMPO OBJECT.')
+           CALL LCMSIX(MPCPO,'ADF',1)
+           CALL LCMGET(MPCPO,'NTYPE',NTYPE)
+           CALL LCMSIX(MPCPO,' ',2)
+           CALL LCMSIX(MPCPO,' ',2)
+         ENDIF
+         IF(NGFF.NE.0) THEN
+           CALL LCMSIX(MPCPO,'MACROLIB',1)
+           CALL LCMLEN(MPCPO,'GFF',ILONG,ITYLCM)
+           IF(ILONG.EQ.0) CALL XABORT('NCRMAC: MISSING GFF DIRECTORY I'
+     1     //'N MULTICOMPO OBJECT.')
+           CALL LCMSIX(MPCPO,'GFF',1)
+           CALL LCMLEN(MPCPO,'FINF_NUMBER ',NFINF,ITYLCM)
+           CALL LCMSIX(MPCPO,' ',2)
+           CALL LCMSIX(MPCPO,' ',2)
+         ENDIF
+         IF(NALBP.NE.0) THEN
+           CALL LCMSIX(MPCPO,'MACROLIB',1)
+           CALL LCMLEN(MPCPO,'ALBEDO',ILONG,ITYLCM)
+           IF(ILONG.NE.NALBP*NGRP) CALL XABORT('NCRMAC: MISSING PHYSIC'
+     1     //'AL ALBEDO INFO IN MULTICOMPO OBJECT.')
+           CALL LCMSIX(MPCPO,' ',2)
+         ENDIF
+      ELSE
+         CALL LCMGTC(IPMAC,'SIGNATURE',12,TEXT12)
+         IF(TEXT12.NE.'L_MACROLIB') THEN
+          CALL XABORT('NCRMAC: SIGNATURE IS '//TEXT12//'. L_MACROLIB E'
+     1    //'XPECTED.')
+         ENDIF
+         CALL LCMGET(IPMAC,'STATE-VECTOR',ISTATE)
+         IF(ISTATE(1).NE.NGRP) THEN
+            CALL XABORT('NCRMAC: INVALID NUMBER OF ENERGY GROUPS(2).')
+         ELSE IF(ISTATE(2).NE.NMIX) THEN
+            CALL XABORT('NCRMAC: INVALID NUMBER OF MIXTURES(2).')
+         ENDIF
+         NL=ISTATE(3)
+         NF=ISTATE(4)
+         NED=ISTATE(5)
+         NDEL=ISTATE(7)
+         NALBP=ISTATE(8)
+         NW=ISTATE(10)
+         IDF=ISTATE(12)
+         NGFF=ISTATE(16)
+         IF(NED.GT.MAXED) CALL XABORT('NCRMAC: MAXED OVERFLOW(2).')
+         IF(NED.GT.0) CALL LCMGTC(IPMAC,'ADDXSNAME-P0',8,NED,HVECT)
+         IF(IDF.EQ.1) THEN
+           NTYPE=2
+         ELSE IF((IDF.GE.2).AND.(IACCOLD.NE.0)) THEN
+           CALL LCMSIX(IPMAC,'ADF',1)
+           CALL LCMGET(IPMAC,'NTYPE',NTYPE)
+           CALL LCMSIX(IPMAC,' ',2)
+         ENDIF
+         IF((NGFF.NE.0).AND.(IACCOLD.NE.0)) THEN
+           CALL LCMSIX(IPMAC,'GFF',1)
+           CALL LCMLEN(IPMAC,'FINF_NUMBER ',NFINF,ITYLCM)
+           IF(NFINF.GT.MAXIFX) CALL XABORT('NCRMAC: MAXIFX OVERFLOW.')
+           CALL LCMSIX(IPMAC,' ',2)
+         ENDIF
+      ENDIF
+      N1D=8+2*NW+NED+NL
+      N2D=2*(NDEL+1)
+      IF(NL.GT.MAXNL) CALL XABORT('NCRMAC: MAXNL OVERFLOW.')
+      IF(N1D.GT.MAX1D) CALL XABORT('NCRMAC: MAX1D OVERFLOW.')
+      IF(N2D.GT.MAX2D) CALL XABORT('NCRMAC: MAX2D OVERFLOW.')
+      LMAKE1(:N1D)=.FALSE.
+      LMAKE2(:N2D)=.FALSE.
+      GAR1(:NMIX,:NGRP,:N1D)=0.0
+      GAR2(:NMIX,:MAXNFI,:NGRP,:N2D)=0.0
+      GAR3(:NMIX,:NGRP,:NGRP,:NL)=0.0
+*----
+*  SET HMAK1 AND HMAK2
+*----
+      HMAK1(:N1D)=' '
+      DO 15 IW=1,MIN(NW+1,10)
+        IF(IW.EQ.1) THEN
+          TEXT12='FLUX-INTG'
+        ELSE
+          WRITE(TEXT12,'(11HFLUX-INTG-P,I1)') IW-1
+        ENDIF
+        HMAK1(IW)=TEXT12
+        WRITE(TEXT12,'(4HNTOT,I1)') IW-1
+        HMAK1(1+NW+IW)=TEXT12
+   15 CONTINUE
+      HMAK1(3+2*NW)='OVERV'
+      HMAK1(4+2*NW)='DIFF'
+      HMAK1(5+2*NW)='DIFFX'
+      HMAK1(6+2*NW)='DIFFY'
+      HMAK1(7+2*NW)='DIFFZ'
+      HMAK1(8+2*NW)='H-FACTOR'
+      DO 20 IED=1,NED
+      HMAK1(8+2*NW+IED)=HVECT(IED)
+   20 CONTINUE
+      DO 30 IL=1,NL
+      WRITE(CM,'(I2.2)') IL-1
+      HMAK1(8+2*NW+NED+IL)='SIGS'//CM
+   30 CONTINUE
+      HMAK2(1)='NUSIGF'
+      HMAK2(2)='CHI'
+      DO 40 IDEL=1,NDEL
+      WRITE(TEXT8,'(6HNUSIGF,I2.2)') IDEL
+      HMAK2(2+2*(IDEL-1)+1)=TEXT8
+      WRITE(TEXT8,'(3HCHI,I2.2)') IDEL
+      HMAK2(2+2*(IDEL-1)+2)=TEXT8
+   40 CONTINUE
+*----
+*  READ EXISTING MACROLIB INFORMATION
+*----
+      ALLOCATE(XVOLM(NMIX))
+      XVOLM(:NMIX)=0.0
+      IF(IACCS.NE.0) THEN   ! IACCS
+        CALL LCMGET(IPMAC,'VOLUME',XVOLM)
+        JPMAC=LCMGID(IPMAC,'GROUP')
+        DO 81 IGR=1,NGRP
+        KPMAC=LCMGIL(JPMAC,IGR)
+        DO 60 I1D=1,N1D
+        CALL LCMLEN(KPMAC,HMAK1(I1D),ILONG,ITYLCM)
+        IF(ILONG.NE.0) THEN
+          LMAKE1(I1D)=.TRUE.
+          CALL LCMGET(KPMAC,HMAK1(I1D),GAR1(1,IGR,I1D))
+          DO 50 IBM=1,NMIX
+          IF(MIXC(IBM).EQ.IBMOLD) GAR1(IBM,IGR,I1D)=0.0
+   50     CONTINUE
+        ENDIF
+   60   CONTINUE
+        DO 65 I2D=1,N2D
+        CALL LCMLEN(KPMAC,HMAK2(I2D),ILONG,ITYLCM)
+        IF(ILONG.NE.0) THEN
+          LMAKE2(I2D)=.TRUE.
+          CALL LCMGET(KPMAC,HMAK2(I2D),GAR2(1,1,IGR,I2D))
+          DO 64 I=1,NF
+          DO 63 IBM=1,NMIX
+          IF(MIXC(IBM).EQ.IBMOLD) GAR2(IBM,I,IGR,I2D)=0.0
+   63     CONTINUE
+   64     CONTINUE
+        ENDIF
+   65   CONTINUE
+        DO 80 IL=1,NL
+        WRITE(CM,'(I2.2)') IL-1
+        ILONG=1
+        IF(IL.GT.1) CALL LCMLEN(KPMAC,'SCAT'//CM,ILONG,ITYLCM)
+        IF(ILONG.NE.0) THEN
+          CALL LCMGET(KPMAC,'SCAT'//CM,GAR4)
+          CALL LCMGET(KPMAC,'NJJS'//CM,NJJ)
+          CALL LCMGET(KPMAC,'IJJS'//CM,IJJ)
+          CALL LCMGET(KPMAC,'IPOS'//CM,IPOS)
+          DO 75 IBM=1,NMIX
+          IPOSDE=IPOS(IBM)
+          DO 70 JGR=IJJ(IBM),IJJ(IBM)-NJJ(IBM)+1,-1
+          GAR3(IBM,JGR,IGR,IL)=GAR4(IPOSDE)
+          IF(MIXC(IBM).EQ.IBMOLD) GAR3(IBM,JGR,IGR,IL)=0.0
+          IPOSDE=IPOSDE+1
+   70     CONTINUE
+   75     CONTINUE
+        ENDIF
+   80   CONTINUE
+   81   CONTINUE
+      ENDIF   ! IACCS
+*----
+*  OVERALL ELEMENTARY CALCULATION LOOP
+*----
+      LFAST=.TRUE.
+      DO 85 IBM=1,NMIX
+      LFAST=LFAST.AND.((MIXC(IBM).NE.IBMOLD).OR.(NISO(IBM).EQ.0))
+   85 CONTINUE
+      DO 210 ICAL=1,NCAL
+      MPCPO=LCMGIL(LPCPO,ICAL)
+      IPTMP=C_NULL_PTR
+      DO 200 IBM=1,NMIX
+      WEIGHT=TERP(ICAL,IBM)
+      IF((MIXC(IBM).NE.IBMOLD).OR.(WEIGHT.EQ.0.0)) GO TO 200
+*----
+*  PRODUCE AN ELEMENTARY MACROLIB (IF IPTMP=C_NULL_PTR)
+*----
+      IF(.NOT.C_ASSOCIATED(IPTMP)) THEN
+        ALLOCATE(FLUX(NGRP,NW+1),LWT(NW+1))
+        CALL LCMOP(IPTMP,'*ELEMENTARY*',0,1,0)
+        CALL LCMEQU(MPCPO,IPTMP)
+        IF(IMPX.GT.0) THEN
+          WRITE(IOUT,'(38H NCRMAC: MULTICOMPO ACCESS FOR MIXTURE,I8,
+     1    5H AND ,11HCALCULATION,I8,9H. WEIGHT=,1P,E12.4)') IBM,ICAL,
+     2    WEIGHT
+          IF(IMPX.GT.50) CALL LCMLIB(IPTMP)
+        ENDIF
+        CALL LCMLEN(IPTMP,'MACROLIB',ILONG,ITYLCM)
+        IF(ILONG.NE.0) CALL LCMDEL(IPTMP,'MACROLIB')
+        CALL LCMGET(IPTMP,'STATE-VECTOR',ISTATE)
+        NBISO=ISTATE(2)
+        IF(ISTATE(1).NE.1) CALL XABORT('NCRMAC: INVALID NUMBER OF MATE'
+     1  //'RIAL MIXTURES IN THE MULTICOMPO.')
+        IF(ISTATE(3).NE.NGRP) CALL XABORT('NCRMAC: INVALID NUMBER OF E'
+     1  //'NERGY GROUPS IN THE MULTICOMPO.')
+        ALLOCATE(MASKL(NGRP))
+        MASKL(:NGRP)=.TRUE.
+        CALL LCMGPD(IPTMP,'ISOTOPESUSED',ISONA_PTR)
+        CALL LCMGPD(IPTMP,'ISOTOPESDENS',DENIS_PTR)
+        CALL C_F_POINTER(ISONA_PTR,ISONA,(/ NBISO /))
+        CALL C_F_POINTER(DENIS_PTR,DENIS,(/ NBISO /))
+        IF(.NOT.LRES) THEN
+          DO 110 ISO=1,NBISO
+          WRITE(TEXT8,'(2A4)') (ISONA(3*(ISO-1)+I0),I0=1,2)
+          KSO1=0
+          DO 90 KSO=1,NISO(IBM) ! user-selected isotope
+          WRITE(HHISO,'(2A4)') (HISO(I0,IBM,KSO),I0=1,2)
+          IF(TEXT8.EQ.HHISO) THEN
+            KSO1=KSO
+            GO TO 100
+          ENDIF
+   90     CONTINUE
+          IF(.NOT.LISO(IBM)) THEN
+            DENIS(ISO)=0.0
+            GO TO 110
+          ENDIF
+  100     LUSER=.FALSE.
+          IF(KSO1.GT.0) LUSER=(CONC(IBM,KSO1).NE.-99.99)
+          IF(LUSER) DENIS(ISO)=CONC(IBM,KSO1)
+  110     CONTINUE
+        ENDIF
+        MAXMIX=1
+        ITSTMP=0
+        TMPDAY(1)=0.0
+        TMPDAY(2)=0.0
+        TMPDAY(3)=0.0
+        ALLOCATE(ISOMI(NBISO))
+        ISOMI(:NBISO)=1
+        CALL LIBMIX(IPTMP,MAXMIX,NGRP,NBISO,ISONA,ISOMI,DENIS,
+     1              .TRUE.,MASKL,ITSTMP,TMPDAY)
+        CALL LCMPPD(IPTMP,'ISOTOPESDENS',NBISO,2,DENIS_PTR)
+        DEALLOCATE(ISOMI,MASKL)
+*----
+*  RECOVER THE INTEGRATED FLUX
+*----
+        CALL LCMLEN(IPTMP,'MIXTURESVOL',ILONG,ITYLCM)
+        IF(ILONG.EQ.0) GO TO 165
+        CALL LCMGET(IPTMP,'MIXTURESVOL',VOLMIX)
+        XVOLM(IBM)=VOLMIX
+        LWT(:NW+1)=.FALSE.
+        FLUX(:NGRP,:(NW+1))=0.0
+        DO 150 ISOT=1,NBISO
+        WRITE(TEXT12,'(3A4)') (ISONA(3*(ISOT-1)+I0),I0=1,3)
+        CALL LCMLEN(IPTMP,TEXT12,ILONG,ITYLCM)
+        IF(ILONG.NE.0) THEN
+          CALL LCMSIX(IPTMP,TEXT12,1)
+          DO 140 IW=1,MIN(NW+1,10)
+          WRITE(TEXT12,'(3HNWT,I1)') IW-1
+          CALL LCMLEN(IPTMP,TEXT12,ILONG,ITYLCM)
+          IF(ILONG.EQ.NGRP) THEN
+            LWT(IW)=.TRUE.
+            CALL LCMGPD(IPTMP,TEXT12,NWT_PTR)
+            CALL C_F_POINTER(NWT_PTR,NWT,(/ NGRP /))
+            DO 130 IGR=1,NGRP
+            FLUX(IGR,IW)=NWT(IGR)*VOLMIX
+  130       CONTINUE
+          ENDIF
+  140     CONTINUE
+          CALL LCMSIX(IPTMP,' ',2)
+        ENDIF
+  150   CONTINUE
+        CALL LCMSIX(IPTMP,'MACROLIB',1)
+        JPTMP=LCMGID(IPTMP,'GROUP')
+        DO 161 IGR=1,NGRP
+        KPTMP=LCMGIL(JPTMP,IGR)
+        DO 160 IW=1,MIN(NW+1,10)
+        IF(LWT(IW)) THEN
+          IF(IW.EQ.1) THEN
+            TEXT12='FLUX-INTG'
+          ELSE
+            WRITE(TEXT12,'(11HFLUX-INTG-P,I1)') IW-1
+          ENDIF
+          CALL LCMPUT(KPTMP,TEXT12,1,2,FLUX(IGR,IW))
+        ENDIF
+  160   CONTINUE
+  161   CONTINUE
+        CALL LCMSIX(IPTMP,' ',2)
+        DEALLOCATE(LWT,FLUX)
+      ENDIF
+*----
+*  PERFORM INTERPOLATION
+*----
+  165 CALL LCMSIX(IPTMP,'MACROLIB',1)
+      CALL LCMGET(IPTMP,'STATE-VECTOR',ISTATE)
+      IF(NF.EQ.0) NF=ISTATE(4)
+      IF(NF.GT.MAXNFI) CALL XABORT('NCRMAC: MAXNFI OVERFLOW.')
+      IF(ISTATE(1).NE.NGRP) THEN
+         CALL XABORT('NCRMAC: INVALID NUMBER OF ENERGY GROUPS(3).')
+      ELSE IF(ISTATE(2).NE.1)THEN
+         CALL XABORT('NCRMAC: INVALID NUMBER OF MIXTURES(3).')
+      ELSE IF(ISTATE(3).GT.NL) THEN
+         CALL XABORT('NCRMAC: INVALID NUMBER OF LEGENDRE ORDERS(3).')
+      ELSE IF((ISTATE(4).NE.0).AND.(ISTATE(4).NE.NF)) THEN
+         CALL XABORT('NCRMAC: INVALID NUMBER OF FISSILE ISOTOPES(3).')
+      ELSE IF((ISTATE(5).NE.NED).AND.(ISTATE(5).GT.0)) THEN
+         CALL XABORT('NCRMAC: INVALID NUMBER OF EDIT REACTIONS(3).')
+      ELSE IF((ISTATE(7).NE.NDEL).AND.(ISTATE(7).GT.0)) THEN
+         CALL XABORT('NCRMAC: INVALID NUMBER OF PRECURSOR GROUPS(3).')
+      ENDIF
+      JPTMP=LCMGID(IPTMP,'GROUP')
+      DO 195 IGR=1,NGRP
+      KPTMP=LCMGIL(JPTMP,IGR)
+      DO 170 I1D=1,N1D
+      CALL LCMLEN(KPTMP,HMAK1(I1D),ILONG,ITYLCM)
+      IF(ILONG.NE.0) THEN
+        IF(ILONG.NE.1) CALL XABORT('NCRMAC: FLOTVA OVERFLOW.')
+        LMAKE1(I1D)=.TRUE.
+        CALL LCMGET(KPTMP,HMAK1(I1D),FLOTVA)
+        IF((.NOT.LPURE).AND.(I1D.GE.4+2*NW).AND.(I1D.LE.7+2*NW)) THEN
+          FLOTVA=1.0/FLOTVA
+        ENDIF
+        GAR1(IBM,IGR,I1D)=GAR1(IBM,IGR,I1D)+WEIGHT*FLOTVA
+      ENDIF
+  170 CONTINUE
+      IF(ISTATE(4).GT.0) THEN
+        DO 175 I2D=1,N2D
+        CALL LCMLEN(KPTMP,HMAK2(I2D),ILONG,ITYLCM)
+        IF(ILONG.NE.0) THEN
+          IF(ILONG.NE.NF) CALL XABORT('NCRMAC: FLOT OVERFLOW.')
+          LMAKE2(I2D)=.TRUE.
+          CALL LCMGPD(KPTMP,HMAK2(I2D),FLOT_PTR)
+          CALL C_F_POINTER(FLOT_PTR,FLOT,(/ ILONG /))
+          DO 174 I=1,NF
+          GAR2(IBM,I,IGR,I2D)=GAR2(IBM,I,IGR,I2D)+WEIGHT*FLOT(I)
+  174     CONTINUE
+        ENDIF
+  175   CONTINUE
+      ENDIF
+      DO 190 IL=1,NL
+      WRITE(CM,'(I2.2)') IL-1
+      ILONG=1
+      IF(IL.GT.1) CALL LCMLEN(KPTMP,'SCAT'//CM,ILONG,ITYLCM)
+      IF(ILONG.NE.0) THEN
+        CALL LCMGET(KPTMP,'SCAT'//CM,GAR4)
+        CALL LCMGET(KPTMP,'NJJS'//CM,NJJ)
+        CALL LCMGET(KPTMP,'IJJS'//CM,IJJ)
+        CALL LCMGET(KPTMP,'IPOS'//CM,IPOS)
+        IPOSDE=IPOS(1)
+        DO 180 JGR=IJJ(1),IJJ(1)-NJJ(1)+1,-1
+        GAR3(IBM,JGR,IGR,IL)=GAR3(IBM,JGR,IGR,IL)+WEIGHT*GAR4(IPOSDE)
+        IPOSDE=IPOSDE+1
+  180   CONTINUE
+      ENDIF
+  190 CONTINUE
+  195 CONTINUE
+      CALL LCMSIX(IPTMP,' ',2)
+      IF(.NOT.LFAST) CALL LCMCL(IPTMP,2)
+  200 CONTINUE
+      IF(C_ASSOCIATED(IPTMP)) CALL LCMCL(IPTMP,2)
+  210 CONTINUE
+*----
+*  WRITE INTERPOLATED MACROLIB INFORMATION
+*----
+      CALL LCMPUT(IPMAC,'VOLUME',NMIX,2,XVOLM)
+      DEALLOCATE(XVOLM)
+      JPMAC=LCMLID(IPMAC,'GROUP',NGRP)
+      DO 365 IGR=1,NGRP
+      KPMAC=LCMDIL(JPMAC,IGR)
+      DO 320 I1D=1,N1D
+      IF(LMAKE1(I1D)) THEN
+        IF((.NOT.LPURE).AND.(I1D.GE.4+2*NW).AND.(I1D.LE.7+2*NW)) THEN
+          DO 310 IBM=1,NMIX
+          IF(MIXC(IBM).EQ.IBMOLD) GAR1(IBM,IGR,I1D)=1./GAR1(IBM,IGR,I1D)
+  310     CONTINUE
+        ENDIF
+        CALL LCMPUT(KPMAC,HMAK1(I1D),NMIX,2,GAR1(1,IGR,I1D))
+      ENDIF
+  320 CONTINUE
+      DO 325 I2D=1,N2D
+      IF(LMAKE2(I2D).AND.(NF.GT.0)) THEN
+        CALL LCMPUT(KPMAC,HMAK2(I2D),NMIX*NF,2,GAR2(1,1,IGR,I2D))
+      ENDIF
+  325 CONTINUE
+      DO 360 IL=1,NL
+      WRITE(CM,'(I2.2)') IL-1
+      IPOSDE=0
+      DO 350 IBM=1,NMIX
+      IPOS(IBM)=IPOSDE+1
+      IGMIN=IGR
+      IGMAX=IGR
+      DO 330 JGR=1,NGRP
+      IF(GAR3(IBM,JGR,IGR,IL).NE.0.0) THEN
+        IGMIN=MIN(IGMIN,JGR)
+        IGMAX=MAX(IGMAX,JGR)
+      ENDIF
+  330 CONTINUE
+      IJJ(IBM)=IGMAX
+      NJJ(IBM)=IGMAX-IGMIN+1
+      DO 340 JGR=IGMAX,IGMIN,-1
+      IPOSDE=IPOSDE+1
+      GAR4(IPOSDE)=GAR3(IBM,JGR,IGR,IL)
+  340 CONTINUE
+  350 CONTINUE
+      IF(IPOSDE.GT.0) THEN
+        CALL LCMPUT(KPMAC,'SCAT'//CM,IPOSDE,2,GAR4)
+        CALL LCMPUT(KPMAC,'NJJS'//CM,NMIX,1,NJJ)
+        CALL LCMPUT(KPMAC,'IJJS'//CM,NMIX,1,IJJ)
+        CALL LCMPUT(KPMAC,'IPOS'//CM,NMIX,1,IPOS)
+        CALL LCMPUT(KPMAC,'SIGW'//CM,NMIX,2,GAR3(1,IGR,IGR,IL))
+      ENDIF
+  360 CONTINUE
+  365 CONTINUE
+      IACCS=1
+*----
+*  UPDATE STATE-VECTOR
+*----
+      CALL LCMGET(IPMAC,'STATE-VECTOR',ISTATE)
+      ISTATE(4)=MAX(ISTATE(4),NF)
+      IF(LMAKE1(4+2*NW)) ISTATE(9)=1
+      IF(LMAKE1(5+2*NW)) ISTATE(9)=2
+      CALL LCMPUT(IPMAC,'STATE-VECTOR',NSTATE,1,ISTATE)
+*----
+*  END OF OVERALL MULTICOMPO MIXTURE LOOP
+*----
+  500 CONTINUE
+*----
+*  INCLUDE LEAKAGE IN THE MACROLIB (USED ONLY FOR NON-REGRESSION TESTS)
+*----
+      IF(B2.NE.0.0) THEN
+        IF(IMPX.GT.0) WRITE(6,'(/34H NCRMAC: INCLUDE LEAKAGE IN THE MA,
+     1  11HCROLIB (B2=,1P,E12.5,2H).)') B2
+        JPMAC=LCMGID(IPMAC,'GROUP')
+        ALLOCATE(WORK1(NMIX),WORK2(NMIX))
+        DO 520 IGR=1,NGRP
+          KPMAC=LCMGIL(JPMAC,IGR)
+          CALL LCMGET(KPMAC,'NTOT0',WORK1)
+          CALL LCMGET(KPMAC,'DIFF',WORK2)
+          DO 510 IBM=1,NMIX
+            IF(MIXC(IBM).NE.0) WORK1(IBM)=WORK1(IBM)+B2*WORK2(IBM)
+  510     CONTINUE
+          CALL LCMPUT(KPMAC,'NTOT0',NMIX,2,WORK1)
+  520   CONTINUE
+        DEALLOCATE(WORK2,WORK1)
+      ENDIF
+*----
+*  PROCESS ADF, GFF and physical albedos (if required)
+*----
+      CALL NCRAGF(IPMAC,IPCPO,IACCOLD,NMIL,NMIX,NGRP,NGFF,NALBP,IMPX,
+     1 NCAL,TERP,MIXC,IDF,NTYPE,NFINF)
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(GAR4,GAR3,GAR2,GAR1)
+      DEALLOCATE(IPOS,NJJ,IJJ)
+      RETURN
+      END
diff --git a/Donjon/src/NCRMAP.f b/Donjon/src/NCRMAP.f
new file mode 100644
index 0000000..3ad7bb6
--- /dev/null
+++ b/Donjon/src/NCRMAP.f
@@ -0,0 +1,174 @@
+*DECK NCRMAP
+      SUBROUTINE NCRMAP(IPMAP,NPARM,HPARM,NCH,NB,IBTYP,HNAVAL,IMPX,
+     1 BURN0,BURN1,WPAR,LPARM)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* recover global parameter values from the fuel-map object.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki, R. Chambon
+*
+*Parameters: input
+* IPMAP   pointer to the fuel-map information.
+* NPARM   number of expected global parameters to be recovered from
+*         the fuel-map (burnup not included).
+* HPARM   names of these global parameters.
+* NCH     number of reactor channels.
+* NB      number of fuel bundles per channel.
+* IBTYP   type of burnup interpolation:
+*         =0 not provided; =1 time-average; =2 instantaneous;
+*         =3 derivative with respect to a single exit burnup.
+* HNAVAL  identification name corresponding to the basic naval-
+*         coordinate position of a neighbour assembly.
+* IMPX    printing index (=0 for no print).
+*
+*Parameters: output
+* BURN0   contains either low burnup integration limits or
+*         instantaneous burnups per fuel bundle.
+* BURN1   upper burnup integration limits per fuel bundle.
+* WPAR    values of the other global parameters in each bundle.
+* LPARM   existence flag for each expected global parameters.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAP
+      INTEGER NPARM,NCH,NB,IBTYP,IMPX
+      REAL BURN0(NCH,NB),BURN1(NCH,NB),WPAR(NCH,NB,NPARM)
+      LOGICAL LPARM(NPARM+1)
+      CHARACTER HPARM(NPARM+1)*(*),HNAVAL*4
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::NSTATE=40
+      INTEGER  ISTATE(NSTATE)
+      INTEGER IB, ICH, IICH, ILONG, ITYLCM, ITYPEP, JPARM
+      REAL VARTMP
+      CHARACTER HSMG*131
+      TYPE(C_PTR) JPMAP,KPMAP
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: BURNB
+      CHARACTER(LEN=4), ALLOCATABLE, DIMENSION(:) :: HSZONE
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(BURNB(NCH,NB))
+*----
+*  TIME-AVERAGE BURNUP
+*----
+      BURN0(:NCH,:NB)=0.0
+      BURN1(:NCH,:NB)=0.0
+      WPAR(:NCH,:NB,:NPARM)=0.0
+      LPARM(:NPARM+1)=.FALSE.
+      IF(IBTYP.EQ.0) THEN
+         CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+         IBTYP=ISTATE(5)
+      ENDIF
+      IF((IBTYP.EQ.0).AND.(HNAVAL.NE.' '))THEN
+*       USE THE BURNUP OF A NEIGHBOUR ASSEMBLY
+        IF(ISTATE(13).EQ.0)CALL XABORT('@NCRMAP: MISSING'
+     1   //' S-ZONE VALUES IN FUEL MAP.')
+        ALLOCATE(HSZONE(NCH))
+        CALL LCMGTC(IPMAP,'S-ZONE',4,NCH,HSZONE)
+        IICH=0
+        DO ICH=1,NCH
+          IF(HSZONE(ICH).EQ.HNAVAL) THEN
+            IICH=ICH
+            GO TO 20
+          ENDIF
+        ENDDO
+        WRITE(HSMG,'(24H@NCRMAP: UNABLE TO FIND ,A,16H IN RECORD S-ZON,
+     1  2HE.)') HNAVAL
+        CALL XABORT(HSMG)
+   20   DEALLOCATE(HSZONE)
+        CALL LCMLEN(IPMAP,'BURN-INST',ILONG,ITYLCM)
+        IF(ILONG.EQ.0)CALL XABORT('@NCRMAP: MISSING'
+     1   //' BURN-INST VALUES IN FUEL MAP.')
+        CALL LCMGET(IPMAP,'BURN-INST',BURNB)
+        DO ICH=1,NCH
+          DO IB=1,NB
+            BURN0(ICH,IB)=BURNB(IICH,IB)
+          ENDDO
+        ENDDO
+      ELSE IF((IBTYP.EQ.1).OR.(IBTYP.EQ.3))THEN
+*       LOW BURNUP LIMITS
+        CALL LCMLEN(IPMAP,'BURN-BEG',ILONG,ITYLCM)
+        IF(ILONG.EQ.0)CALL XABORT('@NCRMAP: MISSING'
+     1   //' BURN0 VALUES IN FUEL MAP.')
+        CALL LCMGET(IPMAP,'BURN-BEG',BURN0)
+*       UPPER BURNUP LIMITS
+        CALL LCMLEN(IPMAP,'BURN-END',ILONG,ITYLCM)
+        IF(ILONG.EQ.0)CALL XABORT('@NCRMAP: MISSING'
+     1   //' BURN1 VALUES IN FUEL MAP.')
+        CALL LCMGET(IPMAP,'BURN-END',BURN1)
+        IF(IMPX.GT.0)WRITE(IOUT,1000)
+        LPARM(NPARM+1)=.TRUE.
+*----
+*  INSTANTANEOUS BURNUP
+*----
+      ELSEIF(IBTYP.EQ.2)THEN
+        CALL LCMLEN(IPMAP,'BURN-INST',ILONG,ITYLCM)
+        IF(ILONG.EQ.0)CALL XABORT('@NCRMAP: MISSING'
+     1   //' BURN-INST VALUES IN FUEL MAP.')
+        CALL LCMGET(IPMAP,'BURN-INST',BURNB)
+        DO ICH=1,NCH
+          DO IB=1,NB
+            BURN0(ICH,IB)=BURNB(ICH,IB)
+            BURN1(ICH,IB)=BURNB(ICH,IB)
+          ENDDO
+        ENDDO
+        IF(IMPX.GT.0)WRITE(IOUT,1001)
+        LPARM(NPARM+1)=.TRUE.
+      ELSEIF(IBTYP.NE.0)THEN
+        CALL XABORT('@NCRMAP: INVALID BURNUP INTERPOLATION OPTION '
+     1  //'IBTYP IN FUEL MAP.')
+      ENDIF
+*----
+*  RECOVER OTHER PARAMETERS
+*----
+      IF(NPARM.GT.0) THEN
+        JPMAP=LCMGID(IPMAP,'PARAM')
+        DO 30 JPARM=1,NPARM
+          KPMAP=LCMGIL(JPMAP,JPARM)
+          CALL LCMGTC(KPMAP,'PARKEY',12,HPARM(JPARM))
+          CALL LCMGET(KPMAP,'P-TYPE',ITYPEP)
+          LPARM(JPARM)=.TRUE.
+*       Global parameter
+          IF(ITYPEP.EQ.1) THEN
+            CALL LCMLEN(KPMAP,'P-VALUE',ILONG,ITYLCM)
+            IF(ILONG.NE.1) THEN
+              WRITE(HSMG,'(37H@NCRMAP: P-VALUE LENGTH OF PARAMETER ,A,
+     1        12H IS EQUAL TO,I6,13H (MUST BE 1).)') HPARM(JPARM),ILONG
+              CALL XABORT(HSMG)
+            ENDIF
+            CALL LCMGET(KPMAP,'P-VALUE',VARTMP)
+            WPAR(:NCH,:NB,JPARM)=VARTMP
+*       Local parameter
+          ELSEIF (ITYPEP.EQ.2) THEN
+            CALL LCMGET(KPMAP,'P-VALUE',WPAR(1,1,JPARM))
+          ENDIF
+   30   CONTINUE
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(BURNB)
+      RETURN
+*
+ 1000 FORMAT(/1X,'** PERFORMING THE TIME-AVERAGE',
+     1 1X,'INTEGRATION OVER THE FUEL LATTICE **'/)
+ 1001 FORMAT(/1X,'** PERFORMING THE INSTANTANEOU',
+     1'S INTERPOLATION OVER THE FUEL LATTICE **'/)
+      END
diff --git a/Donjon/src/NCRRGR.f b/Donjon/src/NCRRGR.f
new file mode 100644
index 0000000..cea9f45
--- /dev/null
+++ b/Donjon/src/NCRRGR.f
@@ -0,0 +1,1027 @@
+*DECK NCRRGR
+      SUBROUTINE NCRRGR(IPCPO,IPMAP,LCUBIC,NMIX,IMPX,NMIL,NCAL,NCH,NB,
+     1 NFUEL,NPARM,ITER,MAXNIS,MIXC,TERP,NISO,LISO,HISO,CONC)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute TERP factors for multicompo interpolation. Use global and
+* local parameters from a fuel-map object and optional user-defined
+* values.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert, D. Sekki, R. Chambon
+*
+*Parameters: input
+* IPCPO   address of the multicompo object.
+* IPMAP   address of the fuel-map object.
+* LCUBIC  =.TRUE.: cubic Ceschino interpolation; =.FALSE: linear
+*         Lagrange interpolation.
+* NMIX    number of material mixtures in the fuel-map macrolib.
+* IMPX    printing index (=0 for no print).
+* NMIL    number of material mixtures in the multicompo.
+* NCAL    number of elementary calculations in the multicompo.
+* NCH     number of reactor channels.
+* NB      number of fuel bundles per channel.
+* NFUEL   number of fuel types.
+* NPARM   number of additional parameters (other than burnup) defined
+*         in FMAP object
+*
+*Parameters: output
+* ITER    completion flag (=0: all over; =1: use another multicompo;
+*         =2 use another L_MAP + multicompo).
+* MAXNIS  maximum value of NISO(I) in user data.
+* MIXC    mixture index in the multicompo corresponding to each microlib
+*         mixture.
+* TERP    interpolation factors.
+* NISO    number of user-selected isotopes.
+* LISO    type of treatment (=.true.: ALL; =.false.: ONLY).
+* HISO    name of the user-selected isotopes.
+* CONC    user-defined number density of the user-selected isotopes. A
+*         value of -99.99 is set to indicate that the multicompo value
+*         is used.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER, PARAMETER::MAXISD=200
+      TYPE(C_PTR) IPCPO,IPMAP
+      INTEGER NMIX,IMPX,NMIL,NCAL,NFUEL,NCH,NB,ITER,MAXNIS,
+     1        MIXC(NMIX),NPARM,HISO(2,NMIX,MAXISD),NISO(NMIX)
+      REAL TERP(NCAL,NMIX),CONC(NMIX,MAXISD)
+      LOGICAL LCUBIC,LISO(NMIX)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXADD=10
+      INTEGER, PARAMETER::MAXLIN=50
+      INTEGER, PARAMETER::MAXPAR=50
+      INTEGER, PARAMETER::MAXVAL=200
+      INTEGER, PARAMETER::NSTATE=40
+      REAL, PARAMETER::REPS=1.0E-4
+      REAL BURN0, BURN1, FLOTT, SUM, VALR1, VALR2, VARVAL
+      INTEGER I0, IBMB, IBME, IBMOLD, IBM, IBTYP, IB, ICAL, ICH, IFUEL,
+     & ILONG, IMIX, IMPY, INDIC, IPARTM, IPAR, ISO, ITYLCM, ITYPE, ITYP,
+     & IVARTY, I, JBM, JB, JCAL, JPARM, JPAR, J, LENGTH, NCOMLI, NISOMI,
+     & NITMA, NLOC, NMIXA, NPARMP, NPAR, NTOT, N
+      CHARACTER TEXT12*12,PARKEY(MAXPAR)*12,PARFMT(MAXPAR)*8,
+     1 PARKEL(MAXPAR)*12,HSMG*131,COMMEN(MAXLIN)*80,VALH(MAXPAR)*12,
+     2 RECNAM*12,VCHAR(MAXVAL)*12,PARNAM*12,HCUBIC*12,HNAVAL*12
+      INTEGER ISTATE(NSTATE),VALI(MAXPAR),NVALUE(MAXPAR),VINTE(MAXVAL),
+     1 MUPLET(2*MAXPAR),MUTYPE(2*MAXPAR),MAPLET(2*MAXPAR,MAXADD),
+     2 MATYPE(2*MAXPAR,MAXADD),IDLTA(2*MAXPAR,MAXADD),NDLTA(2*MAXPAR),
+     3 IDLTA1,MUPLT2(2*MAXPAR),MUTYP2(2*MAXPAR),HISOMI(2,MAXISD)
+      DOUBLE PRECISION DFLOTT
+      REAL VALR(2*MAXPAR,2),VREAL(MAXVAL),VALRA(2*MAXPAR,2,MAXADD),
+     1 CONCMI(MAXISD)
+      LOGICAL LDELT(2*MAXPAR),LDELT1,LSET(2*MAXPAR),LADD(2*MAXPAR),
+     1 LSET1,LADD1,LDMAP(2*MAXPAR,2),LAMAP(2*MAXPAR,2,MAXADD),
+     2 LCUB2(2*MAXPAR),LTST,LISOMI,LASBLY
+      TYPE(C_PTR) JPMAP,KPMAP,JPCPO,KPCPO,LPCPO
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: FMIX,ZONEC,MIXA
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ZONEDP
+      REAL, ALLOCATABLE, DIMENSION(:) :: BRN0,BRN1,VARC,TERPA
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: WPAR
+      LOGICAL, ALLOCATABLE, DIMENSION(:) :: LPARM,LDELTA
+      CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: HPAR
+*----
+*  SCRATCH STORAGE ALLOCATION
+*   FMIX    fuel mixture indices per fuel bundle.
+*   BRN0    contains either low burnup integration limits or
+*           instantaneous burnups per fuel bundle.
+*   BRN1    upper burnup integration limits per fuel bundle.
+*   WPAR    other parameter distributions.
+*   HPAR    'PARKEY' name of the other parameters.
+*----
+      ALLOCATE(LPARM(NPARM+1),FMIX(NCH*NB),ZONEDP(NCH,NB),ZONEC(NCH),
+     1 BRN0(NCH*NB),BRN1(NCH*NB),WPAR(NCH*NB,NPARM),LDELTA(NMIX),
+     2 HPAR(NPARM+1))
+*----
+*  RECOVER TABLE-OF-CONTENT INFORMATION FOR THE MULTICOMPO.
+*----
+      CALL LCMGET(IPCPO,'STATE-VECTOR',ISTATE)
+      NPAR=ISTATE(5)
+      NLOC=ISTATE(6)
+      NCOMLI=ISTATE(10)
+* ASBLY : 
+      LASBLY=.FALSE.
+      CALL LCMGTC(IPCPO,'COMMENT',80,NCOMLI,COMMEN)
+      IF(NPAR.GT.0)THEN
+        CALL LCMSIX(IPCPO,'GLOBAL',1)
+        CALL LCMGTC(IPCPO,'PARKEY',12,NPAR,PARKEY)
+        CALL LCMGTC(IPCPO,'PARFMT',8,NPAR,PARFMT)
+        CALL LCMGET(IPCPO,'NVALUE',NVALUE)
+        IF(IMPX.GT.0)THEN
+          DO IPAR=1,NPAR
+            WRITE(RECNAM,'(''pval'',I8.8)') IPAR
+            IF(PARFMT(IPAR).EQ.'INTEGER') THEN
+              CALL LCMGET(IPCPO,RECNAM,VINTE)
+              WRITE(IOUT,'(13H NCRRGR: KEY=,A,18H TABULATED POINTS=,
+     1        1P,6I12/(43X,6I12))') PARKEY(IPAR),(VINTE(I),I=1,
+     2        NVALUE(IPAR))
+            ELSE IF(PARFMT(IPAR).EQ.'REAL') THEN
+              CALL LCMGET(IPCPO,RECNAM,VREAL)
+              WRITE(IOUT,'(13H NCRRGR: KEY=,A,18H TABULATED POINTS=,
+     1        1P,6E12.4/(43X,6E12.4))') PARKEY(IPAR),(VREAL(I),I=1,
+     2        NVALUE(IPAR))
+            ELSE IF(PARFMT(IPAR).EQ.'STRING') THEN
+              CALL LCMGTC(IPCPO,RECNAM,12,NVALUE(IPAR),VCHAR)
+              WRITE(IOUT,'(13H NCRRGR: KEY=,A,18H TABULATED POINTS=,
+     1        1P,6A12/(43X,6A12))') PARKEY(IPAR),(VCHAR(I),I=1,
+     2        NVALUE(IPAR))
+            ENDIF
+          ENDDO
+        ENDIF
+        CALL LCMSIX(IPCPO,' ',2)
+      ENDIF
+      IF(NLOC.GT.0)THEN
+        CALL LCMSIX(IPCPO,'LOCAL',1)
+        CALL LCMGTC(IPCPO,'PARKEY',12,NLOC,PARKEL)
+        CALL LCMSIX(IPCPO,' ',2)
+        JPCPO=LCMGID(IPCPO,'MIXTURES')
+        DO IBMOLD=1,NMIL
+          KPCPO=LCMGIL(JPCPO,IBMOLD)
+          LPCPO=LCMGID(KPCPO,'TREE')
+          CALL LCMGET(LPCPO,'NVALUE',NVALUE)
+          IF(IMPX.GT.0)THEN
+            WRITE(IOUT,'(17H NCRRGR: MIXTURE=,I6)') IBMOLD
+            DO IPAR=1,NLOC
+              WRITE(RECNAM,'(''pval'',I8.8)') IPAR
+              CALL LCMGET(LPCPO,RECNAM,VREAL)
+              WRITE(IOUT,'(13H NCRRGR: KEY=,A,18H TABULATED POINTS=,
+     1        1P,6E12.4/(43X,6E12.4))') PARKEL(IPAR),(VREAL(I),I=1,
+     2        NVALUE(IPAR))
+            ENDDO
+          ENDIF
+        ENDDO
+      ENDIF
+      IF(IMPX.GT.0) THEN
+        WRITE(IOUT,'(43H NCRRGR: NUMBER OF CALCULATIONS IN MULTICOM,
+     1  3HPO=,I5)') NCAL
+        WRITE(IOUT,'(43H NCRRGR: NUMBER OF MATERIAL MIXTURES IN MUL,
+     1  8HTICOMPO=,I5)') NMIL
+        WRITE(IOUT,'(43H NCRRGR: NUMBER OF MATERIAL MIXTURES IN FUE,
+     1  6HL MAP=,I6)') NMIX
+        WRITE(IOUT,'(1X,A)') (COMMEN(I),I=1,NCOMLI)
+      ENDIF
+      TERP(:NCAL,:NMIX)=0.0
+      MIXC(:NMIX)=0
+*----
+*  READ (INTERP_DATA) AND SET VALI, VALR AND VALH PARAMETERS
+*  CORRESPONDING TO THE INTERPOLATION POINT. FILL MUPLET FOR
+*  PARAMETERS SET WITHOUT INTERPOLATION.
+*----
+      IBM=0
+      IBMB=0
+      IBME=0
+      MAXNIS=0
+      NISOMI=0
+      LISOMI=.TRUE.
+      LDELT1=.FALSE.
+      LADD1=.FALSE.
+      NISO(:NMIX)=0
+      LISO(:NMIX)=.TRUE.
+      LDELTA(:NMIX)=.FALSE.
+      IDLTA1=0
+      DO I=1,2*MAXPAR
+         LSET(I)=.FALSE.
+         LDELT(I)=.FALSE.
+         LADD(I)=.FALSE.
+         LDMAP(I,:2)=.FALSE.
+         LAMAP(I,:2,:MAXADD)=.FALSE.
+         NDLTA(I)=0
+      ENDDO
+*----
+*  READ THE PARKEY NAME OF THE BURNUP FOR THIS MULTICOMPO.
+*----
+      CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+      IF(INDIC.NE.3)CALL XABORT('NCRRGR: CHARACTER DATA EXPECTED(1).')
+      IF((TEXT12.EQ.'MIX').OR.(TEXT12.EQ.';')) THEN
+        NPARMP=NPARM
+        GO TO 30
+      ELSE
+*       add burnup to parameters
+        NPARMP=NPARM+1
+        HPAR(NPARMP)=TEXT12
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3)CALL XABORT('MCRRGR: CHARACTER DATA EXPECTED(2).')
+        IF((TEXT12.EQ.'MIX').OR.(TEXT12.EQ.';')) GO TO 30
+        HNAVAL=TEXT12
+      ENDIF
+*----
+*  MAIN LOOP OF THE SUBROUTINE (UNTIL THE END)
+*----
+   20 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+      IF(INDIC.NE.3)CALL XABORT('NCRRGR: CHARACTER DATA EXPECTED(2).')
+   30 IF(TEXT12.EQ.'MIX')THEN
+        NISOMI=0
+        LISOMI=.TRUE.
+        IVARTY=0
+        IBTYP=0
+        HNAVAL=' '
+        MUPLET(:NPAR+NLOC)=0
+        MUTYPE(:NPAR+NLOC)=0
+        VALI(:NPAR)=0
+        VALR(:NPAR+NLOC,1)=0.0
+        VALR(:NPAR+NLOC,2)=0.0
+        DO 35 I=1,MAXADD
+          MAPLET(:NPAR+NLOC,I)=0
+          MATYPE(:NPAR+NLOC,I)=0
+          VALRA(:NPAR+NLOC,1,I)=0.0
+          VALRA(:NPAR+NLOC,2,I)=0.0
+   35   CONTINUE
+        DO I=1,2*MAXPAR
+          LSET(I)=.FALSE.
+          LDELT(I)=.FALSE.
+          LADD(I)=.FALSE.
+          LDMAP(I,:2)=.FALSE.
+          LAMAP(I,:2,:MAXADD)=.FALSE.
+        ENDDO
+        DO 40 I=1,NPAR
+        VALH(I)=' '
+   40   CONTINUE
+        LCUB2(:NPAR+NLOC)=LCUBIC
+        CALL REDGET(INDIC,IBM,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1)CALL XABORT('NCRRGR: INTEGER DATA EXPECTED.')
+*       CHECK FUEL MIXTURE
+        JPMAP=LCMGID(IPMAP,'FUEL')
+        DO IFUEL=1,NFUEL
+          KPMAP=LCMGIL(JPMAP,IFUEL)
+          CALL LCMGET(KPMAP,'MIX',IMIX)
+          IF(IMIX.EQ.IBM)GOTO 50
+        ENDDO
+        WRITE(IOUT,*)'NCRRGR: UNABLE TO FIND FUEL MIXTURE ',IBM
+        CALL XABORT('NCRRGR: WRONG MIXTURE NUMBER.')
+   50   IBMOLD=1
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3)CALL XABORT('NCRRGR: CHARACTER DATA EXPECTED(3).')
+        IF(TEXT12.EQ.'FROM')THEN
+          CALL REDGET(INDIC,IBMOLD,FLOTT,TEXT12,DFLOTT)
+          IF(INDIC.NE.1)CALL XABORT('NCRRGR: INTEGER DATA EXPECTED.')
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          IF(INDIC.NE.3)CALL XABORT('NCRRGR: CHARACTER DATA EXPECTE'
+     1     //'D.')
+        ELSE IF(TEXT12.EQ.'USE') THEN
+          IBMOLD=IBM
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          IF(INDIC.NE.3)CALL XABORT('NCRRGR: CHARACTER DATA EXPECTE'
+     1     //'D.')
+* ASBLY: automatically assembly-wise unfolded geometry
+        ELSE IF(TEXT12.EQ.'ASBLY') THEN
+          IF(LASBLY) DEALLOCATE(MIXA)
+          IBMOLD=1
+          LASBLY=.TRUE.
+          JPMAP=LCMGID(IPMAP,'GEOMAP')
+          CALL LCMGET(JPMAP,'STATE-VECTOR',ISTATE)
+          CALL LCMLEN(JPMAP,'MIX-ASBLY',NITMA,INDIC)
+          IF(NITMA.EQ.0)CALL XABORT('NCRRGR: No assembly defined')
+          NMIXA=NITMA/2
+*          NMIXA=ISTATE(39)
+          ALLOCATE(MIXA(2*NMIXA))
+          CALL LCMGET(JPMAP,'MIX-ASBLY',MIXA)
+          DO I=1,NMIXA
+            IF(IBM.EQ.MIXA(I)) THEN
+              IBMB=MIXA(I+NMIXA)
+              IBME=IBMB+NMIL-1
+              CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+              IF(INDIC.NE.3)CALL XABORT('NCRRGR: CHARACTER DATA EXPECTE'
+     1     //'D.')
+              GOTO 30
+            ENDIF
+          ENDDO
+          CALL XABORT('NCRRGR: WRONG ASSEMBLY MIXTURE.')
+        ENDIF
+* ASBLY: automatically assembly-wise unfolded geometry
+        IBMB=IBM
+        IBME=IBM
+        GOTO 30
+      ELSEIF(TEXT12.EQ.'MICRO')THEN
+        IF(IBM.EQ.0) CALL XABORT('NCRRGR: MIX NOT SET (1).')
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3)CALL XABORT('NCRRGR: CHARACTER DATA EXPECTED(4).')
+        IF(TEXT12.EQ.'ALL')THEN
+          LISOMI=.TRUE.
+        ELSEIF(TEXT12.EQ.'ONLY')THEN
+          LISOMI=.FALSE.
+        ENDIF
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3)CALL XABORT('NCRRGR: CHARACTER DATA EXPECTED(5).')
+   60   IF(TEXT12.EQ.'ENDMIX')THEN
+          GOTO 30
+        ELSE
+          NISOMI=NISOMI+1
+          IF(NISOMI.GT.MAXISD) CALL XABORT('NCRRGR: MAXISD OVERFLOW.')
+          MAXNIS=MAX(MAXNIS,NISOMI)
+          READ(TEXT12,'(2A4)') (HISOMI(I0,NISOMI),I0=1,2)
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          IF(INDIC.EQ.2)THEN
+            CONCMI(NISOMI)=FLOTT
+          ELSEIF((INDIC.EQ.3).AND.(TEXT12.EQ.'*'))THEN
+            CONCMI(NISOMI)=-99.99
+          ELSE
+            CALL XABORT('NCRRGR: INVALID HISO DATA.')
+          ENDIF
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          IF(INDIC.NE.3)CALL XABORT('NCRRGR: CHARACTER DATA EXPECTED.')
+          GOTO 60
+        ENDIF
+      ELSEIF((TEXT12.EQ.'SET').OR.(TEXT12.EQ.'DELTA').OR.
+     1       (TEXT12.EQ.'ADD'))THEN
+        IF(IBM.EQ.0) CALL XABORT('NCRRGR: MIX NOT SET (2).')
+        ITYPE=0
+        LSET1=.FALSE.
+        LDELT1=.FALSE.
+        LADD1=.FALSE.
+        IF(TEXT12.EQ.'SET')THEN
+          ITYPE=1
+          LSET1=.TRUE.
+        ELSEIF(TEXT12.EQ.'DELTA')THEN
+          ITYPE=2
+          LDELT1=.TRUE.
+        ELSEIF(TEXT12.EQ.'ADD')THEN
+          ITYPE=2
+          LADD1=.TRUE.
+          IDLTA1=IDLTA1+1
+          DO 65 JPAR=1,NPAR+NLOC
+            MAPLET(JPAR,IDLTA1)=MUPLET(JPAR)
+            MATYPE(JPAR,IDLTA1)=MUTYPE(JPAR)
+   65     CONTINUE
+        ENDIF
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3)CALL XABORT('NCRRGR: CHARACTER DATA EXPECTED(7).')
+        IF((TEXT12.EQ.'LINEAR').OR.(TEXT12.EQ.'CUBIC')) THEN
+          HCUBIC=TEXT12
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        ELSE
+          HCUBIC=' '
+        ENDIF
+        IF(INDIC.NE.3)CALL XABORT('NCRRGR: CHARACTER DATA EXPECTED(8).')
+* check if parameter is global
+        IPAR=-99
+        DO I=1,NPAR
+          IF(TEXT12.EQ.PARKEY(I))THEN
+            IPAR=I
+            LPCPO=LCMGID(IPCPO,'GLOBAL')
+            IPARTM=IPAR
+            PARNAM=TEXT12
+            GOTO 70
+          ENDIF
+        ENDDO
+* check if parameter is local
+        DO I=1,NLOC
+          IF(TEXT12.EQ.PARKEL(I))THEN
+            IPAR=NPAR+I
+            JPCPO=LCMGID(IPCPO,'MIXTURES')
+            KPCPO=LCMGIL(JPCPO,IBMOLD)
+            LPCPO=LCMGID(KPCPO,'TREE')
+            IPARTM=IPAR-NPAR
+            PARNAM=TEXT12
+            GOTO 70
+          ENDIF
+        ENDDO
+        WRITE(HSMG,'(18HNCRRGR: PARAMETER ,A,14H NOT FOUND(1).)') TEXT12
+        CALL XABORT(HSMG)
+*
+   70   IF(HCUBIC.EQ.'LINEAR') THEN
+          LCUB2(IPAR)=.FALSE.
+        ELSE IF(HCUBIC.EQ.'CUBIC') THEN
+          LCUB2(IPAR)=.TRUE.
+        ENDIF
+        WRITE(RECNAM,'(''pval'',I8.8)') IPARTM
+        CALL LCMGET(LPCPO,'NVALUE',NVALUE)
+        IF(NVALUE(IPARTM).GT.MAXVAL)CALL XABORT('NCRRGR: MAXVAL OVERFL'
+     1   //'OW.')
+        CALL LCMLEN(LPCPO,RECNAM,LENGTH,ITYLCM)
+        IF(LENGTH.EQ.0)THEN
+          WRITE(HSMG,'(25HNCRRGR: GLOBAL PARAMETER ,A,9H NOT SET.)')
+     1     PARNAM
+          CALL XABORT(HSMG)
+        ENDIF
+        IF((IPAR.GT.NPAR).OR.
+     1   ((IPAR.LE.NPAR).AND.(PARFMT(IPAR).EQ.'REAL')))THEN
+          VALR1=VREAL(1)
+          VALR2=VREAL(NVALUE(IPAR))
+          CALL LCMGET(LPCPO,RECNAM,VREAL)
+          CALL REDGET(INDIC,NITMA,VALR1,TEXT12,DFLOTT)
+          IF(INDIC.EQ.2)THEN
+            VALR2=VALR1
+            IF(LSET1) THEN
+              LSET(IPAR)=.TRUE.
+              VALR(IPAR,1)=VALR1
+              VALR(IPAR,2)=VALR1
+            ENDIF
+            IF(LDELT1) THEN
+              LDELT(IPAR)=.TRUE.
+              VALR(IPAR,1)=VALR1
+              VALR(IPAR,2)=VALR1
+            ELSEIF(LADD1) THEN
+              LADD(IPAR)=.TRUE.
+              VALRA(IPAR,1,IDLTA1)=VALR1
+              VALRA(IPAR,2,IDLTA1)=VALR1
+              NDLTA(IPAR)=NDLTA(IPAR)+1
+              IF(NDLTA(IPAR).GT.MAXADD) CALL XABORT('NCRRGR: MAXADD OV'
+     1        //'ERFLOW.')
+              IDLTA(IPAR,NDLTA(IPAR))=IDLTA1
+            ENDIF
+          ELSEIF(TEXT12.EQ.'MAP')THEN
+            IF(LDELT1)THEN
+              LDELT(IPAR)=.TRUE.
+              LDMAP(IPAR,1)=.TRUE.
+            ELSEIF(LADD1)THEN
+              LADD(IPAR)=.TRUE.
+              NDLTA(IPAR)=NDLTA(IPAR)+1
+              IF(NDLTA(IPAR).GT.MAXADD) CALL XABORT('NCRRGR: MAXADD OV'
+     1        //'ERFLOW.')
+              LAMAP(IPAR,1,NDLTA(IPAR))=.TRUE.
+              IDLTA(IPAR,NDLTA(IPAR))=IDLTA1
+            ENDIF
+            IF(LSET1.AND.(.NOT.LSET(IPAR))) GO TO 20
+          ELSE
+            CALL XABORT('NCRRGR: real value or "MAP" expected(1).')
+          ENDIF
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          IF(ITYPE.GE.2)THEN
+            IF(INDIC.EQ.2)THEN
+              VALR2=FLOTT
+              IF(LDELT1)THEN
+                VALR(IPAR,2)=VALR2
+              ELSEIF(LADD1)THEN
+                VALRA(IPAR,2,IDLTA1)=VALR2
+              ENDIF
+            ELSEIF(TEXT12.EQ.'MAP')THEN
+              IF(LDELT1)THEN
+                LDMAP(IPAR,2)=.TRUE.
+              ELSEIF(LADD1)THEN
+                LAMAP(IPAR,2,IDLTA1)=.TRUE.
+              ENDIF
+            ELSE
+              CALL XABORT('NCRRGR: real value or "MAP" expected(2).')
+            ENDIF
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          ENDIF
+          LTST=.FALSE.
+          IF(.NOT.LADD1)THEN
+            IF(VALR(IPAR,1).EQ.VALR(IPAR,2)) LTST=.TRUE.
+            MUPLET(IPAR)=-1
+            MUTYPE(IPAR)=ITYPE
+          ELSE
+            MAPLET(IPAR,IDLTA1)=-1
+            MATYPE(IPAR,IDLTA1)=2
+          ENDIF
+          IF((LTST).AND.(ITYPE.EQ.1))THEN
+            DO J=1,NVALUE(IPARTM)
+              IF(ABS(VALR(IPAR,1)-VREAL(J)).LE.REPS*ABS(VREAL(J)))THEN
+                MUPLET(IPAR)=J
+                GOTO 30
+              ENDIF
+            ENDDO
+          ENDIF
+*----
+*  ERRORS HANDLING
+*----
+          IF(VALR1.LT.VREAL(1))THEN
+*           OUTSIDE OF THE DOMAIN (1)
+            WRITE(HSMG,'(23HNCRRGR: REAL PARAMETER ,A,10H WITH VALU,
+     1       1HE,1P,E12.4,26H IS OUTSIDE THE DOMAIN.(1))') PARNAM,VALR1
+             WRITE(6,*)'Domain:',VREAL(1),' <-> ',VREAL(NVALUE(IPAR))
+            CALL XABORT(HSMG)
+          ELSEIF(VALR2.GT.VREAL(NVALUE(IPARTM)))THEN
+*           OUTSIDE OF THE DOMAIN (2)
+            WRITE(HSMG,'(23HNCRRGR: REAL PARAMETER ,A,10H WITH VALU,
+     1       1HE,1P,E12.4,26H IS OUTSIDE THE DOMAIN.(2))') PARNAM,VALR2
+             WRITE(6,*)'Domain:',VREAL(1),' <-> ',VREAL(NVALUE(IPAR))
+            CALL XABORT(HSMG)
+          ELSEIF((VALR1.GT.VALR2).AND.(ITYPE.EQ.1))THEN
+*           ITYPE=1 correspond to an integral between VALR1 and VALR2
+*           otherwise it is a simple difference
+            WRITE(HSMG,'(23HNCRRGR: REAL PARAMETER ,A,9H IS DEFIN,
+     1       7HED WITH,1P,E12.4,2H >,E12.4,4H.(1))') PARNAM,
+     2       VALR1,VALR2
+            CALL XABORT(HSMG)
+          ENDIF
+          IF((LADD1).AND.(TEXT12.EQ.'REF'))THEN
+  120       IPAR=-99
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+            IF(TEXT12.EQ.'ENDREF') GOTO 140
+            DO I=1,NPAR
+              IF(TEXT12.EQ.PARKEY(I))THEN
+                IPAR=I
+                GOTO 130
+              ENDIF
+            ENDDO
+            DO I=1,NLOC
+              IF(TEXT12.EQ.PARKEL(I))THEN
+                IPAR=NPAR+I
+                GOTO 130
+              ENDIF
+            ENDDO
+            CALL XABORT('NCRRGR: PARAMETER '//TEXT12//' NOT FOUND(2).')
+  130       CONTINUE
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+            IF(INDIC.EQ.2)THEN
+              VALRA(IPAR,1,IDLTA1)=FLOTT
+              VALRA(IPAR,2,IDLTA1)=FLOTT
+              IF(IPAR.LE.NPAR)THEN
+                LPCPO=LCMGID(IPCPO,'GLOBAL')
+                IPARTM=IPAR
+              ELSE
+                JPCPO=LCMGID(IPCPO,'MIXTURES')
+                KPCPO=LCMGIL(JPCPO,IBMOLD)
+                LPCPO=LCMGID(KPCPO,'TREE')
+                IPARTM=IPAR-NPAR
+              ENDIF
+              WRITE(RECNAM,'(''pval'',I8.8)') IPARTM
+              CALL LCMGET(LPCPO,RECNAM,VREAL)
+              CALL LCMGET(LPCPO,'NVALUE',NVALUE)
+              MAPLET(IPAR,IDLTA1)=-1
+              MATYPE(IPAR,IDLTA1)=1
+              DO J=1,NVALUE(IPARTM)
+                IF(ABS(VALRA(IPAR,1,IDLTA1)-VREAL(J)).LE.
+     1             REPS*ABS(VREAL(J)))THEN
+                  MAPLET(IPAR,IDLTA1)=J
+                  GOTO 120
+                ENDIF
+              ENDDO
+            ELSEIF(TEXT12.EQ.'SAMEASREF')THEN
+              MAPLET(IPAR,IDLTA1)=-1
+              MATYPE(IPAR,IDLTA1)=-1
+            ELSE
+              CALL XABORT('NCRRGR: REAL or "SAMEASREF" expected')
+            ENDIF
+            GOTO 120
+  140       CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          ELSE IF((LDELT1).AND.(TEXT12.EQ.'REF'))THEN
+  150       IPAR=-99
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+            IF(TEXT12.EQ.'ENDREF') GOTO 170
+            DO I=1,NPAR
+              IF(TEXT12.EQ.PARKEY(I))THEN
+                IPAR=I
+                GOTO 160
+              ENDIF
+            ENDDO
+            DO I=1,NLOC
+              IF(TEXT12.EQ.PARKEL(I))THEN
+                IPAR=NPAR+I
+                GOTO 160
+              ENDIF
+            ENDDO
+            CALL XABORT('NCRRGR: PARAMETER '//TEXT12//' NOT FOUND(3).')
+  160       CONTINUE
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+            IF(INDIC.EQ.2)THEN
+              VALR(IPAR,1)=FLOTT
+              VALR(IPAR,2)=FLOTT
+              IF(IPAR.LE.NPAR)THEN
+                LPCPO=LCMGID(IPCPO,'GLOBAL')
+                IPARTM=IPAR
+              ELSE
+                JPCPO=LCMGID(IPCPO,'MIXTURES')
+                KPCPO=LCMGIL(JPCPO,IBMOLD)
+                LPCPO=LCMGID(KPCPO,'TREE')
+                IPARTM=IPAR-NPAR
+              ENDIF
+              WRITE(RECNAM,'(''pval'',I8.8)') IPARTM
+              CALL LCMGET(LPCPO,RECNAM,VREAL)
+              CALL LCMGET(LPCPO,'NVALUE',NVALUE)
+              MUPLET(IPAR)=-1
+              MUTYPE(IPAR)=1
+              DO J=1,NVALUE(IPARTM)
+                IF(ABS(VALR(IPAR,1)-VREAL(J)).LE.REPS*ABS(VREAL(J)))THEN
+                  MUPLET(IPAR)=J
+                  GOTO 150
+                ENDIF
+              ENDDO
+            ELSEIF(TEXT12.EQ.'SAMEASREF')THEN
+              MUPLET(IPAR)=-1
+              MUTYPE(IPAR)=-1
+            ELSE
+              CALL XABORT('NCRRGR: REAL or "SAMEASREF" expected')
+            ENDIF
+            GOTO 150
+  170       CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          ENDIF
+          GOTO 30
+        ELSEIF(PARFMT(IPAR).EQ.'INTEGER')THEN
+          IF(ITYPE.NE.1)CALL XABORT('NCRRGR: SET MANDATORY WITH INT'
+     1     //'EGER PARAMETERS.')
+          CALL REDGET(INDIC,VALI(IPAR),FLOTT,TEXT12,DFLOTT)
+          IF(INDIC.NE.1)CALL XABORT('NCRRGR: INTEGER DATA EXPECTED.')
+          CALL LCMGET(LPCPO,RECNAM,VINTE)
+          DO 175 J=1,NVALUE(IPAR)
+            IF(VALI(IPAR).EQ.VINTE(J))THEN
+              MUPLET(IPAR)=J
+              MUTYPE(IPAR)=ITYPE
+              GOTO 20
+            ENDIF
+  175     CONTINUE
+          WRITE(HSMG,'(26HNCRRGR: INTEGER PARAMETER ,A,9H WITH VAL,
+     1     2HUE,I5,34H NOT FOUND IN MULTICOMPO DATABASE.)')
+     2     PARKEY(IPAR), VALI(IPAR)
+           CALL XABORT(HSMG)
+        ELSEIF(PARFMT(IPAR).EQ.'STRING')THEN
+          IF(ITYPE.NE.1)CALL XABORT('NCRRGR: SET MANDATORY WITH STR'
+     1     //'ING PARAMETERS.')
+          CALL REDGET(INDIC,NITMA,FLOTT,VALH(IPAR),DFLOTT)
+          IF(INDIC.NE.3)CALL XABORT('NCRRGR: STRING DATA EXPECTED.')
+          CALL LCMGTC(LPCPO,RECNAM,12,NVALUE(IPAR),VCHAR)
+          DO 180 J=1,NVALUE(IPAR)
+            IF(VALH(IPAR).EQ.VCHAR(J))THEN
+              MUPLET(IPAR)=J
+              MUTYPE(IPAR)=ITYPE
+              GOTO 20
+            ENDIF
+  180     CONTINUE
+          WRITE(HSMG,'(25HNCRRGR: STRING PARAMETER ,A,10H WITH VALU,
+     1     1HE,A12,34H NOT FOUND IN MULTICOMPO DATABASE.)')
+     2     PARKEY(IPAR), VALH(IPAR)
+          CALL XABORT(HSMG)
+        ENDIF
+      ELSEIF(TEXT12.EQ.'TIMAV-BURN')THEN
+        IF(IBM.EQ.0) CALL XABORT('NCRRGR: MIX NOT SET (3).')
+        IBTYP=1
+      ELSEIF(TEXT12.EQ.'INST-BURN')THEN
+        IF(IBM.EQ.0) CALL XABORT('NCRRGR: MIX NOT SET (4).')
+        IBTYP=2
+      ELSEIF(TEXT12.EQ.'AVG-EX-BURN')THEN
+        IF(IBM.EQ.0) CALL XABORT('NCRRGR: MIX NOT SET (5).')
+        IBTYP=3
+        CALL REDGET(INDIC,IVARTY,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1)CALL XABORT('NCRRGR: INTEGER DATA EXPECTED.')
+      ELSEIF(TEXT12.EQ.'ENDMIX')THEN
+*----
+*  RECOVER FUEL-MAP INFORMATION.
+*----
+        IF(IMPX.GT.0) THEN
+          DO IPAR=1,NPAR
+            IF(PARFMT(IPAR).EQ.'REAL')THEN
+              IF(LCUB2(IPAR)) THEN
+                WRITE(IOUT,'(26H NCRRGR: GLOBAL PARAMETER:,A12,5H ->CU,
+     1          18HBIC INTERPOLATION.)') PARKEY(IPAR)
+              ELSE
+                WRITE(IOUT,'(26H NCRRGR: GLOBAL PARAMETER:,A12,5H ->LI,
+     1          19HNEAR INTERPOLATION.)') PARKEY(IPAR)
+              ENDIF
+            ENDIF
+          ENDDO
+          DO IPAR=1,NLOC
+            IF(LCUB2(NPAR+IPAR)) THEN
+              WRITE(IOUT,'(25H NCRRGR: LOCAL PARAMETER:,A12,8H ->CUBIC,
+     1        14HINTERPOLATION.)') PARKEL(IPAR)
+            ELSE
+              WRITE(IOUT,'(25H NCRRGR: LOCAL PARAMETER:,A12,8H ->LINEA,
+     1        16HR INTERPOLATION.)') PARKEL(IPAR)
+            ENDIF
+          ENDDO
+        ENDIF
+        FMIX(:NCH*NB)=0
+        CALL LCMGET(IPMAP,'FLMIX',FMIX)
+        CALL NCRMAP(IPMAP,NPARM,HPAR,NCH,NB,IBTYP,HNAVAL,IMPX,BRN0,BRN1,
+     1              WPAR,LPARM)
+        IF(IBTYP.EQ.3) THEN
+          IF(IVARTY.EQ.0) CALL XABORT('NCRRGR: IVARTY NOT SET.')
+          CALL LCMGET(IPMAP,'B-ZONE',ZONEC)
+          DO ICH=1,NCH
+            DO J=1,NB
+              IF(ZONEC(ICH).EQ.IVARTY) THEN
+                ZONEDP(ICH,J)=1
+              ELSE
+                ZONEDP(ICH,J)=0
+              ENDIF
+            ENDDO
+          ENDDO
+          CALL LCMLEN(IPMAP,'B-VALUE',ILONG,ITYP)
+          IF (ILONG.EQ.0) CALL XABORT('NCRRGR: NO SAVED VALUES FOR '
+     1    //'THIS TYPE OF VARIABLE IN L_MAP')
+          ALLOCATE(VARC(ILONG))
+          CALL LCMGET(IPMAP,'B-VALUE',VARC)
+          VARVAL=VARC(IVARTY)
+          DEALLOCATE(VARC)
+        ENDIF
+*----
+*  PERFORM INTERPOLATION OVER THE FUEL MAP.
+*----
+        DO 185 JPARM=1,NPARMP
+          IPAR=-99
+          DO I=1,NPAR
+            IF(HPAR(JPARM).EQ.PARKEY(I))THEN
+              IPAR=I
+              IF(LSET(IPAR)) THEN
+                IF(IMPX.GT.0) WRITE(6,*) 'L_MAP values overwritten by '
+     1          // 'the SET option for parameter '//HPAR(JPARM)
+                IF(.NOT.LADD(IPAR)) LPARM(JPARM)=.FALSE.
+              ENDIF
+              GOTO 185
+            ENDIF
+          ENDDO
+          DO I=1,NLOC
+            IF(HPAR(JPARM).EQ.PARKEL(I))THEN
+              IPAR=NPAR+I
+              IF(LSET(IPAR)) THEN
+                IF(IMPX.GT.0) WRITE(6,*) 'L_MAP values overwritten by '
+     1          // 'the SET option for parameter '//HPAR(JPARM)
+                IF(.NOT.LADD(IPAR)) LPARM(JPARM)=.FALSE.
+              ENDIF
+              GOTO 185
+            ENDIF
+          ENDDO
+          LPARM(JPARM)=.FALSE.
+  185   CONTINUE
+*----
+*  COMPUTE ALL THE MUPLETS FOR EACH BUNDLE
+*----
+        IMPY=MAX(0,IMPX-1)
+        NTOT=0
+        DO 281 JB=1,NB
+        DO 280 ICH=1,NCH
+        IB=(JB-1)*NCH+ICH
+        IF(FMIX(IB).EQ.0) GO TO 280
+        NTOT=NTOT+1
+* ASBLY: loop on multicompo mixtures        
+        DO 285 IBM=IBMB,IBME
+        IF(LASBLY) IBMOLD=IBM-IBMB+1      
+* ASBLY: end        
+        IPAR=-99
+        IF(FMIX(IB).EQ.IBM)THEN
+          IF(NTOT.GT.NMIX) CALL XABORT('NCRRGR: NMIX OVERFLOW.')
+          DO 260 JPARM=1,NPARMP
+          IF(.NOT.LPARM(JPARM))GOTO 260
+* check if parameter is global
+        DO I=1,NPAR
+          IF(HPAR(JPARM).EQ.PARKEY(I))THEN
+            IPAR=I
+            LPCPO=LCMGID(IPCPO,'GLOBAL')
+            IPARTM=IPAR
+            PARNAM=HPAR(JPARM)
+            GOTO 190
+          ENDIF
+        ENDDO
+* check if parameter is local
+        DO I=1,NLOC
+          IF(HPAR(JPARM).EQ.PARKEL(I))THEN
+            IPAR=NPAR+I
+            JPCPO=LCMGID(IPCPO,'MIXTURES')
+            KPCPO=LCMGIL(JPCPO,IBMOLD)
+            LPCPO=LCMGID(KPCPO,'TREE')
+            IPARTM=IPAR-NPAR
+            PARNAM=HPAR(JPARM)
+            GOTO 190
+          ENDIF
+        ENDDO
+        WRITE(HSMG,'(18HNCRRGR: PARAMETER ,A,14H NOT FOUND(4).)')
+     1  HPAR(JPARM)
+        CALL XABORT(HSMG)
+  190   CONTINUE
+        WRITE(RECNAM,'(''pval'',I8.8)') IPARTM
+        CALL LCMGET(LPCPO,'NVALUE',NVALUE)
+        IF(NVALUE(IPARTM).GT.MAXVAL)CALL XABORT('NCRRGR: MAXVAL OVERFL'
+     1   //'OW.')
+        CALL LCMLEN(LPCPO,RECNAM,LENGTH,ITYLCM)
+        IF(LENGTH.EQ.0)THEN
+          WRITE(HSMG,'(25HNCRRGR: GLOBAL PARAMETER ,A,9H NOT SET.)')
+     1    PARNAM
+          CALL XABORT(HSMG)
+        ENDIF
+        ITYPE=0
+        IF((JPARM.EQ.NPARMP).AND.(NPARMP.EQ.NPARM+1))THEN
+*         parameter JPARAM is burnup
+          IF(.NOT.LSET(IPAR))THEN
+            MUTYPE(IPAR)=1
+            MUPLET(IPAR)=-1
+            BURN0=0.0
+            BURN1=0.0
+            IF(IBTYP.EQ.1)THEN
+*             TIME-AVERAGE
+              BURN0=BRN0(IB)
+              BURN1=BRN1(IB)
+            ELSEIF(IBTYP.EQ.2)THEN
+*             INSTANTANEOUS
+              BURN0=BRN0(IB)
+              BURN1=BURN0
+            ELSEIF(IBTYP.EQ.3)THEN
+*             DIFFERENCIATION RELATIVE TO EXIT BURNUP
+              ITYPE=3
+              BURN0=BRN0(IB)
+              BURN1=BRN1(IB)
+            ENDIF
+            VALR(IPAR,1)=BURN0
+            VALR(IPAR,2)=BURN1
+            VALR1=VALR(IPAR,1)
+            VALR2=VALR(IPAR,2)
+            ITYPE=1
+          ENDIF
+        ELSE
+          IF(.NOT.LSET(IPAR))THEN
+            VALR(IPAR,1)=WPAR(IB,JPARM)
+            VALR(IPAR,2)=WPAR(IB,JPARM)
+            MUPLET(IPAR)=-1
+            MUTYPE(IPAR)=1
+            VALR1=VALR(IPAR,1)
+            VALR2=VALR(IPAR,2)
+            ITYPE=1
+          ENDIF
+          IF(LDMAP(IPAR,1).OR.LDMAP(IPAR,2))THEN
+            IF(LDMAP(IPAR,1)) VALR(IPAR,1)=WPAR(IB,JPARM)
+            IF(LDMAP(IPAR,2)) VALR(IPAR,2)=WPAR(IB,JPARM)
+            MUPLET(IPAR)=-1
+            MUTYPE(IPAR)=2
+            VALR1=VALR(IPAR,1)
+            VALR2=VALR(IPAR,2)
+            ITYPE=2
+          ELSE IF(LADD(IPAR))THEN
+            DO N=1,NDLTA(IPAR)
+              IDLTA1=IDLTA(IPAR,N)
+              IF(LAMAP(IPAR,1,IDLTA1)) THEN
+                VALRA(IPAR,1,IDLTA1)=WPAR(IB,JPARM)
+                MAPLET(IPAR,IDLTA1)=-1
+                MATYPE(IPAR,IDLTA1)=2
+              ENDIF
+              IF(LAMAP(IPAR,2,IDLTA1)) THEN
+                VALRA(IPAR,2,IDLTA1)=WPAR(IB,JPARM)
+                MAPLET(IPAR,IDLTA1)=-1
+                MATYPE(IPAR,IDLTA1)=2
+              ENDIF
+            ENDDO
+            VALR1=VALRA(IPAR,1,IDLTA(IPAR,1))
+            VALR2=VALRA(IPAR,2,IDLTA(IPAR,1))
+            ITYPE=2
+          ENDIF
+        ENDIF
+        LPCPO=LCMGID(IPCPO,'GLOBAL')
+        CALL LCMGET(LPCPO,'NVALUE',NVALUE)
+        IF(NVALUE(IPARTM).GT.MAXVAL) CALL XABORT('NCRRGR: MAXVAL OVE'
+     1  //'RFLOW.')
+        WRITE(RECNAM,'(''pval'',I8.8)') IPARTM
+        CALL LCMLEN(LPCPO,RECNAM,LENGTH,ITYLCM)
+        IF(LENGTH.EQ.0)THEN
+          WRITE(HSMG,'(25HNCRRGR: GLOBAL PARAMETER ,A,9H NOT SET.)')
+     1    PARNAM
+          CALL XABORT(HSMG)
+        ENDIF
+        IF(LENGTH.GT.MAXVAL) CALL XABORT('NCRRGR: MAXVAL OVERFLOW.')
+        CALL LCMGET(LPCPO,RECNAM,VREAL)
+        IF(ITYPE.EQ.1)THEN
+          IF(VALR1.EQ.VALR2)THEN
+            DO J=1,NVALUE(IPARTM)
+              IF(ABS(VALR1-VREAL(J)).LE.REPS*ABS(VREAL(J)))THEN
+                MUPLET(IPAR)=J
+                MUTYPE(IPAR)=ITYPE
+                GOTO 260
+              ENDIF
+            ENDDO
+          ENDIF
+        ENDIF
+*----
+*  ERRORS HANDLING
+*----
+        IF(VALR1.LT.VREAL(1))THEN
+*         OUTSIDE OF THE DOMAIN (1)
+          WRITE(HSMG,'(23HNCRRGR: REAL PARAMETER ,A,10H WITH VALU,
+     1    1HE,1P,E12.4,26H IS OUTSIDE THE DOMAIN(3).)') PARNAM,VALR1
+          WRITE(6,*)'Domain:',VREAL(1),' <-> ',VREAL(NVALUE(IPAR))
+          CALL XABORT(HSMG)
+        ELSEIF(VALR2.GT.VREAL(NVALUE(IPAR)))THEN
+*         OUTSIDE OF THE DOMAIN (2)
+          WRITE(HSMG,'(23HNCRRGR: REAL PARAMETER ,A,10H WITH VALU,
+     1    1HE,1P,E12.4,26H IS OUTSIDE THE DOMAIN(4).)') PARNAM,VALR2
+          WRITE(6,*)'Domain:',VREAL(1),' <-> ',VREAL(NVALUE(IPAR))
+          CALL XABORT(HSMG)
+        ELSEIF((ITYPE.EQ.1).AND.(VALR1.GT.VALR2))THEN
+*         VALR1 > VALR2
+          WRITE(HSMG,'(23HNCRRGR: REAL PARAMETER ,A,9H IS DEFIN,
+     1    7HED WITH,1P,E12.4,2H >,E12.4,4H.(2))') PARNAM,
+     2    VALR1,VALR2
+          CALL XABORT(HSMG)
+        ENDIF
+*----
+*  COMPUTE THE TERP FACTORS USING TABLE-OF-CONTENT INFORMATION.
+*----
+  260     CONTINUE
+          MIXC(NTOT)=IBMOLD
+          IF(IBMOLD.GT.NMIL)
+     1       CALL XABORT('NCRRGR: MIX OVERFLOW (COMPO).')
+          IF(IMPY.GT.2) WRITE(6,'(32H NCRRGR: COMPUTE TERP FACTORS IN,
+     1    12H NEW MIXTURE,I5,1H.)') NTOT
+          NISO(NTOT)=NISOMI
+          LISO(NTOT)=LISOMI
+          LDELTA(NTOT)=LDELT1
+          DO ISO=1,NISOMI
+            HISO(1,NTOT,ISO)=HISOMI(1,ISO)
+            HISO(2,NTOT,ISO)=HISOMI(2,ISO)
+            CONC(NTOT,ISO)=CONCMI(ISO)
+          ENDDO
+          DO JPAR=1,NPAR+NLOC
+            MUPLT2(JPAR)=MUPLET(JPAR)
+          ENDDO
+          IF(IBTYP.EQ.3)THEN
+             IF(ZONEDP(ICH,JB).NE.0) THEN
+                CALL NCRTRP(IPCPO,LCUB2,IMPY,IBMOLD,NPAR,NLOC,NCAL,
+     1                      MUPLT2,MUTYPE,VALR(1,1),VARVAL,TERP(1,NTOT))
+             ELSE
+                TERP(:NCAL,NTOT)=0.0
+             ENDIF
+          ELSE
+             CALL NCRTRP(IPCPO,LCUB2,IMPY,IBMOLD,NPAR,NLOC,NCAL,
+     1                   MUPLT2,MUTYPE,VALR(1,1),VARVAL,TERP(1,NTOT))
+          ENDIF
+*         DELTA-ADD
+          DO 270 IPAR=1,NPAR+NLOC
+            IF(LADD(IPAR))THEN
+              DO N=1,NDLTA(IPAR)
+                IDLTA1=IDLTA(IPAR,N)
+                DO JPAR=1,NPAR+NLOC
+                  MUPLT2(JPAR)=MAPLET(JPAR,IDLTA1)
+                  MUTYP2(JPAR)=MATYPE(JPAR,IDLTA1)
+                ENDDO
+                DO JPAR=1,NPAR+NLOC
+                  IF(MUTYP2(JPAR).LT.0)THEN
+                    MUPLT2(JPAR)=MUPLET(JPAR)
+                    MUTYP2(JPAR)=MUTYPE(JPAR)
+                    VALRA(JPAR,1,IDLTA1)=VALR(JPAR,1)
+                    VALRA(JPAR,2,IDLTA1)=VALR(JPAR,2)
+                  ENDIF
+                ENDDO
+                ALLOCATE(TERPA(NCAL))
+                CALL NCRTRP(IPCPO,LCUB2,IMPY,IBMOLD,NPAR,NLOC,NCAL,
+     1          MUPLT2,MUTYP2,VALRA(1,1,IDLTA1),VARVAL,TERPA(1))
+                DO 275 JCAL=1,NCAL
+                TERP(JCAL,NTOT)=TERP(JCAL,NTOT)+TERPA(JCAL)
+  275           CONTINUE
+                DEALLOCATE(TERPA)
+              ENDDO
+            ENDIF
+  270     CONTINUE
+        ENDIF
+* ASBLY: next mixture        
+  285   CONTINUE      
+* ASBLY: end        
+  280   CONTINUE
+  281   CONTINUE
+        IF(NTOT.GT.NMIX) CALL XABORT('NCRRGR: ALGORITHM FAILURE.')
+        IBM=0
+        IBMB=0
+        IBME=0
+      ELSEIF((TEXT12.EQ.'COMPO').OR.(TEXT12.EQ.'TABLE').OR.
+     1  (TEXT12.EQ.';')) THEN
+*----
+*  CHECK TERP FACTORS AND RETURN
+*----
+        IF(TEXT12.EQ.';') ITER=0
+        IF(TEXT12.EQ.'COMPO') ITER=1
+        IF(TEXT12.EQ.'TABLE') ITER=2
+        DO 300 IBM=1,NMIX
+        IBMOLD=MIXC(IBM)
+        IF(IBMOLD.EQ.0) GO TO 300
+        IF(NISO(IBM).GT.MAXNIS) CALL XABORT('NCRRGR: MAXNIS OVERFLOW.')
+        IF(LDELTA(IBM)) THEN
+          SUM=0.0
+        ELSE
+          SUM=1.0
+        ENDIF
+        DO 290 ICAL=1,NCAL
+        SUM=SUM-TERP(ICAL,IBM)
+  290   CONTINUE
+        IF(ABS(SUM).GT.1.0E-4) THEN
+           WRITE(HSMG,'(43HNCRRGR: INVALID INTERPOLATION FACTORS IN MI,
+     1     5HXTURE,I4,1H.)') IBM
+           CALL XABORT(HSMG)
+        ENDIF
+  300   CONTINUE
+*----
+*  EXIT MAIN LOOP OF THE SUBROUTINE
+*----
+        GO TO 310
+      ELSE
+        CALL XABORT('NCRRGR: '//TEXT12//' IS AN INVALID KEYWORD.')
+      ENDIF
+      GOTO 20
+*----
+*  PRINT INTERPOLATION (TERP) FACTORS
+*----
+  310 IF(IMPX.GT.2) THEN
+        WRITE(IOUT,'(/30H NCRRGR: INTERPOLATION FACTORS)')
+        DO ICAL=1,NCAL
+          DO IBM=1,NMIX
+            IF(TERP(ICAL,IBM).NE.0.0) THEN
+              WRITE(IOUT,320) ICAL,(TERP(ICAL,JBM),JBM=1,NMIX)
+              EXIT
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(HPAR,LDELTA,WPAR,BRN1,BRN0,ZONEC,ZONEDP,FMIX,LPARM)
+      IF(LASBLY) DEALLOCATE(MIXA)
+      RETURN
+  320 FORMAT(6H CALC=,I8,6H TERP=,1P,8E13.5/(20X,8E13.5))
+      END
diff --git a/Donjon/src/NCRTRP.f b/Donjon/src/NCRTRP.f
new file mode 100644
index 0000000..9b5203d
--- /dev/null
+++ b/Donjon/src/NCRTRP.f
@@ -0,0 +1,223 @@
+*DECK NCRTRP
+      SUBROUTINE NCRTRP(IPCPO,LCUB2,IMPX,IBMOLD,NPAR,NLOC,NCAL,MUPLET,
+     1 MUTYPE,VALR,VARVAL,TERP)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute the TERP interpolation/derivation/integration factors using
+* table-of-content information of the multicompo for mixture IBMOLD.
+*
+*Copyright:
+* Copyright (C) 2006 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert, R. Chambon
+*
+*Parameters: input
+* IPCPO   address of the multidimensional multicompo object.
+* LCUB2   interpolation type for each parameter (=.TRUE.: cubic Ceschino
+*         interpolation; =.FALSE: linear Lagrange interpolation).
+* IMPX    print parameter (equal to zero for no print).
+* IBMOLD  material mixture index in the multicompo.
+* NPAR    number of global parameters.
+* NLOC    number of local parameters.
+* NCAL    number of elementary calculations in the multicompo.
+* MUPLET  tuple used to identify an elementary calculation.
+* MUTYPE  type of interpolation (=1: interpolation; =2: delta-sigma).
+* VALR    real values of the interpolated point.
+* VARVAL  exit burnup used if MUTYPE(IPAR(ID))=3.
+*
+*Parameters: output
+* TERP    interpolation factors.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER, PARAMETER::MAXPAR=50
+      TYPE(C_PTR) IPCPO
+      INTEGER IMPX,IBMOLD,NPAR,NLOC,NCAL,MUPLET(NPAR+NLOC),
+     1 MUTYPE(NPAR+NLOC)
+      REAL VALR(2*MAXPAR,2),VARVAL,TERP(NCAL)
+      LOGICAL LCUB2(NPAR+NLOC)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXDIM=10
+      INTEGER, PARAMETER::MAXVAL=200
+      INTEGER IPAR(MAXDIM),NVALUE(MAXPAR),NVAL(MAXDIM),IDDIV(MAXDIM),
+     1 NVPO(2)
+      REAL VREAL(MAXVAL),T1D(MAXVAL,MAXDIM),WORK(MAXVAL)
+      REAL BURN0, BURN1, DENOM, TERTMP
+      INTEGER ICAL, IDTMP, IDTOT, ID, ILONG, ITYLCM, I, JD, MAXNVP,
+     & NDELTA, NDIM, NID, NTOT, NCRCAL
+      CHARACTER HSMG*131,RECNAM*12,PARKEY(MAXPAR)*12
+      LOGICAL LCUBIC,LSINGL
+      TYPE(C_PTR) JPCPO,KPCPO,LPCPO
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: JDEBAR,JARBVA
+      REAL, ALLOCATABLE, DIMENSION(:) :: TERPA
+*----
+*  RECOVER TREE INFORMATION
+*----
+      JPCPO=LCMGID(IPCPO,'GLOBAL')
+      CALL LCMGTC(JPCPO,'PARKEY',12,NPAR,PARKEY)
+      JPCPO=LCMGID(IPCPO,'MIXTURES')
+      KPCPO=LCMGIL(JPCPO,IBMOLD)
+      LPCPO=LCMGID(KPCPO,'TREE')
+      CALL LCMGET(LPCPO,'NVP',NVPO)
+      CALL LCMLEN(LPCPO,'ARBVAL',MAXNVP,ITYLCM)
+      IF(NVPO(1).GT.MAXNVP) CALL XABORT('NCRTRP: NVP OVERFLOW.')
+      ALLOCATE(JDEBAR(MAXNVP+1),JARBVA(MAXNVP))
+      CALL LCMGET(LPCPO,'DEBARB',JDEBAR)
+      CALL LCMGET(LPCPO,'ARBVAL',JARBVA)
+*----
+*  COMPUTE TERP FACTORS
+*----
+      TERP(:NCAL)=0.0
+      IPAR(:MAXDIM)=0
+      NDIM=0
+      NDELTA=0
+      DO 10 I=1,NPAR+NLOC
+        IF(MUPLET(I).EQ.-1) THEN
+          NDIM=NDIM+1
+          IF(MUTYPE(I).NE.1) NDELTA=NDELTA+1
+          IF(NDIM.GT.MAXDIM) THEN
+            WRITE(HSMG,'(7HNCRTRP:,I4,29H-DIMENSIONAL INTERPOLATION NO,
+     1      14HT IMPLEMENTED.)') NDIM
+            CALL XABORT(HSMG)
+          ENDIF
+          IPAR(NDIM)=I
+        ENDIF
+   10 CONTINUE
+      IF(IMPX.GT.2) THEN
+        WRITE(IOUT,'(16H NCRTRP: MUPLET=,10I4/(16X,10I4))')
+     1  (MUPLET(I),I=1,NPAR)
+        WRITE(IOUT,'(8H NCRTRP:,I4,31H-DIMENSIONAL INTERPOLATION IN C,
+     1  12HOMPO MIXTURE,I5,1H.)') NDIM,IBMOLD
+      ENDIF
+      IF(NDIM.EQ.0) THEN
+        ICAL=NCRCAL(1,NVPO(1),NPAR+NLOC,JDEBAR,JARBVA,MUPLET)
+        IF(ICAL.GT.NCAL) CALL XABORT('NCRTRP: TERP OVERFLOW(1).')
+        IF(ICAL.EQ.0) GO TO 200
+        IF(ICAL.EQ.-1) GO TO 210
+        TERP(ICAL)=1.0
+      ELSE
+        NTOT=1
+        IDDIV(:MAXDIM)=1
+        DO 70 ID=1,NDIM
+        IF(IPAR(ID).LE.NPAR) THEN
+          LPCPO=LCMGID(IPCPO,'GLOBAL')
+          WRITE(RECNAM,'(''pval'',I8.8)') IPAR(ID)
+          CALL LCMGET(LPCPO,'NVALUE',NVALUE)
+          NID=NVALUE(IPAR(ID))
+        ELSE
+          JPCPO=LCMGID(IPCPO,'MIXTURES')
+          KPCPO=LCMGIL(JPCPO,IBMOLD)
+          LPCPO=LCMGID(KPCPO,'TREE')
+          WRITE(RECNAM,'(''pval'',I8.8)') IPAR(ID)-NPAR
+          CALL LCMGET(LPCPO,'NVALUE',NVALUE)
+          NID=NVALUE(IPAR(ID)-NPAR)
+        ENDIF
+        NTOT=NTOT*NID
+        DO 15 IDTMP=1,NDIM-ID
+        IDDIV(IDTMP)=IDDIV(IDTMP)*NID
+   15   CONTINUE
+        CALL LCMLEN(LPCPO,RECNAM,ILONG,ITYLCM)
+        IF(ILONG.GT.MAXVAL) CALL XABORT('NCRTRP: MAXVAL OVERFLOW.')
+        CALL LCMGET(LPCPO,RECNAM,VREAL)
+        BURN0=VALR(IPAR(ID),1)
+        BURN1=VALR(IPAR(ID),2)
+        LSINGL=(BURN0.EQ.BURN1)
+        LCUBIC=LCUB2(IPAR(ID))
+        IF((MUTYPE(IPAR(ID)).EQ.1).AND.LSINGL) THEN
+          CALL ALTERP(LCUBIC,NID,VREAL,BURN0,.FALSE.,T1D(1,ID))
+        ELSE IF(MUTYPE(IPAR(ID)).EQ.1) THEN
+          IF(BURN0.GE.BURN1) CALL XABORT('@NCRTRP: INVALID BURNUP'
+     1     //' LIMITS(1).')
+          CALL ALTERI(LCUBIC,NID,VREAL,BURN0,BURN1,T1D(1,ID))
+          DO 20 I=1,NID
+          T1D(I,ID)=T1D(I,ID)/(BURN1-BURN0)
+   20     CONTINUE
+        ELSE IF((MUTYPE(IPAR(ID)).EQ.2).AND.(.NOT.LSINGL)) THEN
+          CALL ALTERP(LCUBIC,NID,VREAL,BURN0,.FALSE.,WORK(1))
+          CALL ALTERP(LCUBIC,NID,VREAL,BURN1,.FALSE.,T1D(1,ID))
+          DO 30 I=1,NID
+          T1D(I,ID)=T1D(I,ID)-WORK(I)
+   30     CONTINUE
+        ELSE IF((MUTYPE(IPAR(ID)).EQ.2).AND.(LSINGL)) THEN
+          T1D(:NID,ID)=0.0
+        ELSE IF(MUTYPE(IPAR(ID)).EQ.3) THEN
+*          DERIVATIVE WITH RESPECT TO A SINGLE EXIT BURNUP. USE
+*          EQ.(3.3) OF RICHARD CHAMBON'S THESIS.
+          IF(BURN0.GE.BURN1) CALL XABORT('@NCRTRP: INVALID BURNUP'
+     1    //' LIMITS(2).')
+          IF(PARKEY(IPAR(ID)).NE.'BURN') THEN
+            CALL XABORT('@NCRTRP: BURN EXPECTED.')
+          ENDIF
+          ALLOCATE(TERPA(NID))
+          CALL ALTERI(LCUBIC,NID,VREAL,BURN0,BURN1,TERPA(1))
+          DO 40 I=1,NID
+          T1D(I,ID)=-TERPA(I)
+   40     CONTINUE
+          CALL ALTERP(LCUBIC,NID,VREAL,BURN0,.FALSE.,TERPA(1))
+          DO 50 I=1,NID
+          T1D(I,ID)=T1D(I,ID)-TERPA(I)*BURN0
+   50     CONTINUE
+          CALL ALTERP(LCUBIC,NID,VREAL,BURN1,.FALSE.,TERPA(1))
+          DENOM=VARVAL*(BURN1-BURN0)
+          DO 60 I=1,NID
+          T1D(I,ID)=(T1D(I,ID)+TERPA(I)*BURN1)/DENOM
+   60     CONTINUE
+          DEALLOCATE(TERPA)
+        ELSE
+          CALL XABORT('NCRTRP: INVALID OPTION.')
+        ENDIF
+        NVAL(ID)=NID
+   70   CONTINUE
+
+* Example: NDIM=3, NVALUE=(3,2,2)
+* IDTOT 1  2  3  4  5  6  7  8  9 10 11 12
+* ID(1) 1  2  3  1  2  3  1  2  3  1  2  3
+* ID(2) 1  1  1  2  2  2  1  1  1  2  2  2
+* ID(3) 1  1  1  1  1  1  2  2  2  2  2  2
+* (NTOT=12, IDDIV=(6,3,1))
+        DO 100 IDTOT=1,NTOT               ! Ex.: IDTOT       = 9
+          TERTMP=1.0
+          IDTMP=IDTOT
+          DO 80 JD=1,NDIM                 ! Ex.: JD          = 1,2,3
+            ID=(IDTMP-1)/IDDIV(JD)+1      ! Ex.: ID(NDIM...1)= 2,1,3
+            IDTMP=IDTMP-(ID-1)*IDDIV(JD)  ! Ex.: IDTMP       = 3,3,1
+            MUPLET(IPAR(NDIM-JD+1))=ID
+            TERTMP=TERTMP*T1D(ID,NDIM-JD+1)
+   80     CONTINUE
+          ICAL=NCRCAL(1,NVPO(1),NPAR+NLOC,JDEBAR,JARBVA,MUPLET)
+          IF(ICAL.GT.NCAL) CALL XABORT('NCRTRP: TERP OVERFLOW(2).')
+          IF(ICAL.EQ.0) GO TO 200
+          IF(ICAL.EQ.-1) GO TO 210
+          TERP(ICAL)=TERP(ICAL)+TERTMP
+  100   CONTINUE
+      ENDIF
+      IF(IMPX.GT.3) THEN
+        WRITE(IOUT,'(35H NCRTRP: TERP PARAMETERS IN MIXTURE,I4,1H:/(1X,
+     1  1P,10E12.4))') IBMOLD,(TERP(I),I=1,NCAL)
+      ENDIF
+      DEALLOCATE(JARBVA,JDEBAR)
+      RETURN
+*----
+*  MISSING ELEMENTARY CALCULATION EXCEPTION.
+*----
+  200 WRITE(IOUT,'(16H NCRTRP: MUPLET=,10I4/(16X,10I4))')
+     1 (MUPLET(I),I=1,NPAR+NLOC)
+      CALL XABORT('NCRTRP: MISSING ELEMENTARY CALCULATION.')
+  210 WRITE(IOUT,'(16H NCRTRP: MUPLET=,10I4/(16X,10I4))')
+     1 (MUPLET(I),I=1,NPAR+NLOC)
+      CALL XABORT('NCRTRP: DEGENERATE ELEMENTARY CALCULATION.')
+      END
diff --git a/Donjon/src/NEWMAC.f b/Donjon/src/NEWMAC.f
new file mode 100644
index 0000000..613fa1b
--- /dev/null
+++ b/Donjon/src/NEWMAC.f
@@ -0,0 +1,189 @@
+*DECK NEWMAC
+      SUBROUTINE NEWMAC(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Create a new macrolib which includes the devices properties.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The NEWMAC: module specification is:
+* MACRO3 MATEX := NEWMAC: MATEX MACRO2 DEVICE
+*   :: [ EDIT iprint ] [ XFAC xfac ] ;
+* where
+*   MACRO3 : name of the \emph{macrolib} to be created by the module. It will 
+*     contain the updated properties of each material region with respect to 
+*     the current position of each device.
+*   MATEX  : name of the \emph{matex} object, containing the complete reactor 
+*     material index including devices. MATEX must be specified in the 
+*     modification mode; it will store the updated h-factors, computed per 
+*     each fuel region with respect to the devices positions.
+*   MACRO2 : name of the read-only extended \emph{macrolib}, previously created 
+*     by the MACINI: module.
+*   DEVICE : name of the read-only \emph{device} object containing the devices 
+*     information and parameters.
+*   EDIT   : keyword used to set iprint.
+*   iprint : integer index used to control the printing on screen: = 0
+*     for no print; = 1 for minimum printing; larger values produce increasing 
+*     amounts of output. The default value is iprint = 1.
+*   XFAC   : keyword used to specify the number of cells on which incremental 
+*     cross sections were computed in the supercell code.
+*   xfac   : corrective factor for delta sigmas (real number). For DRAGON 
+*     code, xfac is generally set to 2.0 and, for MULTICELL  code, set to 1.0.
+*     The default value is 2.0. 
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(NSTATE=40)
+      CHARACTER HSIGN*12,TEXT*12,HSMG*131
+      INTEGER ISTATE(NSTATE)
+      DOUBLE PRECISION DFLOT
+      TYPE(C_PTR) IPMAC,IPMTX,IPMAC2,IPDEV,JPMAC,KPMAC
+      REAL, ALLOCATABLE, DIMENSION(:) :: HFAC
+*----
+*  PARAMETER VALIDATION
+*----
+      IF(NENTRY.NE.4)CALL XABORT('@NEWMAC: 4 PARAMETERS EXPECTED')
+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2))CALL XABORT('@NEWMA'
+     1 //'C: LCM OBJECT EXPECTED AT LHS.')
+      IF(JENTRY(1).NE.0)CALL XABORT('@NEWMAC: CREATE MODE EXPECTED'
+     1 //' FOR L_MACROLIB AT LHS.')
+      IPMAC=KENTRY(1)
+*     L_MATEX
+      IF((IENTRY(2).NE.1).AND.(IENTRY(2).NE.2))CALL XABORT('@NEWMA'
+     1 //'C: LCM OBJECT EXPECTED AT RHS.')
+      IF(JENTRY(2).NE.1)CALL XABORT('@NEWMAC: MODIFICATION MODE EX'
+     1 //'PECTED FOR L_MATEX OBJECT.')
+      CALL LCMGTC(KENTRY(2),'SIGNATURE',12,HSIGN)
+      IF(HSIGN.NE.'L_MATEX')THEN
+        TEXT=HENTRY(2)
+        CALL XABORT('@NEWMAC: SIGNATURE OF '//TEXT//' IS '//HSIGN//
+     1  '. L_MATEX EXPECTED AT RHS.')
+      ENDIF
+      IPMTX=KENTRY(2)
+      DO IEN=3,NENTRY
+      IF((IENTRY(IEN).NE.1).AND.(IENTRY(IEN).NE.2))CALL XABORT('@N'
+     1 //'EWMAC: LCM OBJECT EXPECTED AT RHS.')
+      IF(JENTRY(IEN).NE.2)CALL XABORT('@NEWMAC: READ-ONLY MODE EXP'
+     1 //'ECTED FOR THE LCM OBJECTS AT RHS.')
+      ENDDO
+*     L_MACROLIB
+      CALL LCMGTC(KENTRY(3),'SIGNATURE',12,HSIGN)
+      IF(HSIGN.NE.'L_MACROLIB')THEN
+        TEXT=HENTRY(3)
+        CALL XABORT('@NEWMAC: SIGNATURE OF '//TEXT//' IS '//HSIGN//
+     1  '. L_MACROLIB EXPECTED AT RHS.')
+      ENDIF
+      IPMAC2=KENTRY(3)
+*     L_DEVICE
+      CALL LCMGTC(KENTRY(4),'SIGNATURE',12,HSIGN)
+      IF(HSIGN.NE.'L_DEVICE')THEN
+        TEXT=HENTRY(4)
+        CALL XABORT('@NEWMAC: SIGNATURE OF '//TEXT//' IS '//HSIGN//
+     1  '. L_DEVICE EXPECTED AT RHS.')
+      ENDIF
+      IPDEV=KENTRY(4)
+*----
+*  RECOVER STATE-VECTOR INFORMATION
+*----
+      ISTATE(:NSTATE)=0
+*     MACROLIB-INFO
+      CALL LCMGET(IPMAC2,'STATE-VECTOR',ISTATE)
+      NGRP=ISTATE(1)
+      NMIX=ISTATE(2)
+      NL=ISTATE(3)
+      NDEL=ISTATE(7)
+      LEAK=ISTATE(9)
+      ISTATE(:NSTATE)=0
+*     MATEX-INFO
+      CALL LCMGET(IPMTX,'STATE-VECTOR',ISTATE)
+      IF(NMIX.NE.ISTATE(2)) THEN
+        WRITE(HSMG,'(45H@NEWMAC: FOUND DIFFERENT NUMBER OF MIXTURES I,
+     1  12HN MACROLIB (,I8,13H) AND MATEX (,I8,2H).)') NMIX,ISTATE(2)
+        CALL XABORT(HSMG)
+      ENDIF
+      NEL=ISTATE(7)
+      LX=ISTATE(8)
+      LY=ISTATE(9)
+      LZ=ISTATE(10)
+*----
+*  READ INPUT DATA
+*----
+      IMPX=1
+      XFAC=2.0
+   10 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.EQ.10) GO TO 20
+      IF(ITYP.NE.3)CALL XABORT('@NEWMAC: CHARACTER DATA EXPECTED(1)')
+      IF(TEXT.EQ.'EDIT') THEN
+*        READ PRINTING INDEX
+         CALL REDGET(ITYP,IMPX,FLOT,TEXT,DFLOT)
+         IF(ITYP.NE.1)CALL XABORT('@NEWMAC: INTEGER FOR EDIT EXPECTED')
+      ELSE IF (TEXT.EQ.'XFAC') THEN
+*        SET CORRECTIVE FACTOR FOR DELTA SIGMAS
+         CALL REDGET(ITYP,NITMA,XFAC,TEXT,DFLOT)
+         IF(ITYP.NE.2)CALL XABORT('@NEWMAC: REAL DATA EXPECTED')
+      ELSE IF(TEXT.EQ.';') THEN
+         GO TO 20
+      ELSE
+         CALL XABORT('@NEWMAC: INVALID KEYWORD '//TEXT)
+      ENDIF
+      GO TO 10
+*----
+*  CREATE NEW MACROLIB
+*----
+   20 IF(IMPX.GT.4)THEN
+        CALL LCMLIB(IPMAC2)
+        CALL LCMLIB(IPMTX)
+        CALL LCMLIB(IPDEV)
+      ENDIF
+      CALL LCMEQU(IPMAC2,IPMAC)
+      IF(IMPX.GT.2)CALL LCMLIB(IPMAC)
+      CALL NEWMDV(IPMTX,IPMAC,IPMAC2,IPDEV,NMIX,NGRP,NL,NDEL,LEAK,
+     1 NEL,LX,LY,LZ,XFAC,IMPX)
+*----
+*  RECOVER H-FACTOR
+*----
+      ALLOCATE(HFAC(NMIX*NGRP))
+      JPMAC=LCMGID(IPMAC,'GROUP')
+      DO JGR=1,NGRP
+      KPMAC=LCMGIL(JPMAC,JGR)
+      CALL LCMLEN(KPMAC,'H-FACTOR',LENGT,ITYP)
+      IF(LENGT.EQ.0)CALL XABORT('@NEWMAC: UNABLE TO FIND H-F'
+     1 //'ACTOR BLOCK DATA IN THE NEW MACROLIB.')
+      CALL LCMGET(KPMAC,'H-FACTOR',HFAC((JGR-1)*NMIX+1))
+      ENDDO
+      CALL LCMPUT(IPMTX,'H-FACTOR',NMIX*NGRP,2,HFAC)
+      DEALLOCATE(HFAC)
+      IF(IMPX.GT.0) CALL LCMLIB(IPMAC)
+      RETURN
+      END
diff --git a/Donjon/src/NEWMDV.f b/Donjon/src/NEWMDV.f
new file mode 100644
index 0000000..0dfd906
--- /dev/null
+++ b/Donjon/src/NEWMDV.f
@@ -0,0 +1,172 @@
+*DECK NEWMDV
+      SUBROUTINE NEWMDV(IPMTX,IPMAC,IPMAC2,IPDEV,NMIX,NGRP,NL,NDEL,LEAK,
+     1 NEL,LX,LY,LZ,XFAC,IMPX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Update the material properties and store them in a new macrolib.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki
+*
+*Parameters: input
+* IPMTX   pointer to matex information.
+* IPMAC   pointer to create mode macrolib.
+* IPMAC2  pointer to read-only mode macrolib.
+* IPDEV   pointer to device information.
+* NMIX    maximum number of material mixtures.
+* NGRP    number of energy groups.
+* NL      number of legendre orders (=1 for isotropic scattering).
+* NDEL    number of precursor groups for delayed neutron.
+* LEAK    diffusion coefficient flag (=1: isotropic; =2: anisotropic).
+* NEL     total number of elements.
+* LX      number of elements along x-axis.
+* LY      number of elements along y-axis.
+* LZ      number of elements along z-axis.
+* XFAC    corrective factor for delta sigmas.
+* IMPX    printing index (=0 for no print).
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMTX,IPMAC,IPMAC2,IPDEV
+      INTEGER NMIX,NGRP,NL,NDEL,LEAK,NEL,LX,LY,LZ
+      REAL XFAC
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(NSTATE=40,IOUT=6,EPSI=1.0E-4,MAXPRT=10)
+      INTEGER INDX(NEL),ISTATE(NSTATE),DMIX(2,MAXPRT),INAME(3)
+      REAL MESHX(LX+1),MESHY(LY+1),MESHZ(LZ+1),DPOS(6,MAXPRT),LEVEL
+      CHARACTER RNAME*12
+      TYPE(C_PTR) JPDEV,KPDEV
+*----
+* ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IJJ,NJJ
+      REAL, ALLOCATABLE, DIMENSION(:) :: TOT0,TOT1,ZNUS,CHI,SIGF,DIFX,
+     1 DIFY,DIFZ,HFAC,SCAT
+*----
+* SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(IJJ(NMIX*NGRP*NL),NJJ(NMIX*NGRP*NL),TOT0(NMIX*NGRP),
+     1 TOT1(NMIX*NGRP),ZNUS(NMIX*NGRP*(NDEL+1)),CHI(NMIX*NGRP*(NDEL+1)),
+     2 SIGF(NMIX*NGRP),DIFX(NMIX*NGRP),DIFY(NMIX*NGRP),DIFZ(NMIX*NGRP),
+     3 HFAC(NMIX*NGRP),SCAT(NMIX*NL*NGRP*NGRP))
+*----
+*  RECOVER EXISTING PROPERTIES
+*----
+      CALL NEWMGT(IPMAC2,NMIX,NGRP,NL,NDEL,LEAK,TOT0,TOT1,ZNUS,CHI,SIGF,
+     1 DIFX,DIFY,DIFZ,HFAC,IJJ,NJJ,SCAT)
+*----
+*  RECOVER MATEX INFORMATION
+*----
+      MESHX(:LX+1)=0.0
+      MESHY(:LY+1)=0.0
+      MESHZ(:LZ+1)=0.0
+      CALL LCMGET(IPMTX,'MESHX',MESHX)
+      CALL LCMGET(IPMTX,'MESHY',MESHY)
+      CALL LCMGET(IPMTX,'MESHZ',MESHZ)
+      INDX(:NEL)=0
+      CALL LCMGET(IPMTX,'INDEX',INDX)
+      CALL LCMGET(IPDEV,'STATE-VECTOR',ISTATE)
+      IF(ISTATE(2).EQ.0)GOTO 30
+*----
+*  UPDATE ROD PROPERTIES
+*----
+      ITOT=0
+      NROD=ISTATE(2)
+      JPDEV=LCMGID(IPDEV,'DEV_ROD')
+      IF(IMPX.GT.0)WRITE(IOUT,1000)
+      DO 20 ID=1,NROD
+      KPDEV=LCMGIL(JPDEV,ID)
+      IF(IMPX.GT.5)CALL LCMLIB(KPDEV)
+      CALL LCMGET(KPDEV,'LEVEL',LEVEL)
+      IF(LEVEL.LT.EPSI)GOTO 20
+      CALL LCMGET(KPDEV,'ROD-NAME',INAME)
+      WRITE(RNAME,'(3A4)') (INAME(I),I=1,3)
+      CALL LCMGET(KPDEV,'ROD-PARTS',NPART)
+      IF(NPART.GT.MAXPRT) CALL XABORT('NEWMDV: MAXPRT OVERFLOW.')
+      CALL LCMGET(KPDEV,'ROD-POS',DPOS)
+      CALL LCMGET(KPDEV,'ROD-MIX',DMIX)
+      DO 10 IPART=1,NPART
+      IF(IMPX.GT.2)WRITE(IOUT,1001)ID,IPART,RNAME,LEVEL,DPOS(1,IPART)
+      CALL NEWMVF(INDX,DPOS(1,IPART),DMIX(1,IPART),NGRP,NL,NDEL,LEAK,
+     1 NEL,NMIX,LX,LY,LZ,MESHX,MESHY,MESHZ,TOT0,TOT1,ZNUS,CHI,SIGF,DIFX,
+     2 DIFY,DIFZ,HFAC,SCAT,XFAC,IMPX)
+      IF(IMPX.GT.2)WRITE(IOUT,1002)
+   10 CONTINUE
+      ITOT=ITOT+1
+   20 CONTINUE
+      IF(IMPX.GT.0)WRITE(IOUT,1003)ITOT
+   30 IF(ISTATE(4).EQ.0)GOTO 50
+*----
+*  UPDATE LZC PROPERTIES
+*----
+      ITOT=0
+      NLZC=ISTATE(4)
+      JPDEV=LCMGID(IPDEV,'DEV_LZC')
+      IF(IMPX.GT.0)WRITE(IOUT,1004)
+      DO 40 ID=1,NLZC
+      KPDEV=LCMGIL(JPDEV,ID)
+      IF(IMPX.GT.2)WRITE(IOUT,1005)ID
+      IF(IMPX.GT.5)CALL LCMLIB(KPDEV)
+*     EMPTY-PART
+      CALL LCMGET(KPDEV,'EMPTY-POS',DPOS)
+      CALL LCMGET(KPDEV,'EMPTY-MIX',DMIX)
+      IF(IMPX.GT.2)WRITE(IOUT,1006)DPOS
+      CALL NEWMVF(INDX,DPOS(1,1),DMIX(1,1),NGRP,NL,NDEL,LEAK,NEL,NMIX,
+     1 LX,LY,LZ,MESHX,MESHY,MESHZ,TOT0,TOT1,ZNUS,CHI,SIGF,DIFX,DIFY,
+     2 DIFZ,HFAC,SCAT,XFAC,IMPX)
+*     FULL-PART
+      CALL LCMGET(KPDEV,'FULL-POS',DPOS)
+      CALL LCMGET(KPDEV,'FULL-MIX',DMIX)
+      IF(IMPX.GT.2)WRITE(IOUT,1007)DPOS
+      CALL NEWMVF(INDX,DPOS(1,1),DMIX(1,1),NGRP,NL,NDEL,LEAK,NEL,NMIX,
+     1 LX,LY,LZ,MESHX,MESHY,MESHZ,TOT0,TOT1,ZNUS,CHI,SIGF,DIFX,DIFY,
+     2 DIFZ,HFAC,SCAT,XFAC,IMPX)
+      IF(IMPX.GT.2)WRITE(IOUT,1002)
+      ITOT=ITOT+1
+   40 CONTINUE
+      IF(IMPX.GT.0)WRITE(IOUT,1008)ITOT
+*----
+*  STORE NEW PROPERTIES
+*----
+   50 CALL NEWMPT(IPMAC,NMIX,NGRP,NL,NDEL,LEAK,TOT0,TOT1,ZNUS,CHI,SIGF,
+     1 DIFX,DIFY,DIFZ,HFAC,IJJ,NJJ,SCAT)
+*----
+* SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(NJJ,IJJ,SCAT,HFAC,DIFZ,DIFY,DIFX,SIGF,CHI,ZNUS,TOT1,
+     1 TOT0)
+      RETURN
+*
+ 1000 FORMAT(/1X,'**',1X,'UPDATING PROPERTIES',
+     1  1X,'FOR ALL INSERTED RODS',1X,'**'/)
+ 1001 FORMAT(
+     1 /5X,'=>',2X,'ROD-ID #',I3.3,' PART:',I4,5X,'ROD-NAME:',1X,A
+     2 /1X,'ROD INSERTION LEVEL =',F8.4
+     3 /1X,'CURRENT ROD POSITION :'
+     4 /1X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4
+     5 /1X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4)
+ 1002 FORMAT(/1X,38('-')/)
+ 1003 FORMAT(/1X,'TOTAL NUMBER OF TREATED RODS:',I3/)
+*
+ 1004 FORMAT(/1X,'**',1X,'UPDATING PROPERTIES',
+     1  1X,'FOR ALL LZC-DEVICES',1X,'**'/)
+ 1005 FORMAT(/5X,'=>',2X,'LZC-ID #',I2.2)
+ 1006 FORMAT(/1X,'EMPTY-PART POSITION :'
+     1 /1X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4
+     2 /1X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4)
+ 1007 FORMAT(/1X,'FULL-PART POSITION :'
+     1 /1X,'X-',F10.4,5X,'Y-',F10.4,5X,'Z-',F10.4
+     2 /1X,'X+',F10.4,5X,'Y+',F10.4,5X,'Z+',F10.4)
+ 1008 FORMAT(/1X,'TOTAL NUMBER OF TREATED LZC:',I2/)
+      END
diff --git a/Donjon/src/NEWMGT.f b/Donjon/src/NEWMGT.f
new file mode 100644
index 0000000..0578daf
--- /dev/null
+++ b/Donjon/src/NEWMGT.f
@@ -0,0 +1,200 @@
+*DECK NEWMGT
+      SUBROUTINE NEWMGT(IPMAC,NMIX,NGRP,NL,NDEL,LEAK,NTOT0,NTOT1,ZNUS,
+     1 CHI,ZSIGF,DIFFX,DIFFY,DIFFZ,HFAC,IJJ,NJJ,SCAT)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover the existing macrolib data and store them in memory.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki
+*
+*Parameters: input
+* IPMAC   pointer to the macrolib information.
+* NMIX    maximum number of material mixtures.
+* NGRP    number of energy groups.
+* NL      number of legendre orders (=1 for isotropic scattering).
+* NDEL    number of precursor groups for delayed neutron.
+*
+*Parameters: output
+* NTOT0   flux-weighted total macroscopic x-sections.
+* NTOT1   current-weighted total macroscopic x-sections.
+* ZNUS    nu*fission macroscopic x-sections.
+* CHI     fission spectra.
+* ZSIGF   fission macroscopic x-sections.
+* DIFFX   x-directed diffusion coefficients.
+* DIFFY   y-directed diffusion coefficients.
+* DIFFZ   z-directed diffusion coefficients.
+* HFAC    h-factors (kappa*fission macroscopic x-sections).
+* IJJ     highest energy number for which the scattering
+*         component to group g does not vanish.
+* NJJ     number of energy groups for which the scattering
+*         component does not vanish.
+* SCAT    scattering macroscopic x-sections.
+* LEAK    diffusion coefficient flag (=1: isotropic; =2: anisotropic).
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAC
+      INTEGER NMIX,NGRP,NL,NDEL,LEAK,IJJ(NMIX,NL,NGRP),NJJ(NMIX,NL,NGRP)
+      REAL NTOT0(NMIX,NGRP),NTOT1(NMIX,NGRP),ZSIGF(NMIX,NGRP),
+     1     DIFFX(NMIX,NGRP),DIFFY(NMIX,NGRP),DIFFZ(NMIX,NGRP),
+     2     ZNUS(NMIX,NGRP,NDEL+1),CHI(NMIX,NGRP,NDEL+1),HFAC(NMIX,NGRP),
+     3     SCAT(NMIX,NL,NGRP,NGRP)
+*----
+*  LOCAL VARIABLES
+*----
+      CHARACTER CM*2,TEXT12*12
+      PARAMETER(IOUT=6)
+      TYPE(C_PTR) JPMAC,KPMAC
+      REAL, ALLOCATABLE, DIMENSION(:) :: WORK
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(WORK(NMIX*NGRP))
+*
+      WORK(:NMIX*NGRP)=0.0
+      NTOT0(:NMIX,:NGRP)=0.0
+      NTOT1(:NMIX,:NGRP)=0.0
+      ZSIGF(:NMIX,:NGRP)=0.0
+      DIFFX(:NMIX,:NGRP)=0.0
+      DIFFY(:NMIX,:NGRP)=0.0
+      DIFFZ(:NMIX,:NGRP)=0.0
+      ZNUS(:NMIX,:NGRP,:NDEL+1)=0.0
+      CHI(:NMIX,:NGRP,:NDEL+1)=0.0
+      HFAC(:NMIX,:NGRP)=0.0
+      SCAT(:NMIX,:NL,:NGRP,:NGRP)=0.0
+      DO 12 IGR=1,NGRP
+      DO 11 IBM=1,NMIX
+      DO 10 IL=1,NL
+      IJJ(IBM,IL,IGR)=IGR
+      NJJ(IBM,IL,IGR)=1
+   10 CONTINUE
+   11 CONTINUE
+   12 CONTINUE
+*----
+*  RECOVER THE EXISTING MACROLIB DATA
+*----
+      JPMAC=LCMGID(IPMAC,'GROUP')
+      DO 70 JGR=1,NGRP
+      KPMAC=LCMGIL(JPMAC,JGR)
+*     NTOT0
+      CALL LCMLEN(KPMAC,'NTOT0',LENGT,ITYLCM)
+      IF(LENGT.EQ.NMIX)THEN
+        CALL LCMGET(KPMAC,'NTOT0',NTOT0(1,JGR))
+      ELSEIF(LENGT.EQ.0)THEN
+        CALL XABORT('@NEWMGT: MISSING NTOT0 DATA IN MACROLIB.')
+      ELSE
+        CALL XABORT('@NEWMGT: INVALID NTOT0 DATA IN MACROLIB.')
+      ENDIF
+*     NTOT1
+      CALL LCMLEN(KPMAC,'NTOT1',LENGT,ITYLCM)
+      IF(LENGT.EQ.NMIX)THEN
+        CALL LCMGET(KPMAC,'NTOT1',NTOT1(1,JGR))
+      ELSEIF(LENGT.NE.0)THEN
+        CALL XABORT('@NEWMGT: INVALID NTOT1 DATA IN MACROLIB.')
+      ENDIF
+*     NUSIGF
+      CALL LCMLEN(KPMAC,'NUSIGF',LENGT,ITYLCM)
+      IF(LENGT.EQ.NMIX)THEN
+        CALL LCMGET(KPMAC,'NUSIGF',ZNUS(1,JGR,1))
+      ELSEIF(LENGT.NE.0)THEN
+        CALL XABORT('@NEWMGT: INVALID NUSIGF DATA IN MACROLIB.')
+      ENDIF
+      DO IDEL=1,NDEL
+        WRITE(TEXT12,'(6HNUSIGF,I2.2)') IDEL
+        CALL LCMLEN(KPMAC,TEXT12,LENGT,ITYLCM)
+        IF(LENGT.EQ.NMIX)THEN
+          CALL LCMGET(KPMAC,TEXT12,ZNUS(1,JGR,IDEL+1))
+        ELSEIF(LENGT.NE.0)THEN
+          CALL XABORT('@NEWMGT: INVALID '//TEXT12//' DATA IN MACROLIB.')
+        ENDIF
+      ENDDO
+*     CHI
+      CALL LCMLEN(KPMAC,'CHI',LENGT,ITYLCM)
+      IF(LENGT.EQ.NMIX)THEN
+        CALL LCMGET(KPMAC,'CHI',CHI(1,JGR,1))
+      ELSEIF(LENGT.NE.0)THEN
+        CALL XABORT('@NEWMGT: INVALID CHI DATA IN MACROLIB.')
+      ENDIF
+      DO IDEL=1,NDEL
+        WRITE(TEXT12,'(3HCHI,I2.2)') IDEL
+        CALL LCMLEN(KPMAC,TEXT12,LENGT,ITYLCM)
+        IF(LENGT.EQ.NMIX)THEN
+          CALL LCMGET(KPMAC,TEXT12,CHI(1,JGR,IDEL+1))
+        ELSEIF(LENGT.NE.0)THEN
+          CALL XABORT('@NEWMGT: INVALID '//TEXT12//' DATA IN MACROLIB.')
+        ENDIF
+      ENDDO
+*     NFTOT
+      CALL LCMLEN(KPMAC,'NFTOT',LENGT,ITYLCM)
+      IF(LENGT.EQ.NMIX)THEN
+        CALL LCMGET(KPMAC,'NFTOT',ZSIGF(1,JGR))
+      ELSEIF(LENGT.NE.0)THEN
+        CALL XABORT('@NEWMGT: INVALID NFTOT DATA IN MACROLIB.')
+      ENDIF
+*     DIFF
+      CALL LCMLEN(KPMAC,'DIFF',LENGT,ITYLCM)
+      IF(LENGT.EQ.0)GOTO 20
+      IF(LENGT.NE.NMIX)CALL XABORT('@NEWMGT: INVALID DIFF DATA.')
+      CALL LCMGET(KPMAC,'DIFF',DIFFX(1,JGR))
+      LEAK=1
+      GOTO 30
+*     DIFFX
+   20 CALL LCMLEN(KPMAC,'DIFFX',LENGT,ITYLCM)
+      IF(LENGT.EQ.0)GO TO 30
+      IF(LENGT.NE.NMIX)CALL XABORT('@NEWMGT: INVALID DIFFX DATA.')
+      CALL LCMGET(KPMAC,'DIFFX',DIFFX(1,JGR))
+*     DIFFY
+      CALL LCMLEN(KPMAC,'DIFFY',LENGT,ITYLCM)
+      IF(LENGT.NE.NMIX)CALL XABORT('@NEWMGT: INVALID DIFFY DATA.')
+      CALL LCMGET(KPMAC,'DIFFY',DIFFY(1,JGR))
+*     DIFFZ
+      CALL LCMLEN(KPMAC,'DIFFZ',LENGT,ITYLCM)
+      IF(LENGT.NE.NMIX)CALL XABORT('@NEWMGT: INVALID DIFFZ DATA.')
+      CALL LCMGET(KPMAC,'DIFFZ',DIFFZ(1,JGR))
+      LEAK=2
+*     H-FACTOR
+   30 CALL LCMLEN(KPMAC,'H-FACTOR',LENGT,ITYLCM)
+      IF(LENGT.EQ.NMIX)THEN
+        CALL LCMGET(KPMAC,'H-FACTOR',HFAC(1,JGR))
+      ELSEIF(LENGT.NE.0)THEN
+        CALL XABORT('@NEWMGT: INVALID H-FACTOR DATA IN MACROLIB.')
+      ENDIF
+*     SCAT,NJJ,IJJ
+      DO IL=1,NL
+        WRITE (CM,'(I2.2)') IL-1
+        CALL LCMLEN(KPMAC,'SCAT'//CM,LENGT,ITYLCM)
+        IF(LENGT.GT.NMIX*NL*NGRP*NGRP)THEN
+          CALL XABORT('@NEWMGT: INVALID INPUT MACROLIB(1).')
+        ELSEIF(LENGT.GT.0)THEN
+          CALL LCMGET(KPMAC,'SCAT'//CM,WORK)
+          CALL LCMGET(KPMAC,'NJJS'//CM,NJJ(1,IL,JGR))
+          CALL LCMGET(KPMAC,'IJJS'//CM,IJJ(1,IL,JGR))
+          IPOSDE=0
+          DO 65 IBM=1,NMIX
+            IJJ0=IJJ(IBM,IL,JGR)
+            DO 60 IGR=IJJ0,IJJ0-NJJ(IBM,IL,JGR)+1,-1
+              IPOSDE=IPOSDE+1
+              SCAT(IBM,IL,IGR,JGR)=WORK(IPOSDE)
+   60       CONTINUE
+   65     CONTINUE
+        ELSE
+          CALL XABORT('@NEWMGT: OLD FORMAT OF THE MACROLIB.')
+        ENDIF
+      ENDDO
+   70 CONTINUE
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(WORK)
+      RETURN
+      END
diff --git a/Donjon/src/NEWMPT.f b/Donjon/src/NEWMPT.f
new file mode 100644
index 0000000..fe286f2
--- /dev/null
+++ b/Donjon/src/NEWMPT.f
@@ -0,0 +1,138 @@
+*DECK NEWMPT

+      SUBROUTINE NEWMPT(IPMAC,NMIX,NGRP,NL,NDEL,LEAK,NTOT0,NTOT1,ZNUS,

+     1 CHI,ZSIGF,DIFFX,DIFFY,DIFFZ,HFAC,IJJ,NJJ,SCAT)

+*

+*-----------------------------------------------------------------------

+*

+*Purpose:

+* Store modified nuclear properties in a new macrolib.

+*

+*Copyright:

+* Copyright (C) 2007 Ecole Polytechnique de Montreal.

+*

+*Author(s): 

+* D. Sekki

+*

+*Parameters: input/output

+* IPMAC   pointer to create mode macrolib.

+* NMIX    maximum number of material mixtures.

+* NGRP    number of energy groups.

+* NL      number of legendre orders (=1 for isotropic scattering).

+* NDEL    number of precursor groups for delayed neutron.

+* LEAK    diffusion coefficient flag (=1: isotropic; =2: anisotropic).

+* NTOT0   flux-weighted total macroscopic x-sections.

+* NTOT1   current-weighted total macroscopic x-sections.

+* ZNUS    nu*fission macroscopic x-sections.

+* CHI     fission spectra.

+* ZSIGF   fission macroscopic x-sections.

+* DIFFX   x-directed diffusion coefficients.

+* DIFFY   y-directed diffusion coefficients.

+* DIFFZ   z-directed diffusion coefficients.

+* HFAC    h-factors (kappa*fission macroscopic x-sections).

+* IJJ     highest energy number for which the scattering

+*         component to group g does not vanish.

+* NJJ     number of energy groups for which the scattering

+*         component does not vanish.

+* SCAT    scattering macroscopic x-sections.

+*

+*-----------------------------------------------------------------------

+*

+      USE GANLIB

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      TYPE(C_PTR) IPMAC

+      INTEGER NMIX,NGRP,NL,NDEL,LEAK,IJJ(NMIX,NL,NGRP),NJJ(NMIX,NL,NGRP)

+      REAL NTOT0(NMIX,NGRP),NTOT1(NMIX,NGRP),ZSIGF(NMIX,NGRP),

+     1     DIFFX(NMIX,NGRP),DIFFY(NMIX,NGRP),DIFFZ(NMIX,NGRP),

+     2     ZNUS(NMIX,NGRP,NDEL+1),CHI(NMIX,NGRP,NDEL+1),HFAC(NMIX,NGRP),

+     3     SCAT(NMIX,NL,NGRP,NGRP)

+*----

+*  LOCAL VARIABLES

+*----

+      CHARACTER CM*2,TEXT12*12

+      TYPE(C_PTR) JPMAC,KPMAC

+      REAL, ALLOCATABLE, DIMENSION(:) :: WORK

+*----

+*  SCRATCH STORAGE ALLOCATION

+*----

+      ALLOCATE(WORK(NMIX*NGRP))

+*----

+*  STORE PROPERTIES

+*----

+      JPMAC=LCMGID(IPMAC,'GROUP')

+      DO 30 JGR=1,NGRP

+      KPMAC=LCMGIL(JPMAC,JGR)

+*     NTOT0

+      CALL LCMPUT(KPMAC,'NTOT0',NMIX,2,NTOT0(1,JGR))

+*     NTOT1

+      CALL LCMLEN(KPMAC,'NTOT1',LENGT,ITYP)

+      IF(LENGT.EQ.NMIX)

+     1  CALL LCMPUT(KPMAC,'NTOT1',NMIX,2,NTOT1(1,JGR))

+*     NUSIGF

+      CALL LCMLEN(KPMAC,'NUSIGF',LENGT,ITYP)

+      IF(LENGT.EQ.NMIX)

+     1  CALL LCMPUT(KPMAC,'NUSIGF',NMIX,2,ZNUS(1,JGR,1))

+      DO IDEL=1,NDEL

+        WRITE(TEXT12,'(6HNUSIGF,I2.2)') IDEL

+        CALL LCMLEN(KPMAC,TEXT12,LENGT,ITYP)

+        IF(LENGT.EQ.NMIX)

+     1    CALL LCMPUT(KPMAC,TEXT12,NMIX,2,ZNUS(1,JGR,IDEL+1))

+      ENDDO

+*     CHI

+      CALL LCMLEN(KPMAC,'CHI',LENGT,ITYP)

+      IF(LENGT.EQ.NMIX)

+     1  CALL LCMPUT(KPMAC,'CHI',NMIX,2,CHI(1,JGR,1))

+      DO IDEL=1,NDEL

+        WRITE(TEXT12,'(3HCHI,I2.2)') IDEL

+        CALL LCMLEN(KPMAC,TEXT12,LENGT,ITYP)

+        IF(LENGT.EQ.NMIX)

+     1    CALL LCMPUT(KPMAC,TEXT12,NMIX,2,CHI(1,JGR,IDEL+1))

+      ENDDO

+*     NFTOT

+      CALL LCMLEN(KPMAC,'NFTOT',LENGT,ITYP)

+      IF(LENGT.EQ.NMIX)

+     1  CALL LCMPUT(KPMAC,'NFTOT',NMIX,2,ZSIGF(1,JGR))

+      IF(LEAK.EQ.1)THEN

+*       DIFF

+        CALL LCMPUT(KPMAC,'DIFF',NMIX,2,DIFFX(1,JGR))

+      ELSEIF(LEAK.EQ.2)THEN

+*       DIFFX,DIFFY,DIFFZ

+        CALL LCMPUT(KPMAC,'DIFFX',NMIX,2,DIFFX(1,JGR))

+        CALL LCMPUT(KPMAC,'DIFFY',NMIX,2,DIFFY(1,JGR))

+        CALL LCMPUT(KPMAC,'DIFFZ',NMIX,2,DIFFZ(1,JGR))

+      ENDIF

+*     H-FACTOR

+      CALL LCMLEN(KPMAC,'H-FACTOR',LENGT,ITYP)

+      IF(LENGT.EQ.NMIX)

+     1  CALL LCMPUT(KPMAC,'H-FACTOR',NMIX,2,HFAC(1,JGR))

+      DO IL=1,NL

+        WRITE (CM,'(I2.2)') IL-1

+        CALL LCMLEN(KPMAC,'SCAT'//CM,LENGT,ITYP)

+        IF(LENGT.NE.0)THEN

+          IPOSDE=0

+          DO 20 IBM=1,NMIX

+            DO IGR=IJJ(IBM,IL,JGR),IJJ(IBM,IL,JGR)-

+     1                NJJ(IBM,IL,JGR)+1,-1

+              IPOSDE=IPOSDE+1

+              WORK(IPOSDE)=SCAT(IBM,IL,IGR,JGR)

+            ENDDO

+            HFAC(IBM,JGR)=0.

+            DO 10 IGR=1,NGRP

+              HFAC(IBM,JGR)=HFAC(IBM,JGR)+SCAT(IBM,IL,JGR,IGR)

+   10       CONTINUE

+   20     CONTINUE

+          CALL LCMPUT(KPMAC,'SCAT'//CM,IPOSDE,2,WORK)

+          CALL LCMPUT(KPMAC,'NJJS'//CM,NMIX,1,NJJ(1,IL,JGR))

+          CALL LCMPUT(KPMAC,'IJJS'//CM,NMIX,1,IJJ(1,IL,JGR))

+          CALL LCMPUT(KPMAC,'SIGW'//CM,NMIX,2,SCAT(1,IL,JGR,JGR))

+          CALL LCMPUT(KPMAC,'SIGS'//CM,NMIX,2,HFAC(1,JGR))

+        ENDIF

+      ENDDO

+   30 CONTINUE

+*----

+*  SCRATCH STORAGE DEALLOCATION

+*----

+      DEALLOCATE(WORK)

+      RETURN

+      END

diff --git a/Donjon/src/NEWMVF.f b/Donjon/src/NEWMVF.f
new file mode 100644
index 0000000..8d21653
--- /dev/null
+++ b/Donjon/src/NEWMVF.f
@@ -0,0 +1,190 @@
+*DECK NEWMVF
+      SUBROUTINE NEWMVF(INDX,DPOS,DMIX,NGRP,NL,NDEL,LEAK,NEL,NMIX,LX,
+     1  LY,LZ,MESHX,MESHY,MESHZ,NTOT0,NTOT1,ZNUS,CHI,ZSIGF,DIFFX,DIFFY,
+     2  DIFFZ,HFAC,SCAT,XFAC,IMPX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover material regions affected by the device insertion.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* J. Koclas, D. Sekki
+*
+*Parameters: input/output
+* INDX    index number of each material volume (=0 for virtual regions).
+* DPOS    device position in cm in the core.
+* DMIX    device mixtures for insertion and extraction.
+* NGRP    number of energy  groups.
+* NL      number of legendre orders (=1 for isotropic scattering).
+* NDEL    number of precursor groups for delayed neutron.
+* LEAK    diffusion coefficient flag (=1: isotropic; =2: anisotropic).
+* NEL     total number of elements.
+* NMIX    maximum number of material mixtures.
+* LX      number of elements along x-axis.
+* LY      number of elements along y-axis.
+* LZ      number of elements along z-axis.
+* MESHX   mesh coordinates along x-axis.
+* MESHY   mesh coordinates along y-axis.
+* MESHZ   mesh coordinates along z-axis.
+* NTOT0   flux-weighted total macroscopic x-sections.
+* NTOT1   current-weighted total macroscopic x-sections.
+* ZNUS    nu*fission macroscopic x-sections.
+* CHI     fission spectra.
+* ZSIGF   fission macroscopic x-sections.
+* DIFFX   x-directed diffusion coefficients.
+* DIFFY   y-directed diffusion coefficients.
+* DIFFZ   z-directed diffusion coefficients.
+* HFAC    h-factors (kappa*fission macroscopic x-sections).
+* SCAT    scattering macroscopic x-sections.
+* XFAC    corrective factor for delta sigmas.
+* IMPX    printing index (=0 for no print).
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER NGRP,NL,NDEL,LEAK,NEL,NMIX,INDX(NEL),DMIX(2),LX,LY,LZ,IMPX
+      REAL MESHX(LX+1),MESHY(LY+1),MESHZ(LZ+1),DIFFX(NMIX,NGRP),
+     1 ZSIGF(NMIX,NGRP),NTOT1(NMIX,NGRP),ZNUS(NMIX,NGRP,NDEL+1),
+     2 CHI(NMIX,NGRP,NDEL+1),DPOS(6),NTOT0(NMIX,NGRP),HFAC(NMIX,NGRP),
+     3 SCAT(NMIX,NL,NGRP,NGRP),DIFFY(NMIX,NGRP),DIFFZ(NMIX,NGRP),XFAC
+      PARAMETER(IOUT=6,EPSI=1.0E-4)
+*----
+*  RECOVER REGIONS WHERE DEVICE IS INSERTED
+*----
+      IF(IMPX.GT.4)WRITE(IOUT,*)'RECOVER REGIONS AFFECTED BY DEVICE'
+*     INSERTED COORDINATES
+      DX1=DPOS(1)
+      DX2=DPOS(2)
+      DY1=DPOS(3)
+      DY2=DPOS(4)
+      DZ1=DPOS(5)
+      DZ2=DPOS(6)
+      IF(DX1.LT.MESHX(1)) DX1=MESHX(1)
+      IF(DX2.LT.MESHX(1)) DX2=MESHX(1)
+      IF(DX2.GT.MESHX(LX+1)) DX2=MESHX(LX+1)
+      IF(DX1.GT.MESHX(LX+1)) DX1=MESHX(LX+1)
+      IF(ABS(DX1-DX2).LT.EPSI) RETURN
+      IF(DY1.LT.MESHY(1)) DY1=MESHY(1)
+      IF(DY2.LT.MESHY(1)) DY2=MESHY(1)
+      IF(DY2.GT.MESHY(LY+1)) DY2=MESHY(LY+1)
+      IF(DY1.GT.MESHY(LY+1)) DY1=MESHY(LY+1)
+      IF(ABS(DY1-DY2).LT.EPSI) RETURN
+      IF(DZ1.LT.MESHZ(1)) DZ1=MESHZ(1)
+      IF(DZ2.LT.MESHZ(1)) DZ2=MESHZ(1)
+      IF(DZ2.GT.MESHZ(LZ+1)) DZ2=MESHZ(LZ+1)
+      IF(DZ1.GT.MESHZ(LZ+1)) DZ1=MESHZ(LZ+1)
+      IF(ABS(DZ1-DZ2).LT.EPSI) RETURN
+      I1=0
+      I2=0
+*     CHECK X-AXIS
+      DO I=1,LX
+      IF(ABS(DX1-MESHX(I)).LT.EPSI) DX1=MESHX(I)
+      IF(ABS(DX2-MESHX(I)).LT.EPSI) DX2=MESHX(I)
+      IF(ABS(DX1-MESHX(I+1)).LT.EPSI) DX1=MESHX(I+1)
+      IF(ABS(DX2-MESHX(I+1)).LT.EPSI) DX2=MESHX(I+1)
+      IF((DX1.GE.MESHX(I)).AND.(DX1.LT.MESHX(I+1)))I1=I
+      IF((DX2.GT.MESHX(I)).AND.(DX2.LE.MESHX(I+1)))THEN
+        I2=I
+        GOTO 10
+      ENDIF
+      ENDDO
+   10 IF(IMPX.GT.4)WRITE(IOUT,*)' I1=',I1,', I2=',I2
+      IF((I1.EQ.0).OR.(I2.EQ.0))CALL XABORT('@NEWMVF: WR'
+     1 //'ONG NUMBER OF AFFECTED REGIONS ALONG X-AXIS.')
+      J1=0
+      J2=0
+*     CHECK Y-AXIS
+      DO J=1,LY
+      IF(ABS(DY1-MESHY(J)).LT.EPSI) DY1=MESHY(J)
+      IF(ABS(DY2-MESHY(J)).LT.EPSI) DY2=MESHY(J)
+      IF(ABS(DY1-MESHY(J+1)).LT.EPSI) DY1=MESHY(J+1)
+      IF(ABS(DY2-MESHY(J+1)).LT.EPSI) DY2=MESHY(J+1)
+      IF((DY1.GE.MESHY(J)).AND.(DY1.LT.MESHY(J+1)))J1=J
+      IF((DY2.GT.MESHY(J)).AND.(DY2.LE.MESHY(J+1)))THEN
+        J2=J
+        GOTO 20
+      ENDIF
+      ENDDO
+   20 IF(IMPX.GT.4)WRITE(IOUT,*)' J1=',J1,', J2=',J2
+      IF((J1.EQ.0).OR.(J2.EQ.0))CALL XABORT('@NEWMVF: WR'
+     1 //'ONG NUMBER OF AFFECTED REGIONS ALONG Y-AXIS.')
+      K1=0
+      K2=0
+*     CHECK Z-AXIS
+      DO K=1,LZ
+      IF(ABS(DZ1-MESHZ(K)).LT.EPSI) DZ1=MESHZ(K)
+      IF(ABS(DZ2-MESHZ(K)).LT.EPSI) DZ2=MESHZ(K)
+      IF(ABS(DZ1-MESHZ(K+1)).LT.EPSI) DZ1=MESHZ(K+1)
+      IF(ABS(DZ2-MESHZ(K+1)).LT.EPSI) DZ2=MESHZ(K+1)
+      IF((DZ1.GE.MESHZ(K)).AND.(DZ1.LT.MESHZ(K+1)))K1=K
+      IF((DZ2.GT.MESHZ(K)).AND.(DZ2.LE.MESHZ(K+1)))THEN
+        K2=K
+        GOTO 30
+      ENDIF
+      ENDDO
+   30 IF(IMPX.GT.4)WRITE(IOUT,*)' K1=',K1,', K2=',K2
+      IF((K1.EQ.0).OR.(K2.EQ.0))CALL XABORT('@NEWMVF: WR'
+     1 //'ONG NUMBER OF AFFECTED REGIONS ALONG Z-AXIS.')
+*----
+*  COMPUTE OCCUPIED VOLUME FRACTION
+*----
+      DO 42 K=K1,K2
+      DO 41 J=J1,J2
+      DO 40 I=I1,I2
+      IEL=(K-1)*LX*LY+(J-1)*LX+I
+      IBM=INDX(IEL)
+      IF(IMPX.GT.4)WRITE(IOUT,*)'AFFECTED ELEM #',IEL,' MIX #',IBM
+      IF(IBM.NE.0)THEN
+        FX=0.
+*       FRACTION ALONG X-AXIS
+        IF((DX1.GE.MESHX(I)).AND.(DX2.GT.MESHX(I+1)))THEN
+          FX=(MESHX(I+1)-DX1)/(MESHX(I+1)-MESHX(I))
+        ELSEIF((DX1.GE.MESHX(I)).AND.(DX2.LE.MESHX(I+1)))THEN
+          FX=(DX2-DX1)/(MESHX(I+1)-MESHX(I))
+        ELSEIF((DX1.LT.MESHX(I)).AND.(DX2.GT.MESHX(I+1)))THEN
+          FX=1.
+        ELSEIF((DX1.LT.MESHX(I)).AND.(DX2.LE.MESHX(I+1)))THEN
+          FX=(DX2-MESHX(I))/(MESHX(I+1)-MESHX(I))
+        ENDIF
+        FY=0.
+*       FRACTION ALONG Y-AXIS
+        IF((DY1.GE.MESHY(J)).AND.(DY2.GT.MESHY(J+1)))THEN
+          FY=(MESHY(J+1)-DY1)/(MESHY(J+1)-MESHY(J))
+        ELSEIF((DY1.GE.MESHY(J)).AND.(DY2.LE.MESHY(J+1)))THEN
+          FY=(DY2-DY1)/(MESHY(J+1)-MESHY(J))
+        ELSEIF((DY1.LT.MESHY(J)).AND.(DY2.GT.MESHY(J+1)))THEN
+          FY=1.
+        ELSEIF((DY1.LT.MESHY(J)).AND.(DY2.LE.MESHY(J+1)))THEN
+          FY=(DY2-MESHY(J))/(MESHY(J+1)-MESHY(J))
+        ENDIF
+        FZ=0.
+*       FRACTION ALONG Z-AXIS
+        IF((DZ1.GE.MESHZ(K)).AND.(DZ2.GT.MESHZ(K+1)))THEN
+          FZ=(MESHZ(K+1)-DZ1)/(MESHZ(K+1)-MESHZ(K))
+        ELSEIF((DZ1.GE.MESHZ(K)).AND.(DZ2.LE.MESHZ(K+1)))THEN
+          FZ=(DZ2-DZ1)/(MESHZ(K+1)-MESHZ(K))
+        ELSEIF((DZ1.LT.MESHZ(K)).AND.(DZ2.GT.MESHZ(K+1)))THEN
+          FZ=1.
+        ELSEIF((DZ1.LT.MESHZ(K)).AND.(DZ2.LE.MESHZ(K+1)))THEN
+          FZ=(DZ2-MESHZ(K))/(MESHZ(K+1)-MESHZ(K))
+        ENDIF
+*       VOLUME FRACTION
+        VF=FX*FY*FZ
+        IF((IMPX.GT.4).AND.(VF.GT.EPSI))
+     1    WRITE(IOUT,*)'INSERTED DEVICE VOLUME FRACTION ',VF
+*       UPDATE PROPERTIES
+        IF(VF.GT.EPSI)
+     1    CALL NEWMXS(NTOT0,NTOT1,ZNUS,CHI,ZSIGF,DIFFX,DIFFY,DIFFZ,HFAC,
+     2    SCAT,IBM,DMIX(1),DMIX(2),NGRP,NMIX,NL,NDEL,LEAK,VF,XFAC,IMPX)
+      ENDIF
+   40 CONTINUE
+   41 CONTINUE
+   42 CONTINUE
+      RETURN
+      END
diff --git a/Donjon/src/NEWMXS.f b/Donjon/src/NEWMXS.f
new file mode 100644
index 0000000..cf54fb4
--- /dev/null
+++ b/Donjon/src/NEWMXS.f
@@ -0,0 +1,214 @@
+*DECK NEWMXS
+      SUBROUTINE NEWMXS(NTOT0,NTOT1,ZNUS,CHI,ZSIGF,DIFFX,DIFFY,DIFFZ,
+     1 HFAC,SCAT,IBM,IBM1,IBM2,NGRP,NMIX,NL,NDEL,LEAK,VF,XFAC,IMPX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute nuclear properties perturbed by the device insertion.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki
+*
+*Parameters: input/output
+* NTOT0   flux-weighted total macroscopic x-sections.
+* NTOT1   current-weighted total macroscopic x-sections.
+* ZNUS    nu*fission macroscopic x-sections.
+* CHI     fission spectra.
+* ZSIGF   fission macroscopic x-sections.
+* DIFFX   x-directed diffusion coefficients.
+* DIFFY   y-directed diffusion coefficients.
+* DIFFZ   z-directed diffusion coefficients.
+* HFAC    h-factors (kappa*fission macroscopic x-sections).
+* SCAT    scattering macroscopic x-sections.
+* IBM     mixture index for physical region.
+* IBM1    device mixture index for inserted device.
+* IBM2    device mixture index for extracted device.
+* NGRP    number of energy  groups.
+* NMIX    maximum number of material mixtures.
+* NL      number of legendre orders (=1 for isotropic scattering).
+* NDEL    number of precursor groups for delayed neutron.
+* LEAK    diffusion coefficient flag (=1: isotropic; =2: anisotropic).
+* VF      volume fraction occupied by the device.
+* XFAC    corrective factor for delta sigmas.
+* IMPX    printing index (=0 for no print).
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER IBM,IBM1,IBM2,NGRP,NL,NDEL,LEAK,NMIX,IMPX
+      REAL NTOT0(NMIX,NGRP),NTOT1(NMIX,NGRP),ZNUS(NMIX,NGRP,NDEL+1),
+     1     CHI(NMIX,NGRP,NDEL+1),ZSIGF(NMIX,NGRP),DIFFX(NMIX,NGRP),
+     2     HFAC(NMIX,NGRP),VF,SCAT(NMIX,NL,NGRP,NGRP),DIFFY(NMIX,NGRP),
+     3     DIFFZ(NMIX,NGRP),XFAC
+      PARAMETER(IOUT=6,EPSI=1.0E-4)
+*----
+*  UPDATE PROPERTIES
+*----
+      IF(IMPX.GT.4)WRITE(IOUT,*)' UPDATING PROPERTIES'
+      DO 70 JGR=1,NGRP
+      IF(IMPX.GT.4)WRITE(IOUT,*)' '
+      IF(IMPX.GT.4)WRITE(IOUT,*)' PROCESSING ENERGY GROUP # ',JGR
+*----
+*  NTOT0
+*----
+      IF(IMPX.GT.4)WRITE(IOUT,*)' NTOT0 BEFORE  : ',NTOT0(IBM,JGR)
+      DELT=NTOT0(IBM1,JGR)-NTOT0(IBM2,JGR)
+      NTOT0(IBM,JGR)=NTOT0(IBM,JGR)+XFAC*VF*DELT
+      IF(IMPX.GT.4)WRITE(IOUT,*)' DELTA-SIGMA   : ',DELT
+      IF(IMPX.GT.4)WRITE(IOUT,*)' NTOT0 AFTER   : ',NTOT0(IBM,JGR)
+*----
+*  NTOT1
+*----
+      IF(NTOT1(IBM,JGR).EQ.0.)GOTO 10
+      IF(IMPX.GT.4)WRITE(IOUT,*)' NTOT1 BEFORE  : ',NTOT1(IBM,JGR)
+      DELT=NTOT1(IBM1,JGR)-NTOT1(IBM2,JGR)
+      NTOT1(IBM,JGR)=NTOT1(IBM,JGR)+XFAC*VF*DELT
+      IF(IMPX.GT.4)WRITE(IOUT,*)' DELTA-SIGMA   : ',DELT
+      IF(IMPX.GT.4)WRITE(IOUT,*)' NTOT1 AFTER   : ',NTOT1(IBM,JGR)
+*----
+*  NUSIGF
+*----
+   10 IF(ZNUS(IBM,JGR,1).EQ.0.)GOTO 15
+      IF(IMPX.GT.4)WRITE(IOUT,*)' NUSIGF BEFORE : ',ZNUS(IBM,JGR,1)
+      DELT=ZNUS(IBM1,JGR,1)-ZNUS(IBM2,JGR,1)
+      ZNUS(IBM,JGR,1)=ZNUS(IBM,JGR,1)+XFAC*VF*DELT
+      IF(IMPX.GT.4)WRITE(IOUT,*)' DELTA-SIGMA   : ',DELT
+      IF(IMPX.GT.4)WRITE(IOUT,*)' NUSIGF AFTER  : ',ZNUS(IBM,JGR,1)
+      DO IDEL=1,NDEL
+        IF(IMPX.GT.4)WRITE(IOUT,*)' NUSIGF',IDEL,' BEFORE : ',
+     >  ZNUS(IBM,JGR,IDEL+1)
+        DELT=ZNUS(IBM1,JGR,IDEL+1)-ZNUS(IBM2,JGR,IDEL+1)
+        ZNUS(IBM,JGR,IDEL+1)=ZNUS(IBM,JGR,IDEL+1)+XFAC*VF*DELT
+        IF(IMPX.GT.4)WRITE(IOUT,*)' DELTA-SIGMA   : ',DELT
+        IF(IMPX.GT.4)WRITE(IOUT,*)' NUSIGF',IDEL,' AFTER  : ',
+     >  ZNUS(IBM,JGR,IDEL+1)
+      ENDDO
+*----
+*  CHI
+*----
+   15 IF(CHI(IBM,JGR,1).EQ.0.)GOTO 20
+      IF(IMPX.GT.4)WRITE(IOUT,*)' CHI BEFORE : ',CHI(IBM,JGR,1)
+      DELT=CHI(IBM1,JGR,1)-CHI(IBM2,JGR,1)
+      CHI(IBM,JGR,1)=CHI(IBM,JGR,1)+XFAC*VF*DELT
+      IF(IMPX.GT.4)WRITE(IOUT,*)' DELTA-SIGMA   : ',DELT
+      IF(IMPX.GT.4)WRITE(IOUT,*)' CHI AFTER  : ',CHI(IBM,JGR,1)
+      DO IDEL=1,NDEL
+        IF(IMPX.GT.4)WRITE(IOUT,*)' CHI',IDEL,' BEFORE : ',
+     >  CHI(IBM,JGR,IDEL+1)
+        DELT=CHI(IBM1,JGR,IDEL+1)-CHI(IBM2,JGR,IDEL+1)
+        CHI(IBM,JGR,IDEL+1)=CHI(IBM,JGR,IDEL+1)+XFAC*VF*DELT
+        IF(IMPX.GT.4)WRITE(IOUT,*)' DELTA-SIGMA   : ',DELT
+        IF(IMPX.GT.4)WRITE(IOUT,*)' CHI',IDEL,' AFTER  : ',
+     >  CHI(IBM,JGR,IDEL+1)
+      ENDDO
+*----
+*  NFTOT
+*----
+   20 IF(ZSIGF(IBM,JGR).EQ.0.)GOTO 30
+      IF(IMPX.GT.4)WRITE(IOUT,*)' NFTOT BEFORE  : ',ZSIGF(IBM,JGR)
+      DELT=ZSIGF(IBM1,JGR)-ZSIGF(IBM2,JGR)
+      ZSIGF(IBM,JGR)=ZSIGF(IBM,JGR)+XFAC*VF*DELT
+      IF(IMPX.GT.4)WRITE(IOUT,*)' DELTA-SIGMA   : ',DELT
+      IF(IMPX.GT.4)WRITE(IOUT,*)' NFTOT AFTER   : ',ZSIGF(IBM,JGR)
+*----
+*  HFAC
+*----
+   30 IF(HFAC(IBM,JGR).EQ.0.)GOTO 40
+      IF(IMPX.GT.4)WRITE(IOUT,*)' H-FACTOR BEFORE : ',HFAC(IBM,JGR)
+      DELT=HFAC(IBM1,JGR)-HFAC(IBM2,JGR)
+      HFAC(IBM,JGR)=HFAC(IBM,JGR)+XFAC*VF*DELT
+      IF(IMPX.GT.4)WRITE(IOUT,*)' DELTA-SIGMA    : ',DELT
+      IF(IMPX.GT.4)WRITE(IOUT,*)' H-FACTOR AFTER : ',HFAC(IBM,JGR)
+*----
+*  DIFFX
+*----
+   40 IF(DIFFX(IBM,JGR).LT.EPSI)GOTO 50
+      IF(IMPX.GT.4)WRITE(IOUT,*)' DIFFX BEFORE  : ',DIFFX(IBM,JGR)
+      IF(DIFFX(IBM1,JGR).LT.EPSI)THEN
+        DEL1=0.
+      ELSE
+        DEL1=1./DIFFX(IBM1,JGR)
+      ENDIF
+      IF(DIFFX(IBM2,JGR).LT.EPSI)THEN
+        DEL2=0.
+      ELSE
+        DEL2=1./DIFFX(IBM2,JGR)
+      ENDIF
+      DELT=DEL1-DEL2
+      DIFFX(IBM,JGR)=1./DIFFX(IBM,JGR)+XFAC*VF*DELT
+      DIFFX(IBM,JGR)=1./DIFFX(IBM,JGR)
+      IF(IMPX.GT.4)WRITE(IOUT,*)' DELTA-SIGMA   : ',DELT
+      IF(IMPX.GT.4)WRITE(IOUT,*)' DIFFX AFTER   : ',DIFFX(IBM,JGR)
+*----
+*  DIFFY
+*----
+   50 IF(LEAK.NE.2)GOTO 70
+      IF(DIFFY(IBM,JGR).LT.EPSI)GOTO 60
+      IF(IMPX.GT.4)WRITE(IOUT,*)' DIFFY BEFORE  : ',DIFFY(IBM,JGR)
+      IF(DIFFY(IBM1,JGR).LT.EPSI)THEN
+        DEL1=0.
+      ELSE
+        DEL1=1./DIFFY(IBM1,JGR)
+      ENDIF
+      IF(DIFFY(IBM2,JGR).LT.EPSI)THEN
+        DEL2=0.
+      ELSE
+        DEL2=1./DIFFY(IBM2,JGR)
+      ENDIF
+      DELT=DEL1-DEL2
+      DIFFY(IBM,JGR)=1./DIFFY(IBM,JGR)+XFAC*VF*DELT
+      DIFFY(IBM,JGR)=1./DIFFY(IBM,JGR)
+      IF(IMPX.GT.4)WRITE(IOUT,*)' DELTA-SIGMA   : ',DELT
+      IF(IMPX.GT.4)WRITE(IOUT,*)' DIFFY AFTER   : ',DIFFY(IBM,JGR)
+*----
+*  DIFFZ
+*----
+   60 IF(DIFFZ(IBM,JGR).LT.EPSI)GOTO 70
+      IF(IMPX.GT.4)WRITE(IOUT,*)' DIFFZ BEFORE  : ',DIFFZ(IBM,JGR)
+      IF(DIFFZ(IBM1,JGR).LT.EPSI)THEN
+        DEL1=0.
+      ELSE
+        DEL1=1./DIFFZ(IBM1,JGR)
+      ENDIF
+      IF(DIFFZ(IBM2,JGR).LT.EPSI)THEN
+        DEL2=0.
+      ELSE
+        DEL2=1./DIFFZ(IBM2,JGR)
+      ENDIF
+      DELT=DEL1-DEL2
+      DIFFZ(IBM,JGR)=1./DIFFZ(IBM,JGR)+XFAC*VF*DELT
+      DIFFZ(IBM,JGR)=1./DIFFZ(IBM,JGR)
+      IF(IMPX.GT.4)WRITE(IOUT,*)' DELTA-SIGMA   : ',DELT
+      IF(IMPX.GT.4)WRITE(IOUT,*)' DIFFZ AFTER   : ',DIFFZ(IBM,JGR)
+   70 CONTINUE
+*----
+*  SCAT
+*----
+      DO 82 IL=1,NL
+      DO 81 IGR=1,NGRP
+      DO 80 JGR=1,NGRP
+      DELT=SCAT(IBM1,IL,IGR,JGR)-SCAT(IBM2,IL,IGR,JGR)
+      IF((SCAT(IBM,IL,IGR,JGR).NE.0.0).AND.(DELT.NE.0.0)) THEN
+        IF(IMPX.GT.4)WRITE(IOUT,*)' PROCESSING ENERGY GROUP # ',JGR,
+     >  '<-',IGR
+        IF(IMPX.GT.4)WRITE(IOUT,*)' SCAT',IL,' BEFORE   : ',
+     >  SCAT(IBM,IL,IGR,JGR)
+      ENDIF
+      SCAT(IBM,IL,IGR,JGR)=SCAT(IBM,IL,IGR,JGR)+XFAC*VF*DELT
+      IF(DELT.NE.0.0) THEN
+        IF(IMPX.GT.4)WRITE(IOUT,*)' DELTA-SIGMA   : ',DELT
+        IF(IMPX.GT.4)WRITE(IOUT,*)' SCAT',IL,' AFTER    : ',
+     >  SCAT(IBM,IL,IGR,JGR)
+      ENDIF
+   80 CONTINUE
+   81 CONTINUE
+   82 CONTINUE
+      IF(IMPX.GT.4)WRITE(IOUT,*)' ALL PROPERTIES UPDATED.'
+      RETURN
+      END
diff --git a/Donjon/src/PCR.f b/Donjon/src/PCR.f
new file mode 100644
index 0000000..d048e4e
--- /dev/null
+++ b/Donjon/src/PCR.f
@@ -0,0 +1,463 @@
+*DECK PCR
+      SUBROUTINE PCR(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover and interpolate Microlib or Macrolib information from one or
+* many PMAXS files.
+*
+*Copyright:
+* Copyright (C) 2019 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The PCR: calling specifications are:
+* MLIB := PCR: [ { MLIB | MLIB2 } ] PMAX1 [[ PMAX2 ]] [ MAPFL ] :: (PCR\_data) ;
+* where
+*   MLIB : name of a \emph{microlib (type L\_LIBRARY) or \emph{macrolib} (type 
+*     L\_MACROLIB) containing the interpolated data. If this object also 
+*     appears on the RHS of structure (PCR:, it is open in modification mode 
+*     and updated.
+*   MLIB2 : name of an optional \emph{microlib} object whose content is copied 
+*     on MLIB.
+*   PMAX1 : name of the PMAXS file.
+*   PMAX2 : name of an additional PMAXS file. This file is optional.
+*   MAPFL : name of the \emph{map} object containing fuel regions description, 
+*     parameter information (burnup, fuel/coolant temperatures, coolant 
+*     density, etc). Keyword TABLE is expected in (PCR\_data).
+*   PCR\_data : input data structure containing interpolation information.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      USE PCRDATA
+      USE PCREAD
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(NSTATE=40,MXPMAXS=10,MAXISD=200,IOUT=6,MAXR=12)
+      INTEGER ISTATE(NSTATE),XS_F_NUM,IFPMAXS(MXPMAXS)
+      LOGICAL LMACRO,LCUBIC
+      DOUBLE PRECISION DFLOTT
+      TYPE(C_PTR) IPMAP,IPLIB,IPLIB2
+      CHARACTER HSIGN*12,TEXT4*4,TEXT12*12,HSMG*131,NMDEPL(MAXR)*8
+      CHARACTER(LEN=12) :: HFPMAXS(MXPMAXS)
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: NISO,ITNAM,ITZEA,MATNO,
+     1 KPAX,INAM,IZAE,HREAC,IDR,KPAR
+      INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: HISO
+      REAL, ALLOCATABLE, DIMENSION(:) :: BPAX,RER,RRD,BPAR,YIELD
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: TERP,CONC
+      LOGICAL, ALLOCATABLE, DIMENSION(:) :: LMIXC
+      TYPE(XSBLOCK_ITEM), ALLOCATABLE, DIMENSION(:) :: XS_CALC
+*
+      SAVE      NMDEPL
+      DATA      NMDEPL/'DECAY   ','NFTOT   ','NG      ','N2N     ',
+     >                 'N3N     ','N4N     ','NA      ','NP      ',
+     >                 'N2A     ','NNP     ','ND      ','NT      '/
+*----
+*  PARAMETER VALIDATION
+*----
+      IF(NENTRY.LE.1) CALL XABORT('PCR: MINIMUM OF 2 OBJECTS EXPECTED.')
+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('PCR: MACRO'
+     1 //'LIB LCM OBJECT EXPECTED AT LHS.')
+      IF((JENTRY(1).NE.0).AND.(JENTRY(1).NE.1)) CALL XABORT('PCR: MACRO'
+     1 //'LIB IN CREATE OR MODIFICATION MODE EXPECTED.')
+      IACCS=JENTRY(1)
+      IPLIB=KENTRY(1)
+      IPLIB2=C_NULL_PTR
+      IPMAP=C_NULL_PTR
+      IFPMAXS(:)=0 ! PMAXS file unit
+      NGRP=0
+      NMIX=0
+      XS_F_NUM=0
+      IF(IACCS.EQ.1) THEN
+        CALL LCMGTC(IPLIB,'SIGNATURE',12,HSIGN)
+        IF(HSIGN.EQ.'L_LIBRARY') THEN
+          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+          NGRP=ISTATE(3)
+          NMIX=ISTATE(1)
+        ELSE IF(HSIGN.NE.'L_MACROLIB') THEN
+          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+          NGRP=ISTATE(1)
+          NMIX=ISTATE(2)
+        ELSE
+          TEXT12=HENTRY(1)
+          CALL XABORT('PCR: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     1    '. L_LIBRARY OR L_MACROLIB EXPECTED.')
+        ENDIF
+      ENDIF
+      DO 10 I=2,NENTRY
+        IF(IENTRY(I).EQ.3) CALL XABORT('PCR: LCM OBJECTS OR ASCII FILE'
+     1 //'S EXPECTED AT RHS.')
+        IF(JENTRY(I).NE.2) CALL XABORT('PCR: LCM OBJECTS IN READ-ONLY '
+     1 //'MODE EXPECTED AT RHS.')
+        IF(IENTRY(I).EQ.4) THEN
+          XS_F_NUM=XS_F_NUM+1
+          IF(XS_F_NUM.GT.MXPMAXS) CALL XABORT('PCR: MXPMAXS OVERFLOW.')
+          IFPMAXS(XS_F_NUM)=FILUNIT(KENTRY(I))
+          HFPMAXS(XS_F_NUM)=HENTRY(I)
+        ELSE
+          CALL LCMGTC(KENTRY(I),'SIGNATURE',12,HSIGN)
+          IF(HSIGN.EQ.'L_LIBRARY') THEN
+            IF(C_ASSOCIATED(IPLIB2)) CALL XABORT('PCR: ONLY ONE MICROL'
+     1     //'IB EXPECTED AT RHS.')
+            IPLIB2=KENTRY(I)
+            GO TO 10
+          ELSE IF(HSIGN.EQ.'L_MACROLIB') THEN
+            CALL XABORT('PCR: ANOTHER MACROLIB NOT EXPECTED AT RHS.')
+          ELSE IF(HSIGN.EQ.'L_MAP') THEN
+            IF(I.NE.NENTRY)CALL XABORT('PCR: FUEL-MAP EXPECTED TO BE T'
+     1      //'HE LAST OBJECT.')
+            IF(NENTRY.LT.3)CALL XABORT('PCR: MISSING SAPHYB OBJECT.')
+            IPMAP=KENTRY(NENTRY)
+            CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+            NMIX=ISTATE(9)
+          ELSE
+            CALL XABORT('PCR: INVALID SIGNATURE='//HSIGN//'.')
+          ENDIF
+        ENDIF
+   10 CONTINUE
+*----
+*  ALLOCATE PMAXS INFORMATION
+*----
+      IF(XS_F_NUM.EQ.0) CALL XABORT('PCR: PMAXS FILE NOT DEFINED.')
+      ALLOCATE(Bran_info(XS_F_NUM))
+      ALLOCATE(PMAXS(XS_F_NUM))
+      KREAD=-1
+      DO I=1,XS_F_NUM
+        PMAX=>PMAXS(I)
+        Bran_info(I)%NOT_assigned=.true.
+        CALL read_PMAXS_file(I,KREAD,IFPMAXS(I))
+        KREAD=0
+      ENDDO
+      NCAL=0
+      DO IBRA=1,NBRA
+        IBSET=PMAX%BRANCH(IBRA,1)%IBSET
+        NBURN=PMAX%Bset(IBSET)%NBURN
+        NCAL=NCAL+NBURN
+      ENDDO
+*----
+*  READ THE INPUT DATA
+*----
+      LMACRO=.TRUE.
+      LCUBIC=.FALSE.
+      B2=0.0
+      IMPX=1
+   20 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+      IF(INDIC.NE.3) CALL XABORT('PCR: CHARACTER DATA EXPECTED(1).')
+   30 IF(TEXT12.EQ.'EDIT') THEN
+*       READ THE PRINT INDEX.
+        CALL REDGET(INDIC,IMPX,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1) CALL XABORT('PCR: INTEGER DATA EXPECTED(1).')
+      ELSE IF(TEXT12.EQ.'NMIX') THEN
+*       READ THE MAXIMUM NUMBER OF MATERIAL MIXTURES.
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1) CALL XABORT('PCR: INTEGER DATA EXPECTED(2).')
+        IF(NITMA.LT.NMIX) THEN
+           WRITE(HSMG,'(20HPCR: NMIX MUST BE >=,I8)') NMIX
+           CALL XABORT(HSMG)
+        ENDIF
+        NMIX=NITMA
+      ELSE IF(TEXT12.EQ.'MACRO') THEN
+        LMACRO=.TRUE.
+      ELSE IF(TEXT12.EQ.'MICRO') THEN
+        LMACRO=.FALSE.
+      ELSE IF(TEXT12.EQ.'LINEAR') THEN
+        LCUBIC=.FALSE.
+      ELSE IF(TEXT12.EQ.'CUBIC') THEN
+        LCUBIC=.TRUE.
+      ELSE IF(TEXT12.EQ.'PMAXS') THEN
+        IF(NMIX.EQ.0) CALL XABORT('PCR: ZERO NUMBER OF MIXTURES.')
+        IF(C_ASSOCIATED(IPMAP)) THEN
+          WRITE(IOUT,'(/43H PCR: ***WARNING*** A FUEL MAP IS SET AT RH,
+     1    26HS; KEYWORD TABLE EXPECTED.)')
+        ENDIF
+        NGRP=NGROUP
+        IF((IACCS.EQ.0).AND.(C_ASSOCIATED(IPLIB2))) THEN
+          CALL LCMEQU(IPLIB2,IPLIB)
+          IACCS=1
+        ENDIF
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3) CALL XABORT('PCR: CHARACTER DATA EXPECTED(2).')
+        I0=0
+        DO 60 I=1,XS_F_NUM
+          IF(TEXT12.EQ.HFPMAXS(I)) THEN
+            PMAX=>PMAXS(I)
+            ITH=I
+            GO TO 70
+          ENDIF
+   60   CONTINUE
+        CALL XABORT('PCR: PMAXS FILE '//TEXT12//' NOT FOUND.')
+   70   IF(IMPX.GT.0) WRITE(IOUT,320) TEXT12
+        ALLOCATE(TERP(NCAL,NMIX),NISO(NMIX),HISO(2,NMIX,MAXISD),
+     1  CONC(NMIX,MAXISD),LMIXC(NMIX),XS_CALC(NCAL))
+*
+        CALL PCRDRV(LCUBIC,NMIX,IMPX,NCAL,ITER,MAXNIS,TERP,NISO,HISO,
+     1  CONC,LMIXC,XS_CALC)
+        GO TO 100
+      ELSE IF(TEXT12.EQ.'TABLE') THEN
+        IF(.NOT.C_ASSOCIATED(IPMAP)) CALL XABORT('PCR: MISSING FUEL-MA'
+     1  //'P OBJECT.')
+        ISTATE(:NSTATE)=0
+        CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+        NB=ISTATE(1)
+        NCH=ISTATE(2)
+        NCOMB=ISTATE(3)
+        NGRP=ISTATE(4)
+        NFUEL=ISTATE(7)
+        NPARM=ISTATE(8)
+        IF(NCOMB.EQ.0)CALL XABORT('PCR: NUMBER OF COMBUSTION ZONES NO'
+     1   //'T YET DEFINED IN THE FUEL MAP NCOMB=0.')
+        IF((IACCS.EQ.0).AND.(C_ASSOCIATED(IPLIB2))) THEN
+          CALL LCMEQU(IPLIB2,IPLIB)
+          IACCS=1
+        ENDIF
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3) CALL XABORT('PCR: CHARACTER DATA EXPECTED(3).')
+        I0=0
+        DO 80 I=1,XS_F_NUM
+          IF(TEXT12.EQ.HFPMAXS(I)) THEN
+            PMAX=>PMAXS(I)
+            ITH=I
+            GO TO 90
+          ENDIF
+   80   CONTINUE
+        CALL XABORT('PCR: PMAXS FILE '//TEXT12//' NOT FOUND.')
+   90   IF(IMPX.GT.0) WRITE(IOUT,320) TEXT12
+        IF(NGRP.NE.NGROUP) THEN
+          WRITE(HSMG,'(9H PCR: THE,I4,29H-TH PMAXS FILE HAS AN INVALID,
+     1    25H NUMBER OF ENERGY GROUPS.)') ITH
+          CALL XABORT(HSMG)
+        ENDIF
+        ALLOCATE(TERP(NCAL,NMIX),NISO(NMIX),HISO(2,NMIX,MAXISD),
+     1  CONC(NMIX,MAXISD),LMIXC(NMIX),XS_CALC(NCAL))
+*
+        CALL PCRRGR(IPMAP,LCUBIC,NMIX,IMPX,NCAL,NCH,NB,NFUEL,NPARM,
+     1  ITER,MAXNIS,TERP,NISO,HISO,CONC,LMIXC,XS_CALC)
+        GO TO 100
+      ELSE IF(TEXT12.EQ.'LEAK') THEN
+        CALL REDGET(INDIC,NITMA,B2,TEXT12,DFLOTT)
+        IF(INDIC.NE.2) CALL XABORT('PCR: REAL DATA EXPECTED.')
+      ELSE IF(TEXT12.EQ.'CHAIN') THEN
+        IF(LMACRO) CALL XABORT('PCR: MICRO KEYWORD EXPECTED.')
+        CALL REDGET(INDIC,MD2,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1) CALL XABORT('PCR: INTEGER DATA EXPECTED.')
+*
+        NBESP=1
+        ALLOCATE(ITNAM(3*MD2),ITZEA(MD2),MATNO(MD2),
+     1  KPAX((MD2+MAXR)*MD2),BPAX((MD2+MAXR)*MD2*NBESP))
+        TEXT4='    '
+        READ(TEXT4,'(A4)') ITEXT4
+        ITNAM(:3*MD2)=ITEXT4
+        ITZEA(:MD2)=0
+        MATNO(:MD2)=0
+        KPAX(:(MD2+MAXR)*MD2)=0
+        BPAX(:(MD2+MAXR)*MD2*NBESP)=0.0
+        CALL PCREIR(NMDEPL,MD2,NEL,ITNAM,ITZEA,KPAX,BPAX)
+        CALL LIBWET(MAXR,MD2,NBESP,NSTATE,NMDEPL,ITNAM,ISTATE,MATNO,
+     1  KPAX,BPAX)
+        NDEPL=ISTATE(1)
+        NDFI=ISTATE(2)
+        NDFP=ISTATE(3)
+        NHEAVY=ISTATE(4)
+        NLIGHT=ISTATE(5)
+        NOTHER=ISTATE(6)
+        NSTABL=ISTATE(7)
+        NREAC=ISTATE(8)
+        NPAR=ISTATE(9)
+        NBESP=MAX(1,ISTATE(10))
+*----
+*  ALLOCATE DECAY CHAIN
+*----
+        NDEPL=MAX(NDEPL,1)
+        NDFI=MAX(NDFI,1)
+        NDFP=MAX(NDFP,1)
+        ALLOCATE(INAM(3*NDEPL),IZAE(NDEPL),IDR(NREAC*NDEPL),
+     1  RER(NREAC*NDEPL),RRD(NDEPL),KPAR(NPAR*NDEPL),BPAR(NPAR*NDEPL),
+     2  YIELD(NDFI*NDFP*NBESP))
+*----
+*  SET DECAY CHAIN
+*----
+        CALL LIBWED(MAXR,MD2,NBESP,NDEPL,NDFI,NDFP,NHEAVY,NLIGHT,NOTHER,
+     >              NREAC,NPAR,ITNAM,ITZEA,MATNO,KPAX,BPAX,INAM,IZAE,
+     >              IDR,RER,RRD,KPAR,BPAR,YIELD)
+*----
+*  RELEASE WORK VECTORS FOR WIMS-AECL, WIMS-NEA, DRAGLIB
+*  AND INPUT FILE
+*----
+        DEALLOCATE(BPAX,KPAX,MATNO,ITZEA,ITNAM)
+*----
+*  SELECT USED DEPLETION REACTION NAMES
+*----
+        ALLOCATE(HREAC(2*NREAC))
+        DO 95 I=1,NREAC
+          READ(NMDEPL(I),'(2A4)') (HREAC(2*(I-1)+J),J=1,2)
+   95   CONTINUE
+*----
+*  PRINT DECAY CHAIN IF REQUIRED
+*----
+        IMPY=IMPX+2
+        CALL LIBEPR(IMPY,NBESP,NDEPL,NSTABL,NDFI,NDFP,NREAC,NPAR,INAM,
+     >              HREAC,IDR,RER,RRD,KPAR,BPAR,YIELD,IZAE)
+*----
+*  SAVE CHAIN
+*----
+        CALL LCMSIX(IPLIB,'DEPL-CHAIN',1)
+        CALL LCMPUT(IPLIB,'STATE-VECTOR',NSTATE,1,ISTATE)
+        NDEPL=ISTATE(1)
+        CALL LCMPUT(IPLIB,'ISOTOPESDEPL',3*NDEPL,3,INAM)
+        CALL LCMPUT(IPLIB,'CHARGEWEIGHT',NDEPL,1,IZAE)
+        CALL LCMPUT(IPLIB,'DEPLETE-IDEN',2*NREAC,3,HREAC)
+        CALL LCMPUT(IPLIB,'DEPLETE-REAC',NREAC*NDEPL,1,IDR)
+        CALL LCMPUT(IPLIB,'DEPLETE-ENER',NREAC*NDEPL,2,RER)
+        CALL LCMPUT(IPLIB,'DEPLETE-DECA',NDEPL,2,RRD)
+        CALL LCMPUT(IPLIB,'PRODUCE-REAC',NPAR*NDEPL,1,KPAR)
+        CALL LCMPUT(IPLIB,'PRODUCE-RATE',NPAR*NDEPL,2,BPAR)
+        IF(NDFP.GT.0) CALL LCMPUT(IPLIB,'FISSIONYIELD',NDFI*NDFP*NBESP,
+     >  2,YIELD)
+        CALL LCMSIX(IPLIB,' ',2)
+        CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+        ISTATE(11)=NDEPL
+        ISTATE(12)=NMIX
+        CALL LCMPUT(IPLIB,'STATE-VECTOR',NSTATE,1,ISTATE)
+*----
+*  DEALLOCATE DECAY CHAIN ARRAYS
+*----
+        DEALLOCATE(YIELD,BPAR,KPAR,RRD,RER,IDR,IZAE,INAM)
+        IF(IMPX.GT.0) THEN
+          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+          WRITE(IOUT,300) IMPX,(ISTATE(I),I=1,12)
+          WRITE(IOUT,310) (ISTATE(I),I=13,15),(ISTATE(I),I=17,24)
+        ENDIF
+      ELSE IF(TEXT12.EQ.';') THEN
+        GO TO 200
+      ELSE
+        CALL XABORT('PCR: '//TEXT12//' IS AN INVALID KEYWORD.')
+      ENDIF
+      GO TO 20
+*----
+*  BUILD THE INTERPOLATED MACROLIB OR MICROLIB
+*----
+ 100  IF(LMACRO) THEN
+*       build a macrolib
+        CALL PCRMAC(MAXNIS,IPLIB,IACCS,NMIX,NGRP,NGFF,IMPX,NCAL,TERP,
+     1  NISO,HISO,CONC,LMIXC,XS_CALC,B2)
+        IF(IMPX.GT.0) THEN
+          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+          WRITE(IOUT,290) IMPX,(ISTATE(I),I=1,9),ISTATE(12),ISTATE(16)
+        ENDIF
+      ELSE
+*       build a microlib
+        IF(IACCS.EQ.0)THEN
+          MAXISO=MAXISD*NMIX
+        ELSE
+          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+          MAXISO=MAX(MAXISD*NMIX,ISTATE(2))
+        ENDIF
+        CALL PCRMIC(MAXNIS,MAXISO,IPLIB,IACCS,NMIX,NGRP,IMPX,NCAL,TERP,
+     1  NISO,HISO,CONC,LMIXC,XS_CALC,B2)
+        IF(IMPX.GT.0) THEN
+          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+          WRITE(IOUT,300) IMPX,(ISTATE(I),I=1,12)
+          WRITE(IOUT,310) (ISTATE(I),I=13,15),(ISTATE(I),I=17,24)
+        ENDIF
+      ENDIF
+*
+      DEALLOCATE(XS_CALC,LMIXC,CONC,HISO,NISO,TERP)
+*----
+*  CONTINUE DATA PROCESSING
+*----
+      IF(ITER.EQ.0) THEN
+        GO TO 200
+      ELSE IF(ITER.EQ.1) THEN
+        TEXT12='PMAXS'
+        GO TO 30
+      ELSE IF(ITER.EQ.2) THEN
+        TEXT12='TABLE'
+        GO TO 30
+      ELSE IF(ITER.EQ.3) THEN
+        TEXT12='CHAIN'
+        GO TO 30
+      ENDIF
+*----
+*  DEALLOCATE PMAXS INFORMATION
+*----
+  200 IF(IMPX.GT.2) CALL LCMLIB(IPLIB)
+      DO I=1,XS_F_NUM
+        PMAX=>PMAXS(I)
+        CALL Clear_PMAXS_file(I)
+      ENDDO
+      DEALLOCATE(PMAXS,Bran_info)
+      RETURN
+*
+  290 FORMAT(/8H OPTIONS/8H -------/
+     1 7H IMPX  ,I6,30H   (0=NO PRINT/1=SHORT/2=MORE)/
+     2 7H NGROUP,I6,28H   (NUMBER OF ENERGY GROUPS)/
+     3 7H NBMIX ,I6,39H   (NUMBER OF MIXTURES IN THE MACROLIB)/
+     4 7H NANISO,I6,34H   (MAXIMUM SCATTERING ANISOTROPY)/
+     5 7H NIFISS,I6,45H   (MAXIMUM NUMBER OF FISSILE ISOTOPES IN A M,
+     6 7HIXTURE)/
+     7 7H NEDMAC,I6,34H   (NUMBER OF CROSS SECTION EDITS)/
+     8 7H ITRANC,I6,45H   (0=NO TRANSPORT CORRECTION/1=APOLLO TYPE/2,
+     9 43H=RECOVER FROM LIBRARY/4=LEAKAGE CORRECTION)/
+     1 7H NLG   ,I6,39H   (NUMBER OF DELAYED PRECURSOR GROUPS)/
+     2 7H NALBP ,I6,31H   (NUMBER OF PHYSICAL ALBEDOS)/
+     3 7H ILEAK ,I6,40H   (1=DIFF AVAILABLE; 2=DIFFX AVAILABLE)/
+     4 7H IDF   ,I6,33H   (0=NO ADF INFO/2=ADF GAP INFO)/
+     5 7H NGFF  ,I6,39H   (0: NO GENERALIZED FORM FACTOR INFO))
+  300 FORMAT(/8H OPTIONS/8H -------/
+     1 7H IMPX  ,I6,30H   (0=NO PRINT/1=SHORT/2=MORE)/
+     2 7H MAXMIX,I6,31H   (MAXIMUM NUMBER OF MIXTURES)/
+     3 7H NBISO ,I6,36H   (NUMBER OF ISOTOPES OR MATERIALS)/
+     4 7H NGRP  ,I6,28H   (NUMBER OF ENERGY GROUPS)/
+     5 7H NL    ,I6,30H   (NUMBER OF LEGENDRE ORDERS)/
+     6 7H ITRANC,I6,45H   (0=NO TRANSPORT CORRECTION/1=APOLLO TYPE/2,
+     7 57H=RECOVER FROM LIBRARY/3=WIMS-D TYPE/4=LEAKAGE CORRECTION)/
+     8 7H IPROB ,I6,23H   (0=DIRECT/1=ADJOINT)/
+     9 7H ITIME ,I6,28H   (1=STEADY-STATE/2=PROMPT)/
+     1 7H NLIB  ,I6,32H   (NUMBER OF SETS OF LIBRARIES)/
+     2 7H NGF   ,I6,48H   (NUMBER OF FAST GROUP WITHOUT SELF-SHIELDING)/
+     3 7H IGRMAX,I6,41H   (LAST GROUP INDEX WITH SELF-SHIELDING)/
+     4 7H NDEPL ,I6,33H   (NUMBER OF DEPLETING ISOTOPES)/
+     5 7H NCOMB ,I6,33H   (NUMBER OF DEPLETING MIXTURES))
+  310 FORMAT(7H NEDMAC,I6,34H   (NUMBER OF CROSS SECTION EDITS)/
+     1 7H NBMIX ,I6,23H   (NUMBER OF MIXTURES)/
+     2 7H NRES  ,I6,40H   (NUMBER OF SETS OF RESONANT MIXTURES)/
+     3 7H IPROC ,I6,48H   (-1=SKIP LIBRARY PROCESSING/0=DILUTION INTERP,
+     4 48HOLATION/1=USE PHYSICAL TABLES/2=BUILD A DRAGLIB/,
+     5 55H3=COMPUTE CALENDF TABLES/4=COMPUTE SLOWING-DOWN TABLES)/
+     6 7H IMAC  ,I6,45H   (0=DO NOT/1=DO BUILD AN EMBEDDED MACROLIB)/
+     7 7H NDEL  ,I6,31H   (NUMBER OF PRECURSOR GROUPS)/
+     8 7H NFISS ,I6,31H   (NUMBER OF FISSILE ISOTOPES)/
+     9 7H ISOADD,I6,37H   (0=COMPLETE BURNUP CHAIN/1=DO NOT)/
+     1 7H MAXISM,I6,40H   (MAX. NUMBER OF ISOTOPES PER MIXTURE)/
+     2 7H IPRECI,I6,34H   (CALENDF ACCURACY FLAG:1/2/3/4)/
+     3 7H IDF   ,I6,33H   (0=NO ADF INFO/2=ADF GAP INFO))
+  320 FORMAT(/32H PCR: INTERPOLATING PMAXS FILE ',A12,2H'.)
+      END
diff --git a/Donjon/src/PCRDATA.f90 b/Donjon/src/PCRDATA.f90
new file mode 100644
index 0000000..d153429
--- /dev/null
+++ b/Donjon/src/PCRDATA.f90
@@ -0,0 +1,276 @@
+MODULE PCRDATA
+!
+!-----------------------------------------------------------------------
+!
+!Purpose:
+! Fortran module containing PMAXS file information.
+!
+!Copyright:
+! Copyright (C) 2019 Ecole Polytechnique de Montreal
+!
+!Author(s): A. Hebert
+!
+!-----------------------------------------------------------------------
+!
+    IMPLICIT NONE      
+    INTEGER(4), PARAMETER  :: Nallvar=12
+    REAL(8)             :: state_value(Nallvar)
+    
+    CHARACTER(2)        :: all_var_nam(Nallvar)
+    DATA                   all_var_nam/'CR','DC','PC','TF','TC','IC','DM','PM','TM','IM','DN','BN'/
+    INTEGER(4), PARAMETER   :: svCR=1,svDC=2,svPC=3,svTF=4,svTC=5
+    INTEGER(4), PARAMETER   :: svIC=6,svDM=7,svPM=8,svTM=9,svIM=10
+    INTEGER(4), PARAMETER   :: svDN=11,svBN=12
+    
+    REAL(8)             :: Sref(Nallvar)
+    DATA                Sref/0.0, 0.71, 600.0, 28.3, 580.0, 0.0, 0.71, 600.0, 580.0, 0.0, 0.0, 0.0 /
+
+    LOGICAL :: validname
+    LOGICAL :: lHST(Nallvar), lSTT(Nallvar)
+
+    CHARACTER(12) :: formng
+    CHARACTER(3) :: TIVname(4)
+
+    INTEGER(4), PARAMETER :: xtr=1,xab=2,xnf=3,xkf=4,xxe=5,xsm=6,xfi=7
+    INTEGER(4), PARAMETER :: xdcl=1,xdwr=2,xdbp=3,xdcr=4,xchi=1,BBET=1
+    INTEGER(4) :: xchd,xinv, EBET,BLAM,ELAM,BDHB,EDHB,BDHL,EDHL
+    INTEGER(4) :: xlpk,xj1i,xj1s,xj1c
+    INTEGER(4) :: NXST,NLPF,iLPF,iXSTI
+    INTEGER(4) :: iTIV(4),ilpk,ij1c,iread_xs
+
+    INTEGER(4) :: NGR,NDL,NDC,NAD,NCD
+    INTEGER(4) :: NGROUP,NDLAY,NDCAY,NADF,NZDF,NCDF,iups,Nset,NTDF
+    INTEGER(4) :: NHST,NBRA,NBCR,NBset,NRODS,NCOL,NROW,NPART,NROWA,NCOLA,NXSB
+    INTEGER(4) :: MHST,MBRA,MBCR,MBset,MRODS,MCOLA
+    INTEGER(4) :: N_Bran_struct,Nstat_var,ktf
+    INTEGER(4), DIMENSION(:), POINTER :: var_ind,NBR
+    REAL(8) :: iHMD,Dsat,ARWatR,ARByPa,ARConR,PITCH,XBE,YBE,minw,maxw,maxws,minws
+    REAL(8), DIMENSION(:,:), POINTER :: state
+
+    LOGICAL :: ladf,lxes,lded,lj1f,lchi,lchd,linv,ldet,lyld,lcdf,lgff,lbet,lamb,ldec,lzdf
+    LOGICAL :: tcdf,tgff
+    LOGICAL :: padf,pxes,pded,pj1f,pchi,pchd,pvel,pdet,pyld,pcdf,pgff,pbet,pamb,pdec,pzdf
+    LOGICAL :: lcrp,lppm,lxesm,derivatives, outrange
+
+    CHARACTER(80),DIMENSION(6) :: hcomment
+
+    TYPE Branches_info
+       INTEGER(4) :: Nstat_var, ktf, NBRA
+       INTEGER(4), DIMENSION(:),   POINTER   :: var_ind     !(Nstat_var)
+       INTEGER(4), DIMENSION(:),   POINTER   :: NBR         !(Nstat_var)
+       Character(2), DIMENSION(:), POINTER   :: state_nam   !(NBRA)
+       REAL(8), DIMENSION(:,:), POINTER   :: state          !(Nstat_var,NBRA)
+       logical :: NOT_assigned
+       Character(2), DIMENSION(:), POINTER :: var_nam       !(Nstat_var)
+    END TYPE Branches_info
+   
+    TYPE XSBLOCK_TYPE
+         REAL(8), DIMENSION(:,:), POINTER ::sig  !(NGROUP,NXST)
+!                                           1   2   3   4   5   6   7
+!                                          xtr,xab,xnf,xkf,xfi,xxe,xsm
+         REAL(8), DIMENSION(:,:), POINTER ::sct,adf,cdf,gff,zdf
+         REAL(8), DIMENSION(:),   POINTER ::LPF,det
+         REAL(8) ::    kinf,B2,kinfB,kinfL
+! Average assembly flux
+         REAL(8), DIMENSION(:),   POINTER :: flux
+! Axial surface flux, (g,bottom->top)         
+         REAL(8), DIMENSION(:,:), POINTER :: zflx
+! Radial surface flux, (g,W-S-E-N) if cart, if hex(g,NW-W-SW-SE-E-NE)
+         REAL(8), DIMENSION(:,:), POINTER :: rflx
+! Axial current in, (g,bottom->top,i-o-n)         
+         REAL(8), DIMENSION(:,:,:), POINTER :: zcur
+! Radial surface flux, (g,W-S-E-N,i-o-n) if cart, if hex(g,NW-W-SW-SE-E-NE)
+         REAL(8), DIMENSION(:,:,:), POINTER :: rcur  
+! Groupwise yields
+         REAL(8), DIMENSION(:),   POINTER :: yldI, yldXe, yldPm
+! Xe, Sm, I, Pm Number Densities         
+         REAL(8) :: NDXE,NDSM,NDI,NDPM
+    END TYPE XSBLOCK_TYPE
+
+    TYPE BRANCH_WISE_TYPE
+        INTEGER(4)                        :: iBset
+        TYPE(XSBLOCK_TYPE),dimension(:),pointer:: XS(:) !(NBURN)
+    END TYPE BRANCH_WISE_TYPE
+
+    TYPE PMAXS_WISE_TYPE
+         logical   derivatives
+         INTEGER(4) :: NCOL,NRODS,NROW,NPART,NROWA,NCOLA
+         INTEGER(4) :: NHST,NBset
+         REAL(8),  DIMENSION(:,:), POINTER         :: history      !(Nstat_var,NHST)
+         REAL(8),  DIMENSION(:), POINTER           :: invdiff      !(NHST)
+         INTEGER(4),  DIMENSION(:), POINTER           :: base         !(NHST)
+         REAL(8):: iHMD,Dsat,ARWatR,ARByPa,ARConR,PITCH,XBE,YBE
+
+         TYPE(BRANCH_WISE_TYPE), DIMENSION(:,:), POINTER :: branch !(NBRA,NHST)
+         TYPE(HIST_TIV_TYPE),     DIMENSION(:), POINTER :: TIVB   !(NHST)
+         TYPE(Burnup_info),DIMENSION(:), POINTER  :: Bset !(NBset)
+    END TYPE PMAXS_WISE_TYPE
+
+    TYPE HIST_TIV_TYPE
+        INTEGER(4)                        :: iBset
+        TYPE(TH_INDEP_VAR),dimension(:),pointer:: TIV(:) !(NBURN)
+    END TYPE HIST_TIV_TYPE
+
+    TYPE Burnup_info
+        INTEGER(4) :: NBURN
+        REAL(8),DIMENSION(:), POINTER  :: burns !(NBURN)
+    end type Burnup_info
+
+    TYPE TH_INDEP_VAR
+       REAL(8), DIMENSION(:,:),POINTER :: sig   !(NGROUP,xinv)
+!                                                xchi,xchd,xinv,
+       REAL(8), DIMENSION(:),POINTER :: kinp !bet,lam,dhb,dhl
+       REAL(8) :: YLD(3) !YID,YXE,YPM
+       REAL(8) :: NDXE,NDSM,NDI,NDPM
+       REAL(8) :: POWER
+       REAL(8) :: DAYS
+       REAL(8) :: BURNUP
+    END TYPE TH_INDEP_VAR
+
+    TYPE XSBLOCK_ITEM
+       INTEGER :: IBURN ! burnup step -- added by EPM
+       REAL(8) :: DELTA ! delta local variable -- added by EPM
+       TYPE(XSBLOCK_TYPE), POINTER :: XS
+       TYPE(TH_INDEP_VAR), POINTER :: TIV
+    END TYPE XSBLOCK_ITEM
+
+    TYPE(PMAXS_WISE_TYPE),DIMENSION(:), POINTER :: PMAXS !(XS_F_NUM)
+    TYPE(PMAXS_WISE_TYPE),pointer:: PMAX
+    TYPE(Branches_info), DIMENSION(:), target,allocatable ::Bran_info
+    TYPE(Branches_info), POINTER ::bran_i
+    TYPE(XSBLOCK_TYPE), target,allocatable :: XSCR(:)
+    TYPE(XSBLOCK_TYPE), target :: XSND
+    TYPE(XSBLOCK_TYPE), pointer:: XS
+    TYPE(TH_INDEP_VAR), pointer:: TIV
+
+contains
+
+!---------------------------------------------------------------------
+   SUBROUTINE AllocateXSBlock
+!---------------------------------------------------------------------
+      IMPLICIT NONE
+      
+      INTEGER(4) :: ireg
+      
+      IF (NADF .GT. 4) THEN
+          ireg = NADF
+      ELSE
+          ireg = 4
+      END IF
+
+      allocate(XS%sig(NGROUP,NXST))
+      allocate(XS%sct(NGROUP,NGROUP))
+      allocate(XS%flux(NGROUP))
+      allocate(XS%rflx(NGROUP,ireg))
+      allocate(XS%zflx(NGROUP,2))
+      allocate(XS%rcur(NGROUP,ireg,3))
+      allocate(XS%zcur(NGROUP,2,3))
+      IF (lyld) THEN
+          allocate(XS%yldI(NGROUP))
+          allocate(XS%yldXe(NGROUP))
+          allocate(XS%yldPm(NGROUP))
+      ELSE
+          allocate(XS%yldI(1))
+          allocate(XS%yldXe(1))
+          allocate(XS%yldPm(1))
+      END IF
+      if(ladf)then
+         allocate(XS%adf(NGROUP,NADF))
+      else
+         allocate(XS%adf(1,1))
+      endif
+      if(lzdf)then
+         allocate(XS%ZDF(NGROUP,NZDF))
+         NTDF = NADF + NZDF
+      else
+         allocate(XS%ZDF(1,1))
+         NTDF = NADF
+      endif
+      if(NLPF .GT. 0)then
+         allocate(XS%LPF(NLPF))
+      else
+         allocate(XS%LPF(1))
+      endif
+      if(ldet)then
+         allocate(XS%det(NGROUP))
+      else
+         allocate(XS%det(1))
+      endif
+      if(lcdf)then
+         allocate(XS%cdf(NGROUP,NCDF))
+      else
+         allocate(XS%cdf(1,1))
+      endif
+      if(lgff.and.NRODS .GT. 0)then
+         allocate(XS%gff(NGROUP,NRODS))
+      else
+         allocate(XS%gff(1,1))
+      endif
+      
+      CALL Default_XS
+   END SUBROUTINE AllocateXSBlock
+
+!---------------------------------------------------------------------
+   SUBROUTINE DeallocateXSBlock
+!---------------------------------------------------------------------
+      deallocate(XS%sig)
+      deallocate(XS%sct)
+      deallocate(XS%adf)
+      deallocate(XS%zdf)
+      deallocate(XS%cdf)      
+      deallocate(XS%LPF)
+      deallocate(XS%det)
+      deallocate(XS%gff)
+      deallocate(XS%flux)
+      deallocate(XS%rflx)
+      deallocate(XS%zflx)
+      deallocate(XS%rcur)
+      deallocate(XS%zcur)      
+   END SUBROUTINE DeallocateXSBlock
+
+!---------------------------------------------------------------------
+   SUBROUTINE Clear_XS
+!---------------------------------------------------------------------
+      XS%sig=0
+      XS%sct=0
+      XS%adf=0
+      XS%zdf=0
+      XS%cdf=0
+      XS%LPF=0
+      XS%det=0
+      XS%gff=0
+      XS%flux=0
+      XS%yldI=0
+      XS%yldXe=0
+      XS%yldPm=0
+      XS%rflx=0
+      XS%zflx=0
+      XS%rcur=0
+      XS%zcur=0           
+   END SUBROUTINE Clear_XS
+
+!---------------------------------------------------------------------
+   SUBROUTINE Default_XS
+!---------------------------------------------------------------------
+      CALL Clear_XS
+
+      XS%kinf  = 0.0
+      XS%kinfB = 1.0
+      XS%kinfL = 1.0
+      XS%B2    = 0.0
+                 
+      XS%ndxe  = 0.0
+      XS%ndsm  = 0.0
+      XS%ndi   = 0.0
+      XS%ndpm  = 0.0      
+
+      XS%adf   = 1.0
+      XS%zdf   = 1.0
+      XS%cdf   = 1.0      
+      XS%gff   = 1.0      
+
+      XS%yldi   = 0.0
+      XS%yldxe  = 0.0
+      XS%yldpm  = 0.0            
+   END SUBROUTINE Default_XS   
+END MODULE PCRDATA
diff --git a/Donjon/src/PCRDRV.f b/Donjon/src/PCRDRV.f
new file mode 100644
index 0000000..70468e2
--- /dev/null
+++ b/Donjon/src/PCRDRV.f
@@ -0,0 +1,402 @@
+*DECK PCRDRV
+      SUBROUTINE PCRDRV(LCUBIC,NMIX,IMPX,NCAL,ITER,MAXNIS,TERP,NISO,
+     1 HISO,CONC,LMIXC,XS_CALC)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute TERP factors for PMAXS file interpolation. Use user-defined
+* global and local parameters.
+*
+*Copyright:
+* Copyright (C) 2019 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* LCUBIC  =.TRUE.: cubic Ceschino interpolation; =.FALSE: linear
+*         Lagrange interpolation.
+* NMIX    maximum number of material mixtures in the microlib.
+* IMPX    print parameter (equal to zero for no print).
+* NCAL    number of elementary calculations in the PMAXS file.
+*
+*Parameters: output
+* ITER    completion flag (=0: all over; =1: use another PMAXS file;
+*         =2 use another L_MAP + PMAXS file).
+* MAXNIS  maximum value of NISO(I) in user data.
+* TERP    interpolation factors.
+* NISO    number of user-selected isotopes.
+* HISO    name of the user-selected isotopes.
+* CONC    user-defined number density of the user-selected isotopes.
+* LMIXC   flag set to .true. for fuel-map mixtures to process.
+* XS_CALC pointers towards PMAXS elementary calculations.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      USE PCRDATA
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER, PARAMETER::MAXISD=200
+      INTEGER NMIX,IMPX,NCAL,ITER,MAXNIS,NISO(NMIX),HISO(2,NMIX,MAXISD)
+      REAL TERP(NCAL,NMIX),CONC(NMIX,MAXISD)
+      LOGICAL LCUBIC,LMIXC(NMIX)
+      TYPE(XSBLOCK_ITEM) XS_CALC(NCAL)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXLIN=50
+      INTEGER, PARAMETER::MAXPAR=50
+      INTEGER, PARAMETER::MAXVAL=200
+      REAL, PARAMETER::REPS=1.0E-4
+      REAL FLOTT, SUM
+      INTEGER I0, IBM, ICAL, INDIC, IPAR, ITYPE, I, JBM, J, NCOMLI,
+     & NITMA, NPAR, IBRA, IBSET, II, IND, INDELT, NBURN, NNV
+      CHARACTER TEXT12*12,PARKEY(MAXPAR)*12,HSMG*131,COMMEN(MAXLIN)*80,
+     1 RECNAM*12,HCUBIC*12
+      INTEGER NVALUE(MAXPAR),MUPLET(MAXPAR),MUTYPE(MAXPAR)
+      DOUBLE PRECISION DFLOTT
+      REAL VALR(MAXPAR,2),VREAL(MAXVAL,MAXPAR)
+      LOGICAL LCUB2(MAXPAR)
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: MUBASE
+      LOGICAL, ALLOCATABLE, DIMENSION(:) :: LDELTA
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(LDELTA(NMIX))
+*----
+*  RECOVER TABLE-OF-CONTENT INFORMATION FOR THE PMAXS FILE. THE I-TH
+*  PMAXS FILE INFORMATION CORRESPONDS TO POINTERS bran_i and PMAX.
+*----
+      NPAR=bran_i%Nstat_var
+      NVALUE(:NPAR)=0
+      DO IPAR=1,bran_i%Nstat_var
+        PARKEY(IPAR)=bran_i%var_nam(IPAR)
+      ENDDO
+      IF(PMAX%NBset.GT.0) THEN
+        NPAR=NPAR+1
+        PARKEY(NPAR)='B'
+        NVALUE(NPAR)=PMAX%Bset(1)%NBURN
+        NNV=NVALUE(NPAR)
+        VREAL(:NNV,NPAR)=REAL(PMAX%Bset(1)%burns(:NNV))
+      ENDIF
+      IF(NPAR.GT.MAXPAR) CALL XABORT('PCRDRV: MAXPAR OVERFLOW.')
+      IF(NHST.NE.1) CALL XABORT('PCRDRV: MULTIPLE HISTORY CASE NOT IMP'
+     1 //'LEMENTED.')
+      NCOMLI=6
+      COMMEN(:6)=hcomment(:6)
+      DO IBRA=1,NBRA
+        DO IPAR=1,bran_i%Nstat_var
+          FLOTT=REAL(bran_i%state(IPAR,IBRA))
+          IF(NVALUE(IPAR).EQ.0) THEN
+            NVALUE(IPAR)=1
+            VREAL(1,IPAR)=FLOTT
+          ELSE
+            DO I=1,NVALUE(IPAR)
+              IF(FLOTT.EQ.VREAL(I,IPAR)) THEN
+                GO TO 10
+              ELSE IF(FLOTT.LT.VREAL(I,IPAR)) THEN
+                DO J=NVALUE(IPAR),I,-1
+                  VREAL(J+1,IPAR)=VREAL(J,IPAR)
+                ENDDO
+                VREAL(I,IPAR)=FLOTT
+                NVALUE(IPAR)=NVALUE(IPAR)+1
+                GO TO 10
+              ENDIF
+            ENDDO
+            IF(FLOTT.GT.VREAL(NVALUE(IPAR),IPAR)) THEN
+              NVALUE(IPAR)=NVALUE(IPAR)+1
+              VREAL(NVALUE(IPAR),IPAR)=FLOTT
+            ENDIF
+          ENDIF
+   10     CONTINUE
+        ENDDO
+      ENDDO
+      IF((IMPX.GT.0).AND.(bran_i%Nstat_var.GT.0))THEN
+        DO IPAR=1,NPAR
+          WRITE(RECNAM,'(''pval'',I8.8)') IPAR
+          WRITE(IOUT,'(13H PCRDRV: KEY=,A,18H TABULATED POINTS=,
+     1    1P,6E12.4/(43X,6E12.4))') PARKEY(IPAR),(VREAL(I,IPAR),I=1,
+     2    NVALUE(IPAR))
+        ENDDO
+      ENDIF
+*----
+*  PRINT PMAXS FILE AND FUELMAP STATISTICS
+*----
+      IF(IMPX.GT.0) THEN
+        WRITE(IOUT,'(43H PCRDRV: NUMBER OF CALCULATIONS IN PMAXS FI,
+     1  3HLE=,I6)') NCAL
+        WRITE(IOUT,'(43H PCRDRV: NUMBER OF MATERIAL MIXTURES IN FUE,
+     1  6HL MAP=,I6)') NMIX
+        WRITE(IOUT,'(43H PCRDRV: NUMBER OF LOCAL VARIABLES INCLUDIN,
+     1  9HG BURNUP=,I6)') NPAR
+        WRITE(IOUT,'(28H PCRDRV: PMAXS FILE COMMENTS,60(1H-))')
+        WRITE(IOUT,'(1X,A)') (COMMEN(I),I=1,NCOMLI)
+        WRITE(IOUT,'(9H PCRDRV: ,79(1H-))')
+      ENDIF
+*----
+*  SCAN THE PMAXS FILE INFORMATION TO RECOVER THE MUPLET DATABASE
+*----
+      IF(IMPX.GT.5) THEN
+        WRITE(IOUT,'(24H PCRDRV: MUPLET DATABASE/12H CALCULATION,4X,
+     1  6HMUPLET)')
+        WRITE(IOUT,'(16X,20A4)') PARKEY(:NPAR)
+      ENDIF
+      ALLOCATE(MUBASE(NPAR,NCAL))
+      ICAL=0
+      DO IBRA=1,NBRA
+        INDELT=0
+        DO IPAR=1,NPAR
+          IF(bran_i%state_nam(IBRA).EQ.PARKEY(IPAR)) THEN
+            INDELT=IPAR
+            CYCLE
+          ENDIF
+        ENDDO
+        IBSET=PMAX%BRANCH(IBRA,1)%IBSET
+        NBURN=PMAX%Bset(IBSET)%NBURN
+        DO IPAR=1,bran_i%Nstat_var
+          FLOTT=REAL(bran_i%state(IPAR,IBRA))
+          IND=0
+          DO I=1,NVALUE(IPAR)
+            IF(FLOTT.EQ.VREAL(I,IPAR)) THEN
+               IND=I
+               EXIT
+            ENDIF
+          ENDDO
+          IF(IND.EQ.0) THEN
+            CALL XABORT('PCRDRV: MUPLET ALGORITHM FAILURE.')
+          ELSE
+            MUPLET(IPAR)=IND
+          ENDIF
+        ENDDO
+        IF((NBURN.EQ.PMAX%Bset(1)%NBURN).OR.(NBURN.EQ.1)) THEN
+          DO I=1,NBURN
+            MUPLET(bran_i%Nstat_var+1)=I
+            II=ICAL+I
+            MUBASE(:bran_i%Nstat_var+1,II)=MUPLET(:bran_i%Nstat_var+1)
+            XS_CALC(ICAL+I)%IBURN=I
+            XS_CALC(ICAL+I)%XS=>PMAX%BRANCH(IBRA,1)%XS(I)
+            XS_CALC(ICAL+I)%TIV=>PMAX%TIVB(1)%TIV(I)
+            IF(INDELT.GT.0) THEN
+              XS_CALC(ICAL+I)%DELTA=bran_i%state(INDELT,IBRA)-
+     1        bran_i%state(INDELT,1)
+            ELSE
+              XS_CALC(ICAL+I)%DELTA=0.0
+            ENDIF
+          ENDDO
+        ELSE
+          CALL XABORT('PCRDRV: INVALID VALUE OF NBURN.')
+        ENDIF
+        IF(IMPX.GT.5) THEN
+          DO I=ICAL+1,ICAL+NBURN
+            WRITE(IOUT,'(I8,2X,A2,2X,20I4/(14X,20I4))') I,
+     1      bran_i%state_nam(IBRA),MUBASE(:NPAR,I)
+          ENDDO
+        ENDIF
+        ICAL=ICAL+NBURN
+      ENDDO !IBRA
+      IF(ICAL.NE.NCAL) CALL XABORT('PCRDRV: MUPLET ALGORITHM FAILURE.')
+*----
+*  READ (INTERP_DATA) AND SET VALR PARAMETERS CORRESPONDING TO THE
+*  INTERPOLATION POINT. FILL MUPLET FOR PARAMETERS SET WITHOUT
+*  INTERPOLATION.
+*----
+      NISO(:NMIX)=0
+      TERP(:NCAL,:NMIX)=0.0
+      LMIXC(:NMIX)=.FALSE.
+*----
+*  READ (INTERP_DATA) AND SET VALR PARAMETERS CORRESPONDING TO THE
+*  INTERPOLATION POINT. FILL MUPLET FOR PARAMETERS SET WITHOUT
+*  INTERPOLATION.
+*----
+      IBM=0
+      MAXNIS=0
+      NISO(:NMIX)=0
+      LDELTA(:NMIX)=.FALSE.
+   20 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+      IF(INDIC.NE.3) CALL XABORT('PCRDRV: CHARACTER DATA EXPECTED.')
+   30 IF(TEXT12.EQ.'MIX') THEN
+         MUPLET(:NPAR)=0
+         MUTYPE(:NPAR)=0
+         VALR(:NPAR,1)=0.0
+         VALR(:NPAR,2)=0.0
+         LCUB2(:NPAR)=LCUBIC
+         CALL REDGET(INDIC,IBM,FLOTT,TEXT12,DFLOTT)
+         IF(INDIC.NE.1) CALL XABORT('PCRDRV: INTEGER DATA EXPECTED.')
+         IF(IBM.GT.NMIX) CALL XABORT('PCRDRV: NMIX OVERFLOW.')
+         LMIXC(IBM)=.TRUE.
+         CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('PCRDRV: CHARACTER DATA EXPECTED.')
+         GO TO 30
+      ELSE IF(TEXT12.EQ.'MICRO') THEN
+         IF(IBM.EQ.0) CALL XABORT('PCRDRV: MIX NOT SET (1).')
+         CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('PCRDRV: CHARACTER DATA EXPECTED.')
+   50    IF(TEXT12.EQ.'ENDMIX') THEN
+            GO TO 30
+         ELSE
+            NISO(IBM)=NISO(IBM)+1
+            IF(NISO(IBM).GT.MAXISD) CALL XABORT('PCRDRV: MAXISD OVERFL'
+     1      //'OW.')
+            MAXNIS=MAX(MAXNIS,NISO(IBM))
+            READ(TEXT12,'(2A4)') (HISO(I0,IBM,NISO(IBM)),I0=1,2)
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+            IF(INDIC.EQ.2) THEN
+               CONC(IBM,NISO(IBM))=FLOTT
+            ELSE
+               CALL XABORT('PCRDRV: INVALID HISO DATA.')
+            ENDIF
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+            IF(INDIC.NE.3) CALL XABORT('PCRDRV: CHARACTER DATA EXPECTE'
+     1      //'D.')
+            GO TO 50
+         ENDIF
+      ELSE IF((TEXT12.EQ.'SET').OR.(TEXT12.EQ.'DELTA')) THEN
+         IF(IBM.EQ.0) CALL XABORT('PCRDRV: MIX NOT SET (2).')
+         ITYPE=0
+         IF(TEXT12.EQ.'SET') THEN
+            ITYPE=1
+         ELSE IF(TEXT12.EQ.'DELTA') THEN
+            ITYPE=2
+            LDELTA(IBM)=.TRUE.
+         ENDIF
+         CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('PCRDRV: CHARACTER DATA EXPECTED.')
+         IF((TEXT12.EQ.'LINEAR').OR.(TEXT12.EQ.'CUBIC')) THEN
+            HCUBIC=TEXT12
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+         ELSE
+            HCUBIC=' '
+         ENDIF
+         IF(INDIC.NE.3) CALL XABORT('PCRDRV: CHARACTER DATA EXPECTED.')
+         DO 60 I=1,NPAR
+         IF(TEXT12.EQ.PARKEY(I)) THEN
+            IPAR=I
+            GO TO 70
+         ENDIF
+   60    CONTINUE
+         CALL XABORT('PCRDRV: PARAMETER '//TEXT12//' NOT FOUND.')
+   70    IF(HCUBIC.EQ.'LINEAR') THEN
+            LCUB2(IPAR)=.FALSE.
+         ELSE IF(HCUBIC.EQ.'CUBIC') THEN
+            LCUB2(IPAR)=.TRUE.
+         ENDIF
+         CALL REDGET(INDIC,NITMA,VALR(IPAR,1),TEXT12,DFLOTT)
+         IF(INDIC.NE.2) CALL XABORT('PCRDRV: REAL DATA EXPECTED.')
+         VALR(IPAR,2)=VALR(IPAR,1)
+         CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+         IF(INDIC.EQ.2) THEN
+            VALR(IPAR,2)=FLOTT
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+         ENDIF
+         IF(VALR(IPAR,1).EQ.VALR(IPAR,2)) THEN
+            DO 80 J=1,NVALUE(IPAR)
+            IF(ABS(VALR(IPAR,1)-VREAL(J,IPAR)).LE.REPS*
+     1      ABS(VREAL(J,IPAR)))THEN
+               MUPLET(IPAR)=J
+               IF(ITYPE.NE.1) MUPLET(IPAR)=-1
+               MUTYPE(IPAR)=ITYPE
+               GO TO 30
+            ENDIF
+   80       CONTINUE
+         ENDIF
+         IF(VALR(IPAR,1).LT.VREAL(1,IPAR)) THEN
+            WRITE(HSMG,'(23HPCRDRV: REAL PARAMETER ,A,10H WITH VALU,
+     1      1HE,1P,E12.4,25H IS OUTSIDE THE DOMAIN (<,E12.4,1H))')
+     2      PARKEY(IPAR),VALR(IPAR,1),VREAL(1,IPAR)
+            CALL XABORT(HSMG)
+         ELSE IF(VALR(IPAR,2).GT.VREAL(NVALUE(IPAR),IPAR)) THEN
+            WRITE(HSMG,'(23HPCRDRV: REAL PARAMETER ,A,10H WITH VALU,
+     1      1HE,1P,E12.4,25H IS OUTSIDE THE DOMAIN (>,E12.4,1H))')
+     2      PARKEY(IPAR),VALR(IPAR,1),VREAL(NVALUE(IPAR),IPAR)
+            CALL XABORT(HSMG)
+         ELSE IF(VALR(IPAR,1).GT.VALR(IPAR,2)) THEN
+            WRITE(HSMG,'(23HPCRDRV: REAL PARAMETER ,A,9H IS DEFIN,
+     1      7HED WITH,1P,E12.4,2H >,E12.4,1H.)') PARKEY(IPAR),
+     2      VALR(IPAR,1),VALR(IPAR,2)
+            CALL XABORT(HSMG)
+         ENDIF
+         MUPLET(IPAR)=-1
+         MUTYPE(IPAR)=ITYPE
+         GO TO 30
+      ELSE IF(TEXT12.EQ.'ENDMIX') THEN
+*----
+*  COMPUTE THE TERP FACTORS USING TABLE-OF-CONTENT INFORMATION.
+*----
+         IF(IMPX.GT.0) THEN
+           DO IPAR=1,NPAR
+             IF(LCUB2(IPAR)) THEN
+               WRITE(IOUT,'(26H PCRDRV: GLOBAL PARAMETER:,A12,5H ->CU,
+     1         18HBIC INTERPOLATION.)') PARKEY(IPAR)
+             ELSE
+               WRITE(IOUT,'(26H PCRDRV: GLOBAL PARAMETER:,A12,5H ->LI,
+     1         19HNEAR INTERPOLATION.)') PARKEY(IPAR)
+             ENDIF
+           ENDDO
+         ENDIF
+         IF(IBM.GT.NMIX) CALL XABORT('PCRDRV: MIX OVERFLOW (MICROLIB).')
+         IF(NCAL.EQ.1) THEN
+           TERP(1,IBM)=1.0
+         ELSE
+           CALL PCRTRP(LCUB2,IMPX,NPAR,NCAL,NVALUE,MUPLET,MUTYPE,VALR,
+     1     0.0,MUBASE,VREAL,TERP(1,IBM))
+         ENDIF
+         IBM=0
+      ELSE IF((TEXT12.EQ.'PMAXS').OR.(TEXT12.EQ.'TABLE').OR.
+     1   (TEXT12.EQ.';')) THEN
+*----
+*  CHECK TERP FACTORS AND RETURN
+*----
+         IF(TEXT12.EQ.';') ITER=0
+         IF(TEXT12.EQ.'PMAXS') ITER=1
+         IF(TEXT12.EQ.'TABLE') ITER=2
+         DO 150 IBM=1,NMIX
+         IF(.NOT.LMIXC(IBM)) GO TO 150
+         IF(NISO(IBM).GT.MAXNIS) CALL XABORT('PCRDRV: MAXNIS OVERFLOW.')
+         IF(LDELTA(IBM)) THEN
+            SUM=0.0
+         ELSE
+            SUM=1.0
+         ENDIF
+         DO 140 ICAL=1,NCAL
+         SUM=SUM-TERP(ICAL,IBM)
+  140    CONTINUE
+         IF(ABS(SUM).GT.1.0E-4) THEN
+            WRITE(HSMG,'(43HPCRDRV: INVALID INTERPOLATION FACTORS IN MI,
+     1      5HXTURE,I4,1H.)') IBM
+            CALL XABORT(HSMG)
+         ENDIF
+  150    CONTINUE
+         GO TO 160
+      ELSE
+         CALL XABORT('PCRDRV: '//TEXT12//' IS AN INVALID KEYWORD.')
+      ENDIF
+      GO TO 20
+*----
+*  PRINT INTERPOLATION (TERP) FACTORS
+*----
+  160 IF(IMPX.GT.2) THEN
+        WRITE(IOUT,'(/30H PCRDRV: INTERPOLATION FACTORS)')
+        DO ICAL=1,NCAL
+          DO IBM=1,NMIX
+            IF(TERP(ICAL,IBM).NE.0.0) THEN
+              WRITE(IOUT,170) ICAL,(TERP(ICAL,JBM),JBM=1,NMIX)
+              EXIT
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(MUBASE,LDELTA)
+      RETURN
+  170 FORMAT(6H CALC=,I8,6H TERP=,1P,8E13.5/(20X,8E13.5))
+      END
diff --git a/Donjon/src/PCREAD.f90 b/Donjon/src/PCREAD.f90
new file mode 100644
index 0000000..db378d0
--- /dev/null
+++ b/Donjon/src/PCREAD.f90
@@ -0,0 +1,909 @@
+MODULE PCREAD
+!
+!-----------------------------------------------------------------------
+!
+!Purpose:
+! Fortran support module for PMAXS reading.
+!
+!Copyright:
+! Copyright (C) 2019 Ecole Polytechnique de Montreal
+!
+!Author(s): A. Hebert
+!
+!-----------------------------------------------------------------------
+!
+    use PCRDATA
+
+    IMPLICIT NONE
+
+    TYPE(PMAXS_WISE_TYPE),target :: PMAXO
+    CHARACTER(80), ALLOCATABLE ::PMAXS_F_name(:)
+    INTEGER(4),   ALLOCATABLE ::Bran_struct(:)
+
+    INTEGER(4) :: ntbase1,nhinc
+    TYPE(BRANCH_WISE_TYPE), DIMENSION(:,:), POINTER :: incbase !(ntbase1,nhinc)
+    INTEGER(4), DIMENSION(:), allocatable :: bset
+
+    INTEGER(4) :: n_hist_type, hist_type(Nallvar)
+
+CONTAINS
+
+!---------------------------------------------------------------------
+   SUBROUTINE AllocateBranch(Bran)
+!---------------------------------------------------------------------
+!
+    IMPLICIT NONE   
+   
+    TYPE(BRANCH_WISE_TYPE),target :: Bran
+    INTEGER(4) :: k,NBURN
+    NBURN=PMAX%Bset(Bran%ibset)%NBURN
+    allocate(Bran%XS(NBURN))
+    do k=1,NBURN
+        XS=>Bran%XS(k)
+        call AllocateXSBlock
+    enddo
+   END SUBROUTINE AllocateBranch
+
+!---------------------------------------------------------------------
+   SUBROUTINE ClearBranch(Bran)
+!---------------------------------------------------------------------
+!
+    IMPLICIT NONE   
+   
+    TYPE(BRANCH_WISE_TYPE),target :: Bran
+    INTEGER(4) :: k,NBURN
+
+    NBURN=PMAX%Bset(bran%ibset)%NBURN
+    do k=1,NBURN
+        XS=>bran%XS(k)
+        CALL Clear_XS
+    enddo
+    deallocate(Bran%XS)
+   END SUBROUTINE ClearBranch
+
+!---------------------------------------------------------------------
+   SUBROUTINE AllocateTIVB(TIVB)
+!---------------------------------------------------------------------
+!
+    IMPLICIT NONE
+   
+    TYPE(HIST_TIV_TYPE),target :: TIVB
+    INTEGER(4) :: k,NBURN
+
+    NBURN=PMAX%Bset(TIVB%ibset)%NBURN
+    allocate(TIVB%TIV(NBURN))
+    do k=1,NBURN
+       TIV=>TIVB%TIV(k)
+       if(xinv .GT. 0)then
+         allocate(TIV%sig(NGROUP,xinv))
+       else
+         allocate(TIV%sig(1,1))
+       endif
+       if(EDHL .GT. 0)then
+         allocate(TIV%kinp(EDHL))
+       else
+         allocate(TIV%kinp(1))
+      endif
+      TIV%sig=0
+      TIV%kinp=0
+      TIV%yld=0
+      TIV%power=0.0
+      TIV%days=0.0
+      TIV%burnup=0.0      
+      TIV%ndxe=0.0
+      TIV%ndsm=0.0
+      TIV%ndi =0.0
+    enddo
+   END SUBROUTINE AllocateTIVB
+
+!---------------------------------------------------------------------
+   SUBROUTINE ClearTIVB(TIVB)
+!---------------------------------------------------------------------
+!
+    IMPLICIT NONE
+   
+    TYPE(HIST_TIV_TYPE),target :: TIVB
+    INTEGER(4) :: k,NBURN
+
+    NBURN=PMAX%Bset(TIVB%ibset)%NBURN
+    do k=1,NBURN
+        TIV=>TIVB%TIV(k)
+        !deallocate(TIVB%TIV(k)%sig) ! commented for flang
+        deallocate(TIVB%TIV(k)%kinp)
+    enddo
+    deallocate(TIVB%TIV)
+   END SUBROUTINE ClearTIVB
+
+!---------------------------------------------------------------------
+   SUBROUTINE read_TIV(PMAXS_unit)
+!---------------------------------------------------------------------
+      IMPLICIT NONE
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: TIVtemp
+      INTEGER(4) :: PMAXS_unit
+      INTEGER(4) i,j,k  !,m
+      REAL(8) dump
+99    format(8E12.5)
+
+!1)   fission spectrum inverse velocity and detector xs
+        if(iXSTI .GT. 0)then
+          allocate(TIVtemp(NGROUP,4))
+          read(PMAXS_unit,99)((TIVtemp(i,j),i=1,NGROUP),j=1,iXSTI)
+          do j=1,iXSTI
+             k=iTIV(j)
+             if(k .GT. 0)then
+                do i=1,NGROUP
+                   TIV%sig(i,k)=TIVtemp(i,j)
+                enddo
+             endif
+          enddo
+          deallocate(TIVtemp)
+       endif
+!2)   yiled
+    if(pyld)then
+       if(lyld)then
+          read(PMAXS_unit,99)TIV%YLD(:)
+       else
+          read(PMAXS_unit,99)
+       endif
+    endif
+
+!cdf
+       IF(tcdf)THEN
+          READ(PMAXS_unit,99)((dump,i=1,NGROUP),j=1,NCD)
+       ENDIF
+! gff
+       if(tgff.and.NRODS .GT. 0)then
+             read(PMAXS_unit,99)((dump,i=1,NGROUP),j=1,NRODS)
+       endif
+
+!3)   BETA of Delayed neutron data
+    if(pbet)then
+        if(lbet)then
+           read(PMAXS_unit,99)TIV%kinp(BBET:EBET)
+        else
+           read(PMAXS_unit,99)(dump,i=1,NDLAY)
+        endif
+     endif
+!4)lambda of Delayed neutron data
+    if(pamb)then
+        if(lamb)then
+           read(PMAXS_unit,99)TIV%kinp(BLAM:ELAM)
+        else
+           read(PMAXS_unit,99)(dump,i=1,NDLAY)
+        endif
+     endif
+!5)   Decay heat data
+    if(pdec)then
+        if(ldec)then
+              read(PMAXS_unit,99)TIV%kinp(BDHB:EDHB)
+              read(PMAXS_unit,99)TIV%kinp(BDHL:EDHL)
+        else
+          read(PMAXS_unit,99)(dump,i=1,NDCAY)
+          read(PMAXS_unit,99)(dump,i=1,NDCAY)
+        endif
+     endif
+     return
+   END SUBROUTINE read_TIV
+
+!---------------------------------------------------------------------
+   SUBROUTINE read_XS_Block(PMAXS_unit)
+!---------------------------------------------------------------------
+       IMPLICIT NONE
+       INTEGER(4) :: PMAXS_unit
+       REAL(8) LPFtemp(8)
+       REAL(8) dump
+       INTEGER(4) i,j  !,k
+       read(PMAXS_unit,99)((XS%sig(i,j),i=1,NGROUP),j=1,4)
+
+       if(pxes)then
+          if(pdet)then
+             if(lxes)then
+                if(ldet)then
+                   read(PMAXS_unit,99)((XS%sig(i,j),i=1,NGROUP),j=5,7),XS%det
+                else
+                   read(PMAXS_unit,99)((XS%sig(i,j),i=1,NGROUP),j=5,7),(dump,i=1,NGROUP)
+                endif
+             else
+                if(ldet)then
+                   read(PMAXS_unit,99)((dump,i=1,NGROUP),j=1,3),XS%det
+                else
+                   read(PMAXS_unit,99)((dump,i=1,NGROUP),j=1,4)
+                endif
+             endif
+          else
+             if(lxes)then
+                   read(PMAXS_unit,99)((XS%sig(i,j),i=1,NGROUP),j=5,7)
+                   XS%sig(1,5) = XS%sig(1,5) * 1E24
+                   XS%sig(2,5) = XS%sig(2,5) * 1E24
+                   XS%sig(1,6) = XS%sig(1,6) * 1E24
+                   XS%sig(2,6) = XS%sig(2,6) * 1E24
+             else
+                   read(PMAXS_unit,99)((dump,i=1,NGROUP),j=1,3)
+             endif
+          endif
+       else
+          if(pdet)then
+                if(ldet)then
+                   read(PMAXS_unit,99)XS%det
+                else
+                   read(PMAXS_unit,99)(dump,i=1,NGROUP)
+                endif
+          endif
+       endif
+! sct (scattering cross sections)
+       read(PMAXS_unit,99)XS%sct
+! adf
+            IF(padf)THEN
+               IF(ladf)THEN
+                  READ(PMAXS_unit,99)((XS%adf(i,j),i=1,NGROUP),j=1,NAD)
+                  if(NAD .LT. NADF)then
+                     if(NAD .EQ. 1)then
+                        do i=1,NGROUP
+                            XS%adf(i,:)=XS%adf(i,1)
+                        enddo
+                     elseif(NAD .EQ. 2)then
+                        if(NADF .EQ. 3) then
+                           call XABORT('read_XS_Block: Error - Please Use Same NADF In All PMAXS Files')
+                        elseif(NADF .EQ. 4)then
+                            do i=1,NGROUP
+                               XS%adf(i,3)=XS%adf(i,2)
+                               XS%adf(i,4)=XS%adf(i,1)
+                            enddo
+                        else
+                            do i=1,NGROUP
+                               XS%adf(i,3)=XS%adf(i,1)
+                               XS%adf(i,4)=XS%adf(i,2)
+                               XS%adf(i,5)=XS%adf(i,1)
+                               XS%adf(i,6)=XS%adf(i,2)
+                            enddo
+                        endif
+                     else
+                            do i=1,NGROUP
+                               XS%adf(i,4)=XS%adf(i,1)
+                               XS%adf(i,5)=XS%adf(i,2)
+                               XS%adf(i,6)=XS%adf(i,3)
+                            enddo
+                     endif
+                  endif
+               ELSE
+                  READ(PMAXS_unit,99)((dump,i=1,NGROUP),j=1,NAD)
+               ENDIF
+            ENDIF
+! lpf
+  99   format(8e12.5)
+       if(iLPF .GT. 0)then
+          read(PMAXS_unit,99)(LPFtemp(j),j=1,iLPF)
+          if(pded.and.lded)XS%LPF(1:4)=LPFtemp(1:4)
+          if(pj1f.and.lj1f)XS%LPF(xlpk:xj1c)=LPFtemp(ilpk:ij1c)
+       endif
+! cdf
+            IF(pcdf)THEN
+               IF(lcdf)THEN
+                  READ(PMAXS_unit,99)((XS%cdf(i,j),i=1,NGROUP),j=1,NCD)
+                  if(NCD .LT. NCDF)then
+                     if(NCD .EQ. 1)then
+                        do i=1,NGROUP
+                            XS%cdf(i,:)=XS%cdf(i,1)
+                        enddo
+                     elseif(NCD .EQ. 2)then
+                               if(NCDF .EQ. 5)then
+                                  do i=1,NGROUP
+                                     XS%cdf(i,5)=XS%cdf(i,2)
+                                     XS%cdf(i,4)=XS%cdf(i,2)
+                                     XS%cdf(i,3)=XS%cdf(i,1)
+                                     XS%cdf(i,2)=XS%cdf(i,1)
+                                  enddo
+                               elseif(NCDF .EQ. 6)then
+                                  do i=1,NGROUP
+                                     XS%cdf(i,3)=XS%cdf(i,1)
+                                     XS%cdf(i,4)=XS%cdf(i,2)
+                                     XS%cdf(i,5)=XS%cdf(i,1)
+                                     XS%cdf(i,6)=XS%cdf(i,2)
+                                  enddo
+                               elseif(NCDF .EQ. 8)then
+                                  do i=1,NGROUP
+                                     XS%cdf(i,8)=XS%cdf(i,2)
+                                     XS%cdf(i,7)=XS%cdf(i,2)
+                                     XS%cdf(i,6)=XS%cdf(i,2)
+                                     XS%cdf(i,5)=XS%cdf(i,2)
+                                     XS%cdf(i,4)=XS%cdf(i,1)
+                                     XS%cdf(i,3)=XS%cdf(i,1)
+                                     XS%cdf(i,2)=XS%cdf(i,1)
+                                  enddo
+                               else
+                                  call XABORT('read_XS_Block: Error - Please Use Same NCDF In All PMAXS Files')
+                               endif
+                     elseif(NCD .EQ. 3)then
+                               if(NCDF .EQ. 4)then
+                                  do i=1,NGROUP
+                                     XS%cdf(i,4)=XS%cdf(i,2)
+                                  enddo
+                               elseif(NCDF .EQ. 5)then
+                                  do i=1,NGROUP
+                                     XS%cdf(i,4)=XS%adf(i,1)
+                                     XS%cdf(i,5)=XS%adf(i,2)
+                                  enddo
+                               elseif(NCDF .EQ. 6)then
+                                  do i=1,NGROUP
+                                     XS%cdf(i,4)=XS%cdf(i,1)
+                                     XS%cdf(i,5)=XS%cdf(i,2)
+                                     XS%cdf(i,6)=XS%cdf(i,3)
+                                  enddo
+                               elseif(NCDF .EQ. 8)then
+                                  do i=1,NGROUP
+                                     XS%cdf(i,4)=XS%cdf(i,2)
+                                     XS%cdf(i,5)=XS%adf(i,1)
+                                     XS%cdf(i,6)=XS%adf(i,2)
+                                     XS%cdf(i,7)=XS%adf(i,2)
+                                     XS%cdf(i,8)=XS%adf(i,1)
+                                  enddo
+                               endif
+                     elseif(NCD .EQ. 4)then
+                              if(NCDF .EQ. 8)then
+                                  do i=1,NGROUP
+                                     XS%cdf(i,5)=XS%adf(i,1)
+                                     XS%cdf(i,6)=XS%adf(i,2)
+                                     XS%cdf(i,7)=XS%adf(i,3)
+                                     XS%cdf(i,8)=XS%adf(i,4)
+                                  enddo
+                              else
+                                  call XABORT('read_XS_Block: Error - Please Use Same NCDF In All PMAXS Files')
+                              endif
+                     elseif(NCD .EQ. 5)then
+                                  do i=1,NGROUP
+                                     XS%cdf(i,8)=XS%cdf(i,4)
+                                     XS%cdf(i,7)=XS%cdf(i,5)
+                                     XS%cdf(i,6)=XS%cdf(i,5)
+                                     XS%cdf(i,5)=XS%cdf(i,4)
+                                     XS%cdf(i,4)=XS%cdf(i,2)
+                                  enddo
+                     else
+                                  call XABORT('read_XS_Block: Please use same NCDF in all PMAXS files')
+                     endif
+                  endif
+               ELSE
+                  READ(PMAXS_unit,99)((dump,i=1,NGROUP),j=1,NCD)
+               ENDIF
+            ENDIF
+! gff
+       if(pgff.and.NRODS .GT. 0)then
+          if(lgff)then
+             read(PMAXS_unit,99)XS%gff
+          else
+             read(PMAXS_unit,99)((dump,i=1,NGROUP),j=1,NRODS)
+          endif
+       endif
+       return
+   END SUBROUTINE read_XS_Block
+
+!---------------------------------------------------------------------
+   SUBROUTINE det_var_position
+!---------------------------------------------------------------------
+!          determine variable position in input PMAXS file
+         
+         IMPLICIT NONE
+         
+         INTEGER(4) i  !, i_pri,i_adf,i_lpf
+! XS block
+! LPF
+         if(pded)then
+            i=4
+         else
+            i=0
+         endif
+         if(pj1f)then
+            ilpk=i+1
+            ij1c=i+4
+            iLPF=ij1c
+         else
+            iLPF=i
+         endif
+
+! TIV block
+         if(pchi)then
+            i=1
+            iTIV(i)=xchi
+         else
+            i=0
+         endif
+         if(pchd)then
+            i=i+1
+            iTIV(i)=xchd
+         endif
+         if(pvel)then
+            i=i+1
+            iTIV(i)=xinv
+         endif
+         iXSTI=i
+   END SUBROUTINE det_var_position
+
+!---------------------------------------------------------------------
+   SUBROUTINE set_var_position
+!---------------------------------------------------------------------
+!          set variable position in memory and output PMAXS
+         
+         IMPLICIT NONE
+         INTEGER(4) :: i
+         formng='(1P008E12.5)'
+         if(NGROUP .GT. 4)then
+            write(formng(4:6),'(I3.3)')NGROUP
+         elseif(NGROUP .EQ. 3)then
+            formng='(1P006E12.5)'
+         endif
+
+         if(NADF .EQ. 0)ladf=.false.
+         if(NCDF .EQ. 0)lcdf=.false.
+         if(NRODS .EQ. 0)lgff=.false.
+
+!    ded
+         if(lded)then
+            i=4
+         else
+            i=0
+         endif
+         if(lj1f)then
+            xlpk=i+1
+            xj1i=i+2
+            xj1s=i+3
+            xj1c=i+4
+            NLPF=xj1c
+         else
+            NLPF=i
+         endif
+
+! TIV block
+         if(lchi)then
+            i=1
+             TIVname(i)='Chi'
+         else
+            i=0
+         endif
+         if(lchd)then
+            i=i+1
+            TIVname(i)='Chd'
+         endif
+         xchd=i
+         if(linv)then
+            i=i+1
+            TIVname(i)='inV'
+         endif
+         xinv=i
+
+! beta and lambda
+         EBET=NDLAY
+         BLAM=EBET+1
+         ELAM=EBET+NDLAY
+! decay heat
+         BDHB=ELAM+1
+         EDHB=ELAM+NDCAY
+         BDHL=EDHB+1
+         EDHL=EDHB+NDCAY
+
+! format
+         formng='(1P008E12.5)'
+         if(NGROUP .GT. 4)then
+             write(formng(4:6),'(I3.3)')NGROUP
+         elseif(NGROUP .EQ. 3)then
+             formng='(1P006E12.5)'
+         endif
+   END SUBROUTINE set_var_position
+
+!---------------------------------------------------------------------
+   SUBROUTINE read_PMAXS_file(iPMAX,kread,PMAXS_unit)
+!---------------------------------------------------------------------
+      use PCRDATA
+
+      IMPLICIT NONE
+
+      INTEGER(4) :: iPMAX,kread,PMAXS_unit
+      INTEGER(4) :: itemp,i_s
+      CHARACTER(8) :: tit
+      CHARACTER(80) :: oneline
+
+      read(PMAXS_unit,'(A80)',end=101)oneline
+      if(oneline(1:8).NE.'GLOBAL_V') call XABORT('dep_read_pmaxs_file: GLOBAL_V expected.')
+!1) global variables
+      if(oneline(64:64).eq.' ')then
+         read(oneline,*)tit,NHST,NGR,NDL,NDC,NAD,NCD,NRODS,NCOLA, &
+            padf,pxes,pded,pj1f,pchi,pchd,pvel,pdet,pyld,pcdf,pgff,pbet,pamb,pdec
+            derivatives=.true.
+            pzdf = .FALSE.
+      else if(oneline(66:66).eq.' ')then
+         read(oneline,*)tit,NHST,NGR,NDL,NDC,NAD,NCD,NRODS,NCOLA, &
+            padf,pxes,pded,pj1f,pchi,pchd,pvel,pdet,pyld,pcdf,pgff,pbet,pamb,pdec,derivatives
+            pzdf = .FALSE.
+      else
+         read(oneline,*)tit,NHST,NGR,NDL,NDC,NAD,NCD,NRODS,NCOLA, &
+            padf,pxes,pded,pj1f,pchi,pchd,pvel,pdet,pyld,pcdf,pgff,pbet,pamb,pdec,pzdf,derivatives
+      endif
+      if(kread.LE.0)THEN
+        if(kread .EQ. -1)THEN
+          NGROUP=NGR
+          NDLAY =NDL
+          NDCAY =NDC
+          NADF  =NAD
+          NCDF  =NCD
+          MHST  =NHST
+          MRODS =NRODS
+          MCOLA =NCOLA
+          if(MCOLA .LT. NROWA)MCOLA=NROWA
+          MBset=1
+          MBRA=1
+          MBCR=0
+        else
+          if(NGROUP.NE.NGR) then
+            call XABORT('read_PMAXS_file: Error - NGROUP must be the same in all PMAXS files')
+          endif
+          if( NDLAY.NE.NDL)THEN
+            if(NDLAY .EQ. 0)THEN
+              NDLAY=NDL
+            ELSEif(NDL .GT. 0 .AND. pbet .AND. pamb)THEN
+              call XABORT('read_PMAXS_file: Error - NDLAY must be the same in all PMAXS files')
+            ENDIF
+          endif
+          if( NDCAY.NE.NDC)THEN
+            if(NDCAY .EQ. 0)THEN
+               NDCAY=NDC
+            elseif(NDC .GT. 0 .AND. pdec)THEN
+              call XABORT('read_PMAXS_file: Error - NDCAY must be same in all PMAXS files')
+            endif
+          endif
+          if(  NADF .LT. NAD)NADF=NAD
+          if(  NCDF .LT. NCD)NCDF=NCD
+          if( MHST   .LT. NHST ) MHST  =NHST
+          if( MRODS  .LT. NRODS) MRODS =NRODS
+          if( MCOLA  .LT. NCOLA) MCOLA =NCOLA
+          if( MCOLA  .LT. NROWA) MCOLA =NROWA
+        endif
+      endif
+      call set_var_position
+
+      read(PMAXS_unit,'(A80)') hcomment(1)
+      read(PMAXS_unit,'(A80)') hcomment(2)
+      read(PMAXS_unit,'(A80)') hcomment(3)
+      lxes=.false.
+      NXST=4
+      if(INDEX(hcomment(3),"xe,sm" ) /= 0) THEN
+        lxes=.true.
+        NXST=7
+      endif
+      if(INDEX(hcomment(3),"det" ) /= 0) THEN
+        lxes=.true.
+        NXST=8
+      endif
+      tcdf=.false.
+      tgff=.false.
+      if(pcdf)then
+         if(INDEX(hcomment(3),"CDF" ) /= 0) THEN
+           tcdf=.true.
+           pcdf=.false.
+         ENDIF
+      endif
+      if(pgff)then
+         if(INDEX(hcomment(3),"GFF" ) /= 0) THEN
+           tgff=.true.
+           pgff=.false.
+         ENDIF
+      endif
+      read(PMAXS_unit,'(A80)') hcomment(4)
+      read(PMAXS_unit,'(A80)') hcomment(5)
+      read(PMAXS_unit,'(A80)') hcomment(6)
+
+      call read_pmax_head(iPMAX, PMAXS_unit)
+!4) XS Set identification
+      do
+         read(PMAXS_unit,*,end=101)tit
+         if(tit .EQ. 'XS_SET')exit
+      enddo
+
+      backspace(PMAXS_unit)
+      read(PMAXS_unit,*)tit,itemp,i_s,itemp,itemp,NCOLA,NROWA,NPART,PITCH,XBE,YBE,iHMD,Dsat,ARWatR,ARByPa,ARConR
+
+      CALL test_pinpower
+
+      call AllocatePMAXS
+      call DEP_read_main(PMAXS_unit)
+      return
+      101 call XABORT('read_PMAXS_file: Error - Reached The End Of PMAXS File')
+   END SUBROUTINE read_PMAXS_file
+
+!---------------------------------------------------------------------
+   SUBROUTINE test_pinpower 
+!---------------------------------------------------------------------
+     IMPLICIT NONE
+
+     computed_part: SELECT CASE (NPART)
+     CASE (0)
+         NCOL=NCOLA
+         NROW=NROWA
+         NRODS=NCOL*NROW
+     CASE (1)
+         NCOL=NCOLA
+         NROW=NROWA
+         if(NCOL.ne.NROW) THEN
+            call XABORT('test_pinpower: Error - Assembly Must Be Square For NPART=1')
+         END IF
+         NRODS=NCOL*(NCOL+1)/2
+     CASE (2)
+         NCOL=(NCOLA+1)/2
+         NROW=(NROWA+1)/2
+         NRODS=NCOL*NROW
+     CASE (3)
+         NCOL=(NCOLA+1)/2
+         NROW=(NROWA+1)/2
+         if(NCOL.ne.NROW) THEN
+            call XABORT('test_pinpower: Error - Assembly Must Be Square For NPART=3')
+         END IF
+         NRODS=NCOL*(NCOL+1)/2
+     END SELECT computed_part
+   END SUBROUTINE test_pinpower
+
+!---------------------------------------------------------------------
+   SUBROUTINE read_pmax_head(iPMAX, PMAXS_unit)
+!---------------------------------------------------------------------
+     use PCRDATA
+     IMPLICIT NONE
+     INTEGER(4) :: iPMAX, PMAXS_unit
+     INTEGER(4) :: i,ibra,itemp,inb,j
+     CHARACTER(8) :: tit
+
+     if(NDL .EQ. 0)then
+       pbet=.false.
+       pamb=.false.
+     endif
+     if(NDC .EQ. 0)pdec=.false.
+     if(NAD .EQ. 0)padf=.false.
+     if(NCD .EQ. 0)pcdf=.false.
+     if(NRODS .EQ. 0)pgff=.false.
+
+     call det_var_position
+
+     bran_i=>Bran_info(iPMAX)
+     if(bran_i%NOT_assigned)then
+       bran_i%NOT_assigned=.false.
+!2) States data
+       do
+          read(PMAXS_unit,*,end=101)tit
+          if(tit .EQ. 'STA_VAR') then
+             backspace(PMAXS_unit)
+             read(PMAXS_unit,*)tit,Nstat_var
+             bran_i%Nstat_var=Nstat_var
+             allocate(bran_i%var_ind(Nstat_var),bran_i%var_nam(Nstat_var))
+             var_ind=>bran_i%var_ind
+             backspace(PMAXS_unit)
+             read(PMAXS_unit,*)tit,Nstat_var,bran_i%var_nam(1:Nstat_var)
+             ktf=0
+             inb=1
+             do i=1,Nstat_var
+                validname=.false.
+                do j=inb,Nallvar
+                     if(bran_i%var_nam(i).eq.all_var_nam(j))then
+                      validname=.true.
+                      var_ind(i)=j
+                      inb=j+1
+                      exit
+                      endif
+                enddo
+                if(validname)then
+                   if(inb .EQ. 5)ktf=i
+                else
+                   call XABORT('read_pmax_head: Error - State Variable Name Invalid')
+                endif
+             enddo
+             exit
+          endif
+          if(tit .EQ. 'BRANCHES'.or.tit .EQ. 'BURNUPS'.or.tit .EQ. 'XS_SET') then
+             backspace(PMAXS_unit)
+             Nstat_var=5
+             bran_i%Nstat_var=Nstat_var
+             allocate(bran_i%var_ind(Nstat_var),bran_i%var_nam(Nstat_var))
+             var_ind=>bran_i%var_ind
+             ktf=4
+             do i=1,Nstat_var
+                var_ind(i)=i
+                bran_i%var_nam(i)=all_var_nam(i)
+             enddo
+             exit
+          endif
+       enddo
+
+!2) States data
+       allocate(bran_i%NBR(Nstat_var))
+       NBR=>bran_i%NBR
+       NBRA=1
+       do
+          read(PMAXS_unit,*,end=101)tit
+          if(tit .EQ. 'BRANCHES') then
+             backspace(PMAXS_unit)
+             read(PMAXS_unit,*)tit,itemp,NBR
+             do i=1,Nstat_var
+                NBRA=NBRA+NBR(i)
+             enddo
+             allocate(bran_i%state(Nstat_var,NBRA),bran_i%state_nam(NBRA))
+             if(NBRA .GT. 1)then
+                state=>bran_i%state
+                 if(ktf .GT. 0)then
+                   do ibra=1,NBRA
+                      read(PMAXS_unit,*,end=101)bran_i%state_nam(ibra),itemp,state(:,ibra)
+                      state(ktf,ibra)=dsqrt(state(ktf,ibra))
+                   enddo
+                else
+                   do ibra=1,NBRA
+                      read(PMAXS_unit,*,end=101)bran_i%state_nam(ibra),itemp,state(:,ibra)
+                   enddo
+                endif
+             else
+                bran_i%state=0
+             endif
+             exit
+          endif
+          if(tit .EQ. 'BURNUPS'.or.tit .EQ. 'XS_SET')   then
+             backspace(PMAXS_unit)
+             allocate(bran_i%state(Nstat_var,NBRA))
+             bran_i%state=0
+             NBR=0
+             exit
+          endif
+       enddo
+       bran_i%NBRA=NBRA
+       bran_i%ktf=ktf
+       if(MBRA .LT. NBRA)MBRA=NBRA
+       if(var_ind(1) .EQ. 1)then
+          if(MBCR .LT. NBR(1))MBCR=NBR(1)
+       endif
+     else
+       Nstat_var=bran_i%Nstat_var
+       NBRA=bran_i%NBRA
+       ktf=bran_i%ktf
+     endif
+
+!3) Burnup  information
+     do
+        read(PMAXS_unit,*,end=101)tit
+        if(tit .EQ. 'BURNUPS') then
+            backspace(PMAXS_unit)
+            read(PMAXS_unit,*)tit,PMAX%NBset
+            if(MBset .LT. PMAX%NBset)MBset=PMAX%NBset
+            allocate(PMAX%Bset(PMAX%NBset))
+            do i=1,PMAX%NBset
+                read(PMAXS_unit,*)itemp,itemp
+                allocate(PMAX%Bset(i)%burns(itemp))
+                backspace(PMAXS_unit)
+                read(PMAXS_unit,*)itemp,PMAX%Bset(i)%NBURN,PMAX%Bset(i)%burns
+            enddo
+            exit
+        endif
+        if(tit .EQ. 'XS_SET')   then
+            backspace(PMAXS_unit)
+            PMAX%NBset=1
+            allocate(PMAX%Bset(PMAX%NBset))
+            allocate(PMAX%Bset(1)%burns(1))
+            PMAX%Bset(1)%NBURN=1
+            PMAX%Bset(1)%burns(1)=0
+            exit
+        endif
+     enddo
+     return
+     101  call XABORT('read_pmax_head: Error - Reached The End Of PMAXS File')
+     STOP
+   END SUBROUTINE read_pmax_head
+
+!---------------------------------------------------------------------
+   SUBROUTINE DEP_read_main(PMAXS_unit)
+!---------------------------------------------------------------------
+     use PCRDATA
+     IMPLICIT NONE
+     INTEGER(4) :: PMAXS_unit
+     INTEGER(4) :: i,ihst,ibra,itemp,iBset,NBURN
+     CHARACTER(4) :: tit4
+     CHARACTER(8) :: tit
+!     History case wise data
+     do ihst=1,NHST
+!6) History case identification
+       do
+         read(PMAXS_unit,*,end=101)tit
+         if(tit .EQ. 'HST_CASE')then
+            backspace(PMAXS_unit)
+            read(PMAXS_unit,*)tit,PMAX%history(:,ihst)
+            PMAX%TIVB(ihst)%ibset=1
+            exit
+         endif
+         if(tit .EQ. 'HISTORYC')then
+            backspace(PMAXS_unit)
+            read(PMAXS_unit,*)tit,PMAX%TIVB(ihst)%ibset,PMAX%history(:,ihst)
+            exit
+         endif
+       enddo
+       if(ktf .GT. 0)PMAX%history(ktf,ihst)=sqrt(PMAX%history(ktf,ihst))
+       call AllocateTIVB(PMAX%TIVB(ihst))
+       NBURN=PMAX%Bset(PMAX%TIVB(ihst)%ibset)%NBURN
+       do i=1,NBURN
+         TIV=>PMAX%TIVB(ihst)%TIV(i)
+         call read_TIV(PMAXS_unit)
+       enddo
+!branch wise data
+!7) State identification      Always
+       do ibra=1,NBRA
+         read(PMAXS_unit,'(A4,2I4)')tit4,itemp,iBset
+         PMAX%branch(ibra,ihst)%iBset=iBset
+         NBURN=PMAX%bset(iBset)%NBURN
+         call read_branches(NBURN,PMAXS_unit,PMAX%branch(ibra,ihst))
+       enddo !ibra
+     enddo !ihst
+     return
+     101  call XABORT('DEP_read_main: Error - Reached The End Of PMAXS File')
+   END SUBROUTINE DEP_read_main
+
+!------------------------------------------------------------------
+   SUBROUTINE read_branches(NBURN,PMAXS_unit,bran)
+!------------------------------------------------------------------
+       TYPE(BRANCH_WISE_TYPE) :: bran
+       INTEGER(4) :: NBURN,PMAXS_unit,iburn
+       call AllocateBranch(bran)
+       do iburn=1,NBURN
+          XS=>bran%XS(iburn)
+          call read_XS_Block(PMAXS_unit)
+       enddo
+   END SUBROUTINE read_branches
+
+!---------------------------------------------------------------------
+   SUBROUTINE AllocatePMAXS
+!---------------------------------------------------------------------
+!
+      PMAX%NCOL=NCOL
+      PMAX%NRODS=NRODS
+      PMAX%NHST=NHST
+      PMAX%NROW=NROW
+      PMAX%NPART=NROW
+      PMAX%NROWA=NROWA
+      PMAX%NCOLA=NCOLA
+      PMAX%iHMD=iHMD
+      PMAX%Dsat=Dsat
+      PMAX%ARWatR=ARWatR
+      PMAX%ARByPa=ARByPa
+      PMAX%ARConR=ARConR
+      PMAX%PITCH=PITCH
+      PMAX%XBE=XBE
+      PMAX%YBE=YBE
+      PMAX%derivatives=derivatives
+      allocate(PMAX%TIVB(NHST))
+      allocate(PMAX%branch(NBRA,NHST))
+      allocate(PMAX%history(Nstat_var,NHST))
+      allocate(PMAX%base(NHST))
+      allocate(PMAX%invdiff(NHST))
+   END SUBROUTINE AllocatePMAXS
+
+!---------------------------------------------------------------------
+   SUBROUTINE Clear_PMAXS_file(iPMAX)
+!---------------------------------------------------------------------
+      use PCRDATA
+      IMPLICIT NONE
+      INTEGER(4) :: iPMAX, i, ihst, ibra
+      bran_i=>Bran_info(iPMAX)
+      if(Nstat_var > 0) then
+         deallocate(bran_i%var_ind,bran_i%var_nam,bran_i%NBR)
+         if(NBRA.GT.0) deallocate(bran_i%state,bran_i%state_nam)
+      endif
+      do ihst=1,NHST
+            print *,'Clear_PMAX_file: call ClearTIVB ihst=',ihst
+        call ClearTIVB(PMAX%TIVB(ihst))
+        do ibra=1,NBRA
+          call ClearBranch(PMAX%branch(ibra,ihst))
+        enddo !ibra
+      enddo
+      if(PMAX%NBset > 0) then
+         do i=1,PMAX%NBset
+            deallocate(PMAX%Bset(i)%burns)
+         enddo
+         deallocate(PMAX%Bset)
+      endif
+      if(NHST > 0) then
+        deallocate(PMAX%TIVB)
+        if(NBRA.GT.0) deallocate(PMAX%branch)
+        if(Nstat_var > 0) deallocate(PMAX%history)
+        deallocate(PMAX%base)
+        deallocate(PMAX%invdiff)
+      endif
+      return
+   END SUBROUTINE Clear_PMAXS_file
+END MODULE PCREAD
diff --git a/Donjon/src/PCREIR.f b/Donjon/src/PCREIR.f
new file mode 100644
index 0000000..514ae20
--- /dev/null
+++ b/Donjon/src/PCREIR.f
@@ -0,0 +1,211 @@
+*DECK PCREIR
+      SUBROUTINE PCREIR(NMDEPL,MD2,NEL,ITNAM,ITZEA,KPAX,BPAX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Read depletion data on input file. Based on LIBEIR.f routine in
+* DRAGON.
+*
+*Copyright:
+* Copyright (C) 2020 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version.
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* NMDEPL  names of reactions:
+*           NMDEPL(1)='DECAY'; NMDEPL(2)='NFTOT';
+*           NMDEPL(3)='NG'   ; NMDEPL(4)='N2N';
+*           etc
+* MD2     dimension of arrays ITNAM, ITZEA, KPAX and BPAX
+*
+*Parameters: output
+* NEL     number of particularized isotopes including macro
+* ITNAM   reactive isotope names in chain
+* ITZEA   6-digit nuclide identifier
+*         atomic number z*10000 (digits) + mass number a*10 +
+*         energy state (0 = ground state, 1 = first state, etc.)
+* KPAX    complete reaction type matrix
+* BPAX    complete branching ratio matrix
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  INPUT FORMAT
+*----
+*    CHAIN
+*    [[ hnamson [ izea ]
+*      [ [[ { DECAY    constant |
+*            reaction [energy] } ]]  ]
+*    [ { STABLE |
+*       FROM  [[ { DECAY | reaction }
+*          [[ yield hnampar ]] ]] } ]
+*    ]]
+*    ENDCHAIN
+*
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER, PARAMETER::MAXR=12
+      INTEGER MD2,NEL,ITNAM(3,MD2),ITZEA(MD2),KPAX(MD2+MAXR,MD2)
+      CHARACTER NMDEPL(MAXR)*8
+      REAL BPAX(MD2+MAXR,MD2)
+*----
+*  INPUT FILE PARAMETERS
+*----
+      CHARACTER TEXT12*12
+      INTEGER KNADPL(2)
+      DOUBLE PRECISION DBLINP
+*----
+*  INTERNAL PARAMETERS
+*   KFISSP : FISSION PRODUCT FLAG = 2 (POSITION OF NFTOT IN NMDEPL)
+*----
+      INTEGER KFISSP
+      PARAMETER (KFISSP=2)
+      INTEGER INDIC,NITMA,IEL,JEL,IDEPL,INTG,IREAC,ISOT,JREL,JDEPL
+      REAL FLOTT,RRAT
+*
+      NEL=0
+      CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP)
+  105 IF(INDIC.NE.3) CALL XABORT('PCREIR: CHARACTER DATA EXPECTED')
+*----
+*  EXIT IF ENDCHAIN READ
+*----
+      IF(TEXT12.EQ.'ENDCHAIN') GO TO 190
+*----
+*  ISOTOPE NAME READ
+*  IF NAME ALREADY EXISTS SELECT ISOTOPE NUMBER
+*  IF NAME NOT DEFINED ADD TO ISOTOPE LIST
+*----
+      IDEPL=0
+      READ(TEXT12,'(2A4)') KNADPL(1),KNADPL(2)
+      DO 110 JEL=1,NEL
+        IF(KNADPL(1).EQ.ITNAM(1,JEL).AND.
+     >     KNADPL(2).EQ.ITNAM(2,JEL)) THEN
+          IDEPL=JEL
+          GO TO 115
+        ENDIF
+ 110  CONTINUE
+      NEL=NEL+1
+      IF(NEL.GT.MD2) CALL XABORT('PCREIR: MD2 OVERFLOW(1).')
+      IDEPL=NEL
+      ITNAM(1,NEL)=KNADPL(1)
+      ITNAM(2,NEL)=KNADPL(2)
+*----
+*  READ IZEA
+*----
+ 115  CALL REDGET(INDIC,INTG,FLOTT,TEXT12,DBLINP)
+      IF(INDIC.EQ.1) THEN
+         ITZEA(IDEPL)=INTG
+         CALL REDGET(INDIC,INTG,FLOTT,TEXT12,DBLINP)
+      ELSE
+         ITZEA(IDEPL)=0
+      ENDIF
+*----
+*  LOOP OVER ALL PARAMETERS ASSOCIATED WITH SON ISOTOPES
+*----
+ 120  IF(INDIC.NE.3) CALL XABORT('PCREIR: REACTION TYPE EXPECTED FOR'
+     > //' ISOTOPE '//TEXT12)
+*----
+*  IF KEYWORD IS 'FROM' READ LIST OF PARENT NUCLIDES
+*----
+      IF(TEXT12.EQ.'FROM') THEN
+*----
+*  LOOP OVER ALL PARAMETERS ASSOCIATED WITH PARENT ISOTOPES
+*----
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP)
+ 130    IF(INDIC.NE.3) CALL XABORT('PCREIR: REACTION TYPE EXPECTED.')
+        DO 140 IREAC=1,MAXR
+          RRAT=1.0
+*----
+*  TEST IF KEYWORD IS A REACTION
+*----
+          IF(TEXT12.EQ.NMDEPL(IREAC)) THEN
+*----
+*  READ LIST OF YIELD AND PARENT ISOTOPES
+*----
+            JDEPL=0
+            DO 150 JEL=1,MD2
+*----
+*  IF YIELD ABSENT GO TO TEST FOR NEW REACTION TYPE
+*----
+              CALL REDGET(INDIC,ISOT,RRAT,TEXT12,DBLINP)
+              IF(INDIC.NE.2) GO TO 130
+              CALL REDGET(INDIC,ISOT,FLOTT,TEXT12,DBLINP)
+              IF(INDIC.NE.3)
+     >          CALL XABORT('PCREIR: ISOTOPE NAME hnampar MISSING')
+*----
+*  ISOTOPE NAME READ
+*  IF NAME ALREADY EXISTS SELECT ISOTOPE NUMBER
+*  IF NAME NOT DEFINED ADD TO ISOTOPE LIST
+*----
+              READ(TEXT12,'(2A4)') KNADPL(1),KNADPL(2)
+              DO 160 JREL=1,MD2
+                IF(KNADPL(1).EQ.ITNAM(1,JREL).AND.
+     >             KNADPL(2).EQ.ITNAM(2,JREL)) THEN
+                  JDEPL=JREL
+                  GO TO 165
+                ENDIF
+ 160          CONTINUE
+              NEL=NEL+1
+              IF(NEL.GT.MD2) CALL XABORT('PCREIR: MD2 OVERFLOW(2).')
+              JDEPL=NEL
+              ITNAM(1,NEL)=KNADPL(1)
+              ITNAM(2,NEL)=KNADPL(2)
+ 165          KPAX(IDEPL,JDEPL)=IREAC
+              BPAX(IDEPL,JDEPL)=RRAT
+ 150        CONTINUE
+            CALL XABORT('PCREIR: TO MANY PARENT ISOTOPES')
+          ENDIF
+ 140    CONTINUE
+      ELSE IF(TEXT12.EQ.'STABLE') THEN
+        DO 141 IREAC=1,MAXR
+        IF(KPAX(MD2+IREAC,IDEPL).NE.0) KPAX(MD2+IREAC,IDEPL)=-9999
+ 141    CONTINUE
+        DO 142 IEL=1,MD2
+        KPAX(IDEPL,IEL)=0
+ 142    CONTINUE
+        CALL REDGET(INDIC,INTG,FLOTT,TEXT12,DBLINP)
+*----
+*  READ NEXT KEYWORD FOR THIS ISOTOPE
+*----
+      ELSE
+        DO 170 IREAC=1,MAXR
+          RRAT=0.0
+          IF(TEXT12.EQ.NMDEPL(IREAC)) THEN
+            CALL REDGET(INDIC,ISOT,RRAT,TEXT12,DBLINP)
+            IF(INDIC.EQ.1) THEN
+              CALL XABORT('PCREIR: INVALID INTEGER')
+            ELSE IF(INDIC.EQ.2) THEN
+              CALL REDGET(INDIC,INTG,FLOTT,TEXT12,DBLINP)
+            ENDIF
+            KPAX(MD2+IREAC,IDEPL)=1
+            BPAX(MD2+IREAC,IDEPL)=RRAT
+*----
+*  READ NEXT KEYWORD FOR THIS ISOTOPE
+*----
+            GO TO 120
+          ENDIF
+ 170    CONTINUE
+      ENDIF
+      GO TO 105
+*----
+*  FIND FISSION PRODUCTS
+*----
+ 190  DO 200 IEL=1,MD2
+        DO 210 JEL=1,MD2
+          IF(KPAX(JEL,IEL).EQ.KFISSP) KPAX(MD2+KFISSP,JEL)=-1
+ 210    CONTINUE
+ 200  CONTINUE
+      IF(NEL.NE.MD2) CALL XABORT('PCREIR: INVALID VALUE OF MD2.')
+*----
+*  RETURN FROM PCREIR
+*----
+      RETURN
+      END
diff --git a/Donjon/src/PCRISO.f b/Donjon/src/PCRISO.f
new file mode 100644
index 0000000..26803e3
--- /dev/null
+++ b/Donjon/src/PCRISO.f
@@ -0,0 +1,239 @@
+*DECK PCRISO
+      SUBROUTINE PCRISO(IPLIB,KPTMP,HNAME,JSO,NCAL,NGRP,NL,NED,HVECT,
+     1 NDEL,IMPX,TERP)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover nuclear data from a single isotopic directory.
+*
+*Copyright:
+* Copyright (C) 2019 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPLIB   address of the microlib LCM object.
+* KPTMP   address of the 'CALCULATIONS' list.
+* HNAME   character*12 name of the PMAXS isotope been processed.
+* JSO     index of the PMAXS isotope been processed.
+* NCAL    number of elementary calculations in the PMAXS file.
+* NGRP    number of energy groups.
+* NL      number of Legendre orders.
+* NED     number of extra vector edits.
+* HVECT   character names of the extra vector edits.
+* NDEL    number of delayed precursor groups.
+* IMPX    print parameter (equal to zero for no print).
+* TERP    interpolation weights.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPLIB,KPTMP
+      INTEGER JSO,NCAL,NGRP,NL,NED,NDEL,IMPX
+      REAL TERP(NCAL)
+      CHARACTER HNAME*12,HVECT(NED)*(*)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      REAL TAUXFI, TAUXF, WEIGHT
+      INTEGER ICAL, IDEL, IED, IG1, IG2, IG, ILENG, IL, ITYLCM, J,
+     & LENGTH, MAXH
+      LOGICAL LWD
+      CHARACTER CM*2,HMAKE(100)*12,TEXT12*12
+      TYPE(C_PTR) LPTMP,MPTMP,NPTMP
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: ITYPR
+      REAL, ALLOCATABLE, DIMENSION(:) :: WDLA
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: GAR1,GAR2
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: WSCA1,WSCA2
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(ITYPR(NL))
+      ALLOCATE(GAR1(NGRP,10+NL+NED+2*NDEL),WSCA1(NGRP,NGRP,NL),
+     1 GAR2(NGRP,10+NL+NED+2*NDEL),WSCA2(NGRP,NGRP,NL),WDLA(NDEL))
+*----
+*  RECOVER GENERIC ISOTOPIC DATA FROM THE PMAXS FILE
+*----
+      LWD=.FALSE.
+      DO 10 ICAL=1,NCAL
+      WEIGHT=TERP(ICAL)
+      IF(WEIGHT.EQ.0.0) GO TO 10
+      LPTMP=LCMGIL(KPTMP,ICAL)
+      CALL LCMLEN(LPTMP,'ISOTOPESLIST',LENGTH,ITYLCM)
+      IF(LENGTH.EQ.0) GO TO 10
+      MPTMP=LCMGID(LPTMP,'ISOTOPESLIST')
+      CALL LCMLEL(MPTMP,JSO,ILENG,ITYLCM)
+      IF(ILENG.EQ.0) GO TO 10
+      NPTMP=LCMGIL(MPTMP,JSO)
+      CALL LCMGTC(NPTMP,'ALIAS',12,TEXT12)
+      IF(TEXT12(:8).NE.HNAME(:8)) GO TO 10
+      CALL LCMLEN(NPTMP,'LAMBDA-D',LENGTH,ITYLCM)
+      LWD=(LENGTH.EQ.NDEL).AND.(NDEL.GT.0)
+      IF(LWD) CALL LCMGET(NPTMP,'LAMBDA-D',WDLA)
+      GO TO 15
+   10 CONTINUE
+      CALL XABORT('PCRISO: UNABLE TO FIND A DIRECTORY FOR ISOTOPE '//
+     1 HNAME//'.')
+*----
+*  LOOP OVER ELEMENTARY CALCULATIONS
+*----
+   15 MAXH=10+NL+NED+2*NDEL
+      IF(MAXH+NL.GT.100) CALL XABORT('PCRISO: STATIC STORAGE EXCEEDED')
+      DO J=1,MAXH+NL
+         HMAKE(J)=' '
+      ENDDO
+      GAR2(:NGRP,:MAXH)=0.0
+      WSCA2(:NGRP,:NGRP,:NL)=0.0
+      TAUXFI=0.0
+      DO 120 ICAL=1,NCAL
+      WEIGHT=TERP(ICAL)
+      IF(WEIGHT.EQ.0.0) GO TO 120
+      LPTMP=LCMGIL(KPTMP,ICAL)
+      IF(IMPX.GT.4) THEN
+         WRITE(IOUT,'(34H PCRISO: PMAXS ACCESS FOR ISOTOPE ,A,6H AND C,
+     1   10HALCULATION,I5,1H.)') HNAME,ICAL
+         IF(IMPX.GT.50) CALL LCMLIB(LPTMP)
+      ENDIF
+      MPTMP=LCMGID(LPTMP,'ISOTOPESLIST')
+      CALL LCMLEL(MPTMP,JSO,ILENG,ITYLCM)
+      IF(ILENG.EQ.0) GO TO 120
+      NPTMP=LCMGIL(MPTMP,JSO)
+*----
+*  RECOVER CALCULATION-SPECIFIC ISOTOPIC DATA FROM THE PMAXS FILE
+*----
+      CALL LCMLEN(NPTMP,'NWT0',LENGTH,ITYLCM)
+      IF(LENGTH.EQ.NGRP) THEN
+         CALL LCMGET(NPTMP,'NWT0',GAR1(1,1))
+         HMAKE(1)='NWT0'
+      ENDIF
+      CALL LCMLEN(NPTMP,'NWT1',LENGTH,ITYLCM)
+      IF(LENGTH.EQ.NGRP) THEN
+         CALL LCMGET(NPTMP,'NWT1',GAR1(1,2))
+         HMAKE(2)='NWT1'
+      ENDIF
+      CALL XDRLGS(NPTMP,-1,IMPX,0,NL-1,1,NGRP,GAR1(1,3),WSCA1,ITYPR)
+      DO IL=0,NL-1
+         IF(ITYPR(IL+1).NE.0) THEN
+            WRITE (CM,'(I2.2)') IL
+            HMAKE(3+IL)='SIGS'//CM
+         ENDIF
+      ENDDO
+      CALL LCMGET(NPTMP,'NTOT0',GAR1(1,3+NL))
+      HMAKE(3+NL)='NTOT0'
+      CALL LCMLEN(NPTMP,'NTOT1',LENGTH,ITYLCM)
+      IF(LENGTH.EQ.NGRP) THEN
+         CALL LCMGET(NPTMP,'NTOT1',GAR1(1,4+NL))
+         HMAKE(4+NL)='NTOT1'
+      ENDIF
+      CALL LCMLEN(NPTMP,'NUSIGF',LENGTH,ITYLCM)
+      IF(LENGTH.EQ.NGRP) THEN
+         CALL LCMGET(NPTMP,'NUSIGF',GAR1(1,5+NL))
+         HMAKE(5+NL)='NUSIGF'
+         CALL LCMGET(NPTMP,'CHI',GAR1(1,MAXH-NDEL-1))
+         HMAKE(MAXH-NDEL-1)='CHI'
+      ENDIF
+      IF(NDEL.GT.0) THEN
+         WRITE(TEXT12,'(6HNUSIGF,I2.2)') NDEL
+         CALL LCMLEN(NPTMP,TEXT12,LENGTH,ITYLCM)
+         IF(LENGTH.EQ.NGRP) THEN
+            DO IDEL=1,NDEL
+               WRITE(TEXT12,'(6HNUSIGF,I2.2)') IDEL
+               CALL LCMGET(NPTMP,TEXT12,GAR1(1,MAXH-2*NDEL-2+IDEL))
+               HMAKE(MAXH-2*NDEL-2+IDEL)=TEXT12
+            ENDDO
+         ENDIF
+         WRITE(TEXT12,'(3HCHI,I2.2)') NDEL
+         CALL LCMLEN(NPTMP,TEXT12,LENGTH,ITYLCM)
+         IF(LENGTH.EQ.NGRP) THEN
+            DO IDEL=1,NDEL
+               WRITE(TEXT12,'(3HCHI,I2.2)') IDEL
+               CALL LCMGET(NPTMP,TEXT12,GAR1(1,MAXH-NDEL-1+IDEL))
+               HMAKE(MAXH-NDEL-1+IDEL)=TEXT12
+            ENDDO
+         ENDIF
+      ENDIF
+      CALL LCMLEN(NPTMP,'H-FACTOR',LENGTH,ITYLCM)
+      IF(LENGTH.EQ.NGRP) THEN
+         CALL LCMGET(NPTMP,'H-FACTOR',GAR1(1,MAXH-2*NDEL-4))
+         HMAKE(MAXH-2*NDEL-4)='H-FACTOR'
+      ENDIF
+      CALL LCMLEN(NPTMP,'OVERV',LENGTH,ITYLCM)
+      IF(LENGTH.EQ.NGRP) THEN
+         CALL LCMGET(NPTMP,'OVERV',GAR1(1,MAXH-2*NDEL-3))
+         HMAKE(MAXH-2*NDEL-3)='OVERV'
+      ENDIF
+      CALL LCMLEN(NPTMP,'TRANC',LENGTH,ITYLCM)
+      IF(LENGTH.EQ.NGRP) THEN
+         CALL LCMGET(NPTMP,'TRANC',GAR1(1,MAXH-2*NDEL-2))
+         HMAKE(MAXH-2*NDEL-2)='TRANC'
+      ENDIF
+      DO IED=1,NED
+         CALL LCMLEN(NPTMP,HVECT(IED),LENGTH,ITYLCM)
+         IF((LENGTH.GT.0).AND.(HVECT(IED).NE.'TRANC')) THEN
+            CALL LCMGET(NPTMP,HVECT(IED),GAR1(1,5+NL+IED))
+            HMAKE(5+NL+IED)=HVECT(IED)
+         ENDIF
+      ENDDO
+      CALL LCMLEN(NPTMP,'STRD',LENGTH,ITYLCM)
+      IF(LENGTH.EQ.NGRP) THEN
+         CALL LCMGET(NPTMP,'STRD',GAR1(1,MAXH))
+         HMAKE(MAXH)='STRD'
+      ENDIF
+*----
+*  COMPUTE FISSION RATE FOR A SINGLE ELEMENTARY CALCULATION
+*----
+      TAUXF=0.0
+      IF(HMAKE(5+NL).EQ.'NUSIGF') THEN
+        DO IG=1,NGRP
+           TAUXF=TAUXF+GAR1(IG,5+NL)*GAR1(IG,1)
+        ENDDO
+        TAUXFI=TAUXFI+WEIGHT*TAUXF
+      ENDIF
+*----
+*  ADD CONTRIBUTIONS FROM A SINGLE ELEMENTARY CALCULATION
+*----
+      DO J=1,MAXH
+         IF((HMAKE(J).NE.' ').AND.(HMAKE(J)(:4).NE.'SIGS')) THEN
+            DO IG=1,NGRP
+               GAR2(IG,J)=GAR2(IG,J)+WEIGHT*GAR1(IG,J)
+            ENDDO
+         ENDIF
+      ENDDO
+      DO IL=1,NL
+         ITYPR(IL)=0
+         IF(HMAKE(MAXH+IL).NE.' ') ITYPR(IL)=1
+         DO IG2=1,NGRP
+            GAR2(IG2,2+IL)=GAR2(IG2,2+IL)+WEIGHT*GAR1(IG2,2+IL)
+            DO IG1=1,NGRP
+               WSCA2(IG1,IG2,IL)=WSCA2(IG1,IG2,IL)+WEIGHT*
+     1         WSCA1(IG1,IG2,IL)
+            ENDDO
+         ENDDO
+      ENDDO
+  120 CONTINUE
+*----
+*  SAVE ISOTOPIC DATA IN THE MICROLIB
+*----
+      CALL LCMPTC(IPLIB,'ALIAS',12,HNAME)
+      IF(LWD) CALL LCMPUT(IPLIB,'LAMBDA-D',NDEL,2,WDLA)
+      DO J=1,MAXH
+         IF((HMAKE(J).NE.' ').AND.(HMAKE(J)(:4).NE.'SIGS')) THEN
+            CALL LCMPUT(IPLIB,HMAKE(J),NGRP,2,GAR2(1,J))
+         ENDIF
+      ENDDO
+      CALL XDRLGS(IPLIB,1,IMPX,0,NL-1,1,NGRP,GAR2(1,3),WSCA2,ITYPR)
+      IF(IMPX.GT.50) CALL LCMLIB(IPLIB)
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(WDLA,WSCA2,GAR2,WSCA1,GAR1)
+      DEALLOCATE(ITYPR)
+      RETURN
+      END
diff --git a/Donjon/src/PCRMAC.f b/Donjon/src/PCRMAC.f
new file mode 100644
index 0000000..06cf5af
--- /dev/null
+++ b/Donjon/src/PCRMAC.f
@@ -0,0 +1,451 @@
+*DECK PCRMAC
+      SUBROUTINE PCRMAC(MAXNIS,IPMAC,IACCS,NMIX,NGRP,NGFF,IMPX,NCAL,
+     1 TERP,NISO,HISO,CONC,LMIXC,XS_CALC,B2)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Build the macrolib by scanning the NCAL elementary calculations and
+* weighting them with TERP factors.
+*
+*Copyright:
+* Copyright (C) 2019 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* MAXNIS  maximum value of NISO(I) in user data.
+* IPMAC   address of the output macrolib LCM object.
+* IACCS   =0 macrolib is created; =1 ... is updated.
+* NMIX    maximum number of material mixtures in the macrolib.
+* NGRP    number of energy groups.
+* NGFF    number of group form factors per energy group.
+* IMPX    print parameter (equal to zero for no print).
+* NCAL    number of elementary calculations in the PMAXS file.
+* TERP    interpolation factors.
+* NISO    number of user-selected isotopes.
+* HISO    name of the user-selected isotopes.
+* CONC    user-defined number density of the user-selected isotopes.
+* LMIXC   flag set to .true. for fuel-map mixtures to process.
+* XS_CALC pointers towards PMAXS elementary calculations.
+* B2      buckling
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      USE PCRDATA
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAC
+      INTEGER MAXNIS,IACCS,NMIX,NGRP,NGFF,IMPX,NCAL,NISO(NMIX),
+     1 HISO(2,NMIX,MAXNIS)
+      REAL TERP(NCAL,NMIX),CONC(NMIX,MAXNIS),B2
+      LOGICAL LMIXC(NMIX)
+      TYPE(XSBLOCK_ITEM) XS_CALC(NCAL)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXED=30
+      INTEGER, PARAMETER::MAX1D=40
+      INTEGER, PARAMETER::MAX2D=20
+      INTEGER, PARAMETER::MAXIFX=5
+      INTEGER, PARAMETER::MAXNFI=50
+      INTEGER, PARAMETER::MAXNL=6
+      INTEGER, PARAMETER::MAXRES=MAX1D-10
+      INTEGER, PARAMETER::NSTATE=40
+      REAL FLOTVA, WEIGHT
+      INTEGER I0, I1D, I2D, IBM, ICAL, IDEL, IDF, IED, IGMAX, IGMIN,
+     & IGR, ILONG, IL, IPOSDE, ISO, ITRAN, ITSTMP, ITYLCM, I, JGR,
+     & KSO1, KSO, MAXMIX, N1D, N2D, NBISO, NDEL, NED,NF, NL, NTYPE
+      INTEGER ISTATE(NSTATE),NFINF,IACCOLD
+      REAL TMPDAY(3)
+      LOGICAL LMAKE1(MAX1D),LMAKE2(MAX2D),LFAST
+      CHARACTER TEXT8*8,TEXT12*12,HHISO*8,CM*2,HMAK1(MAX1D)*12,
+     1 HMAK2(MAX2D)*12,HVECT(MAXED)*8
+      TYPE(C_PTR) IPTMP,JPTMP,KPTMP,JPMAC,KPMAC
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IJJ,NJJ,IPOS,ISOMI
+      REAL, ALLOCATABLE, DIMENSION(:) :: GAR4,XVOLM,WORK1,WORK2
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: FLUX
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: GAR1
+      REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: GAR2,GAR3
+      LOGICAL, ALLOCATABLE, DIMENSION(:) :: MASKL
+      INTEGER, POINTER, DIMENSION(:) :: ISONA
+      REAL, POINTER, DIMENSION(:) :: DENIS,FLOT
+      TYPE(C_PTR) ISONA_PTR,DENIS_PTR,FLOT_PTR
+      DATA HMAK1 / 'FLUX-INTG','NTOT0','OVERV','DIFF','DIFFX','DIFFY',
+     1             'DIFFZ','FLUX-INTG-P1','NTOT1','H-FACTOR',MAXRES*' '/
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(IJJ(NMIX),NJJ(NMIX),IPOS(NMIX))
+      ALLOCATE(FLUX(NGRP,2),GAR1(NMIX,NGRP,MAX1D),
+     1 GAR2(NMIX,MAXNFI,NGRP,MAX2D),GAR3(NMIX,NGRP,NGRP,MAXNL),
+     2 GAR4(NMIX*NGRP))
+*
+      IACCOLD=IACCS ! for ADF and GFF 
+      NTYPE=0
+      NFINF=0
+*----
+*  MACROLIB INITIALIZATION
+*----
+      IF(IACCS.EQ.0) THEN
+*        PMAXS values:
+         NL=1
+         NF=0
+         ITRAN=0
+         NDEL=NDLAY
+*         IDF=NTDF
+*         NGFF=NRODS
+         IDF=0
+         NGFF=0
+         NED=1
+         HVECT(1)='H-FACTOR'
+         IF(NXST.GE.7) THEN
+           NED=2
+           HVECT(2)='NFTOT'
+         ENDIF
+         IF(NXST.EQ.8) THEN
+           NED=3
+           HVECT(3)='DETEC'
+         ENDIF
+         TEXT12='L_MACROLIB'
+         CALL LCMPTC(IPMAC,'SIGNATURE',12,TEXT12)
+         ISTATE(:NSTATE)=0
+         ISTATE(1)=NGRP
+         ISTATE(2)=NMIX
+         ISTATE(3)=NL
+         ISTATE(5)=NED
+         ISTATE(6)=ITRAN
+         ISTATE(7)=NDEL
+         ISTATE(12)=IDF
+         ISTATE(16)=NGFF
+         CALL LCMPUT(IPMAC,'STATE-VECTOR',NSTATE,1,ISTATE)
+         CALL LCMPTC(IPMAC,'ADDXSNAME-P0',8,NED,HVECT)
+      ELSE
+         CALL LCMGTC(IPMAC,'SIGNATURE',12,TEXT12)
+         IF(TEXT12.NE.'L_MACROLIB') THEN
+          CALL XABORT('PCRMAC: SIGNATURE IS '//TEXT12//'. L_MACROLIB E'
+     1    //'XPECTED.')
+         ENDIF
+         CALL LCMGET(IPMAC,'STATE-VECTOR',ISTATE)
+         IF(ISTATE(1).NE.NGRP) THEN
+            CALL XABORT('PCRMAC: INVALID NUMBER OF ENERGY GROUPS(2).')
+         ELSE IF(ISTATE(2).NE.NMIX) THEN
+            CALL XABORT('PCRMAC: INVALID NUMBER OF MIXTURES(2).')
+         ENDIF
+         NL=ISTATE(3)
+         NF=ISTATE(4)
+         NED=ISTATE(5)
+         NDEL=ISTATE(7)
+         IDF=ISTATE(12)
+         NGFF=ISTATE(16)
+         IF(NED.GT.MAXED) CALL XABORT('PCRMAC: MAXED OVERFLOW(2).')
+         IF(NED.GT.0) CALL LCMGTC(IPMAC,'ADDXSNAME-P0',8,NED,HVECT)
+         IF(IDF.EQ.1) THEN
+           NTYPE=1
+         ELSE IF((IDF.EQ.3).AND.(IACCOLD.NE.0)) THEN
+           CALL LCMSIX(IPMAC,'ADF',1)
+           CALL LCMGET(IPMAC,'NTYPE',NTYPE)
+           CALL LCMSIX(IPMAC,' ',2)
+         ENDIF
+         IF((NGFF.NE.0).AND.(IACCOLD.NE.0)) THEN
+           CALL LCMSIX(IPMAC,'GFF',1)
+           CALL LCMLEN(IPMAC,'FINF_NUMBER ',NFINF,ITYLCM)
+           IF(NFINF.GT.MAXIFX) CALL XABORT('PCRMAC: MAXIFX OVERFLOW.')
+           CALL LCMSIX(IPMAC,' ',2)
+         ENDIF
+      ENDIF
+      N1D=10+NED+NL
+      N2D=2*(NDEL+1)
+      IF(NL.GT.MAXNL) CALL XABORT('PCRMAC: MAXNL OVERFLOW.')
+      IF(N1D.GT.MAX1D) CALL XABORT('PCRMAC: MAX1D OVERFLOW.')
+      IF(N2D.GT.MAX2D) CALL XABORT('PCRMAC: MAX2D OVERFLOW.')
+      LMAKE1(:N1D)=.FALSE.
+      LMAKE2(:N2D)=.FALSE.
+      GAR1(:NMIX,:NGRP,:N1D)=0.0
+      GAR2(:NMIX,:MAXNFI,:NGRP,:N2D)=0.0
+      GAR3(:NMIX,:NGRP,:NGRP,:NL)=0.0
+      DO 20 IED=1,NED
+      HMAK1(10+IED)=HVECT(IED)
+   20 CONTINUE
+      DO 30 IL=1,NL
+      WRITE(CM,'(I2.2)') IL-1
+      HMAK1(10+NED+IL)='SIGS'//CM
+   30 CONTINUE
+      HMAK2(1)='NUSIGF'
+      HMAK2(2)='CHI'
+      DO 40 IDEL=1,NDEL
+      WRITE(TEXT8,'(6HNUSIGF,I2.2)') IDEL
+      HMAK2(2+2*(IDEL-1)+1)=TEXT8
+      WRITE(TEXT8,'(3HCHI,I2.2)') IDEL
+      HMAK2(2+2*(IDEL-1)+2)=TEXT8
+   40 CONTINUE
+*----
+*  READ EXISTING MACROLIB INFORMATION
+*----
+      ALLOCATE(XVOLM(NMIX))
+      XVOLM(:NMIX)=0.0
+      IF(IACCS.NE.0) THEN   ! IACCS
+        CALL LCMGET(IPMAC,'VOLUME',XVOLM)
+        JPMAC=LCMGID(IPMAC,'GROUP')
+        DO 80 IGR=1,NGRP
+        KPMAC=LCMGIL(JPMAC,IGR)
+        DO 60 I1D=1,N1D
+        CALL LCMLEN(KPMAC,HMAK1(I1D),ILONG,ITYLCM)
+        IF(ILONG.NE.0) THEN
+          LMAKE1(I1D)=.TRUE.
+          CALL LCMGET(KPMAC,HMAK1(I1D),GAR1(1,IGR,I1D))
+          DO 50 IBM=1,NMIX
+          IF(LMIXC(IBM)) GAR1(IBM,IGR,I1D)=0.0
+   50     CONTINUE
+        ENDIF
+   60   CONTINUE
+        DO 65 I2D=1,N2D
+        CALL LCMLEN(KPMAC,HMAK2(I2D),ILONG,ITYLCM)
+        IF(ILONG.NE.0) THEN
+          LMAKE2(I2D)=.TRUE.
+          CALL LCMGET(KPMAC,HMAK2(I2D),GAR2(1,1,IGR,I2D))
+          DO 64 I=1,NF
+          DO 63 IBM=1,NMIX
+          IF(LMIXC(IBM)) GAR2(IBM,I,IGR,I2D)=0.0
+   63     CONTINUE
+   64     CONTINUE
+        ENDIF
+   65   CONTINUE
+        DO 75 IL=1,NL
+        WRITE(CM,'(I2.2)') IL-1
+        ILONG=1
+        IF(IL.GT.1) CALL LCMLEN(KPMAC,'SCAT'//CM,ILONG,ITYLCM)
+        IF(ILONG.NE.0) THEN
+          CALL LCMGET(KPMAC,'SCAT'//CM,GAR4)
+          CALL LCMGET(KPMAC,'NJJS'//CM,NJJ)
+          CALL LCMGET(KPMAC,'IJJS'//CM,IJJ)
+          CALL LCMGET(KPMAC,'IPOS'//CM,IPOS)
+          DO 71 IBM=1,NMIX
+          IPOSDE=IPOS(IBM)
+          DO 70 JGR=IJJ(IBM),IJJ(IBM)-NJJ(IBM)+1,-1
+          GAR3(IBM,JGR,IGR,IL)=GAR4(IPOSDE)
+          IF(LMIXC(IBM)) GAR3(IBM,JGR,IGR,IL)=0.0
+          IPOSDE=IPOSDE+1
+   70     CONTINUE
+   71     CONTINUE
+        ENDIF
+   75   CONTINUE
+   80   CONTINUE
+      ENDIF   ! IACCS
+*----
+*  OVERALL ELEMENTARY CALCULATION LOOP
+*----
+      LFAST=.TRUE.
+      DO 85 IBM=1,NMIX
+      LFAST=LFAST.AND.((.NOT.LMIXC(IBM)).OR.(NISO(IBM).EQ.0))
+   85 CONTINUE
+      DO 210 ICAL=1,NCAL
+      IPTMP=C_NULL_PTR
+      DO 200 IBM=1,NMIX
+      WEIGHT=TERP(ICAL,IBM)
+      IF((.NOT.LMIXC(IBM)).OR.(WEIGHT.EQ.0.0)) GO TO 200
+*----
+*  PRODUCE AN ELEMENTARY MACROLIB (IF IPTMP=C_NULL_PTR)
+*----
+      IF(.NOT.C_ASSOCIATED(IPTMP)) THEN
+        CALL LCMOP(IPTMP,'*ELEMENTARY*',0,1,0)
+        CALL PCRONE(IMPX,ICAL,IPTMP,NCAL,NGRP,XS_CALC)
+        IF(IMPX.GT.0) THEN
+          WRITE(IOUT,'(33H PCRMAC: PMAXS ACCESS FOR MIXTURE,I8,5H AND ,
+     1    11HCALCULATION,I8,9H. WEIGHT=,1P,E12.4)') IBM,ICAL,WEIGHT
+          IF(IMPX.GT.50) CALL LCMLIB(IPTMP)
+        ENDIF
+        CALL LCMGET(IPTMP,'STATE-VECTOR',ISTATE)
+        NBISO=ISTATE(2)
+        IF(ISTATE(1).NE.1) CALL XABORT('PCRMAC: INVALID NUMBER OF MATE'
+     1  //'RIAL MIXTURES IN THE PMAXS FILE.')
+        IF(ISTATE(3).NE.NGRP) CALL XABORT('PCRMAC: INVALID NUMBER OF E'
+     1  //'NERGY GROUPS IN THE PMAXS FILE.')
+        ALLOCATE(MASKL(NGRP))
+        MASKL(:NGRP)=.TRUE.
+        CALL LCMGPD(IPTMP,'ISOTOPESUSED',ISONA_PTR)
+        CALL LCMGPD(IPTMP,'ISOTOPESDENS',DENIS_PTR)
+        CALL C_F_POINTER(ISONA_PTR,ISONA,(/ NBISO /))
+        CALL C_F_POINTER(DENIS_PTR,DENIS,(/ NBISO /))
+        DO 110 ISO=1,NBISO
+        WRITE(TEXT8,'(2A4)') (ISONA(3*(ISO-1)+I0),I0=1,2)
+        KSO1=0
+        DO 90 KSO=1,NISO(IBM) ! user-selected isotope
+        WRITE(HHISO,'(2A4)') (HISO(I0,IBM,KSO),I0=1,2)
+        IF(TEXT8.EQ.HHISO) THEN
+          KSO1=KSO
+          GO TO 100
+        ENDIF
+   90   CONTINUE
+  100   IF(KSO1.GT.0) DENIS(ISO)=CONC(IBM,KSO1)
+  110   CONTINUE
+        MAXMIX=1
+        ITSTMP=0
+        TMPDAY(1)=0.0
+        TMPDAY(2)=0.0
+        TMPDAY(3)=0.0
+        ALLOCATE(ISOMI(NBISO))
+        ISOMI(:NBISO)=1
+        CALL LIBMIX(IPTMP,MAXMIX,NGRP,NBISO,ISONA,ISOMI,DENIS,
+     1              .TRUE.,MASKL,ITSTMP,TMPDAY)
+        CALL LCMPPD(IPTMP,'ISOTOPESDENS',NBISO,2,DENIS_PTR)
+        DEALLOCATE(ISOMI,MASKL)
+      ENDIF
+*----
+*  PERFORM INTERPOLATION
+*----
+      CALL LCMSIX(IPTMP,'MACROLIB',1)
+      CALL LCMGET(IPTMP,'STATE-VECTOR',ISTATE)
+      IF(NF.EQ.0) NF=ISTATE(4)
+      IF(NF.GT.MAXNFI) CALL XABORT('PCRMAC: MAXNFI OVERFLOW.')
+      IF(ISTATE(1).NE.NGRP) THEN
+         CALL XABORT('PCRMAC: INVALID NUMBER OF ENERGY GROUPS(3).')
+      ELSE IF(ISTATE(2).NE.1)THEN
+         CALL XABORT('PCRMAC: INVALID NUMBER OF MIXTURES(3).')
+      ELSE IF(ISTATE(3).NE.NL) THEN
+         CALL XABORT('PCRMAC: INVALID NUMBER OF LEGENDRE ORDERS(3).')
+      ELSE IF((ISTATE(4).NE.0).AND.(ISTATE(4).NE.NF)) THEN
+         CALL XABORT('PCRMAC: INVALID NUMBER OF FISSILE ISOTOPES(3).')
+      ELSE IF((ISTATE(5).NE.NED).AND.(ISTATE(5).GT.0)) THEN
+         CALL XABORT('PCRMAC: INVALID NUMBER OF EDIT REACTIONS(3).')
+      ELSE IF((ISTATE(7).NE.NDEL).AND.(ISTATE(7).GT.0)) THEN
+         CALL XABORT('PCRMAC: INVALID NUMBER OF PRECURSOR GROUPS(3).')
+      ENDIF
+      JPTMP=LCMGID(IPTMP,'GROUP')
+      DO 195 IGR=1,NGRP
+      KPTMP=LCMGIL(JPTMP,IGR)
+      DO 170 I1D=1,N1D
+      CALL LCMLEN(KPTMP,HMAK1(I1D),ILONG,ITYLCM)
+      IF(ILONG.NE.0) THEN
+        IF(ILONG.NE.1) CALL XABORT('PCRMAC: FLOTVA OVERFLOW.')
+        LMAKE1(I1D)=.TRUE.
+        CALL LCMGET(KPTMP,HMAK1(I1D),FLOTVA)
+        GAR1(IBM,IGR,I1D)=GAR1(IBM,IGR,I1D)+WEIGHT*FLOTVA
+      ENDIF
+  170 CONTINUE
+      IF(ISTATE(4).GT.0) THEN
+        DO 175 I2D=1,N2D
+        CALL LCMLEN(KPTMP,HMAK2(I2D),ILONG,ITYLCM)
+        IF(ILONG.NE.0) THEN
+          IF(ILONG.NE.NF) CALL XABORT('PCRMAC: FLOT OVERFLOW.')
+          LMAKE2(I2D)=.TRUE.
+          CALL LCMGPD(KPTMP,HMAK2(I2D),FLOT_PTR)
+          CALL C_F_POINTER(FLOT_PTR,FLOT,(/ ILONG /))
+          DO 174 I=1,NF
+          GAR2(IBM,I,IGR,I2D)=GAR2(IBM,I,IGR,I2D)+WEIGHT*FLOT(I)
+  174     CONTINUE
+        ENDIF
+  175   CONTINUE
+      ENDIF
+      DO 190 IL=1,NL
+      WRITE(CM,'(I2.2)') IL-1
+      ILONG=1
+      IF(IL.GT.1) CALL LCMLEN(KPTMP,'SCAT'//CM,ILONG,ITYLCM)
+      IF(ILONG.NE.0) THEN
+        CALL LCMGET(KPTMP,'SCAT'//CM,GAR4)
+        CALL LCMGET(KPTMP,'NJJS'//CM,NJJ)
+        CALL LCMGET(KPTMP,'IJJS'//CM,IJJ)
+        CALL LCMGET(KPTMP,'IPOS'//CM,IPOS)
+        IPOSDE=IPOS(1)
+        DO 180 JGR=IJJ(1),IJJ(1)-NJJ(1)+1,-1
+        GAR3(IBM,JGR,IGR,IL)=GAR3(IBM,JGR,IGR,IL)+WEIGHT*GAR4(IPOSDE)
+        IPOSDE=IPOSDE+1
+  180   CONTINUE
+      ENDIF
+  190 CONTINUE
+  195 CONTINUE
+      CALL LCMSIX(IPTMP,' ',2)
+      IF(.NOT.LFAST) CALL LCMCL(IPTMP,2)
+  200 CONTINUE
+      IF(C_ASSOCIATED(IPTMP)) CALL LCMCL(IPTMP,2)
+  210 CONTINUE
+*----
+*  WRITE INTERPOLATED MACROLIB INFORMATION
+*----
+      CALL LCMPUT(IPMAC,'VOLUME',NMIX,2,XVOLM)
+      DEALLOCATE(XVOLM)
+      JPMAC=LCMLID(IPMAC,'GROUP',NGRP)
+      DO 370 IGR=1,NGRP
+      KPMAC=LCMDIL(JPMAC,IGR)
+      DO 320 I1D=1,N1D
+      IF(LMAKE1(I1D)) THEN
+        CALL LCMPUT(KPMAC,HMAK1(I1D),NMIX,2,GAR1(1,IGR,I1D))
+      ENDIF
+  320 CONTINUE
+      DO 325 I2D=1,N2D
+      IF(LMAKE2(I2D).AND.(NF.GT.0)) THEN
+        CALL LCMPUT(KPMAC,HMAK2(I2D),NMIX*NF,2,GAR2(1,1,IGR,I2D))
+      ENDIF
+  325 CONTINUE
+      DO 360 IL=1,NL
+      WRITE(CM,'(I2.2)') IL-1
+      IPOSDE=0
+      DO 350 IBM=1,NMIX
+      IPOS(IBM)=IPOSDE+1
+      IGMIN=IGR
+      IGMAX=IGR
+      DO 330 JGR=1,NGRP
+      IF(GAR3(IBM,JGR,IGR,IL).NE.0.0) THEN
+        IGMIN=MIN(IGMIN,JGR)
+        IGMAX=MAX(IGMAX,JGR)
+      ENDIF
+  330 CONTINUE
+      IJJ(IBM)=IGMAX
+      NJJ(IBM)=IGMAX-IGMIN+1
+      DO 340 JGR=IGMAX,IGMIN,-1
+      IPOSDE=IPOSDE+1
+      GAR4(IPOSDE)=GAR3(IBM,JGR,IGR,IL)
+  340 CONTINUE
+  350 CONTINUE
+      IF(IPOSDE.GT.0) THEN
+        CALL LCMPUT(KPMAC,'SCAT'//CM,IPOSDE,2,GAR4)
+        CALL LCMPUT(KPMAC,'NJJS'//CM,NMIX,1,NJJ)
+        CALL LCMPUT(KPMAC,'IJJS'//CM,NMIX,1,IJJ)
+        CALL LCMPUT(KPMAC,'IPOS'//CM,NMIX,1,IPOS)
+        CALL LCMPUT(KPMAC,'SIGW'//CM,NMIX,2,GAR3(1,IGR,IGR,IL))
+      ENDIF
+  360 CONTINUE
+  370 CONTINUE
+      IACCS=1
+*----
+*  UPDATE STATE-VECTOR
+*----
+      CALL LCMGET(IPMAC,'STATE-VECTOR',ISTATE)
+      ISTATE(4)=MAX(ISTATE(4),NF)
+      IF(LMAKE1(4)) ISTATE(9)=1
+      IF(LMAKE1(5)) ISTATE(9)=2
+      CALL LCMPUT(IPMAC,'STATE-VECTOR',NSTATE,1,ISTATE)
+*----
+*  INCLUDE LEAKAGE IN THE MACROLIB (USED ONLY FOR NON-REGRESSION TESTS)
+*----
+      IF(B2.NE.0.0) THEN
+        IF(IMPX.GT.0) WRITE(6,'(/34H PCRMAC: INCLUDE LEAKAGE IN THE MA,
+     1  11HCROLIB (B2=,1P,E12.5,2H).)') B2
+        JPMAC=LCMGID(IPMAC,'GROUP')
+        ALLOCATE(WORK1(NMIX),WORK2(NMIX))
+        DO 520 IGR=1,NGRP
+          KPMAC=LCMGIL(JPMAC,IGR)
+          CALL LCMGET(KPMAC,'NTOT0',WORK1)
+          CALL LCMGET(KPMAC,'DIFF',WORK2)
+          DO 510 IBM=1,NMIX
+            IF(LMIXC(IBM)) WORK1(IBM)=WORK1(IBM)+B2*WORK2(IBM)
+  510     CONTINUE
+          CALL LCMPUT(KPMAC,'NTOT0',NMIX,2,WORK1)
+  520   CONTINUE
+        DEALLOCATE(WORK2,WORK1)
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(GAR4,GAR3,GAR2,GAR1,FLUX)
+      DEALLOCATE(IPOS,NJJ,IJJ)
+      RETURN
+      END
diff --git a/Donjon/src/PCRMIC.f b/Donjon/src/PCRMIC.f
new file mode 100644
index 0000000..9219e44
--- /dev/null
+++ b/Donjon/src/PCRMIC.f
@@ -0,0 +1,335 @@
+*DECK PCRMIC
+      SUBROUTINE PCRMIC(MAXNIS,MAXISO,IPLIB,IACCS,NMIX,NGRP,IMPX,
+     1 NCAL,TERP,NISO,HISO,CONC,LMIXC,XS_CALC,B2)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Build the microlib by scanning the NCAL elementary calculations from
+* PMAXS file and weighting them with TERP factors.
+*
+*Copyright:
+* Copyright (C) 2019 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* MAXNIS  maximum value of NISO(I) in user data.
+* MAXISO  maximum allocated space for output microlib TOC information.
+* IPLIB   address of the output microlib LCM object.
+* IACCS   =0 microlib is created; =1 ... is updated.
+* NMIX    maximum number of material mixtures in the microlib.
+* NGRP    number of energy groups.
+* IMPX    print parameter (equal to zero for no print).
+* NCAL    number of elementary calculations in the PMAXS file.
+* TERP    interpolation factors.
+* NISO    number of user-selected isotopes.
+* HISO    name of the user-selected isotopes.
+* CONC    user-defined number density of the user-selected isotopes.
+* LMIXC   flag set to .true. for fuel-map mixtures to process.
+* XS_CALC pointers towards PMAXS elementary calculations.
+* B2      buckling
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      USE PCRDATA
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPLIB
+      INTEGER MAXNIS,MAXISO,IACCS,NMIX,NGRP,IMPX,NCAL,NISO(NMIX),
+     1 HISO(2,NMIX,MAXNIS)
+      REAL TERP(NCAL,NMIX),CONC(NMIX,MAXNIS),B2
+      LOGICAL LMIXC(NMIX)
+      TYPE(XSBLOCK_ITEM) XS_CALC(NCAL)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXED=50
+      INTEGER, PARAMETER::NSTATE=40
+      INTEGER I0, IBM, ICAL, IED1, IED2, IGR, ISO, ITRANC, KSO1, I,
+     & JSO, KSO, NBISO1, NBISO2, NCOMB2, NCOMB, NDEL, NDEPL, NED1,
+     & NED2, NL, ITSTMP, MAXMIX, NBISO
+      REAL WEIGHT,TMPDAY(3)
+      CHARACTER TEXT12*12,HNAME*12,HVECT1(MAXED)*8,HHISO*8,TEXT8*8,
+     & HVECT2(MAXED)*8
+      INTEGER ISTATE(NSTATE)
+      TYPE(C_PTR) IPTMP,JPTMP,KPTMP,JPLIB,KPLIB
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IMIX2,ITOD2,ISTY2,MILVO,
+     & IMICR
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: HUSE1,HUSE2,HNAM2
+      REAL, ALLOCATABLE, DIMENSION(:) :: DENS2,ENER,GAR1,GAR2
+      LOGICAL, ALLOCATABLE, DIMENSION(:) :: MASKL
+      INTEGER, POINTER, DIMENSION(:) :: ISONA,ISOMI
+      REAL, POINTER, DIMENSION(:) :: DENIS
+      TYPE(C_PTR) ISONA_PTR,ISOMI_PTR,DENIS_PTR
+      TYPE(C_PTR), ALLOCATABLE, DIMENSION(:) :: IPLIST
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(HUSE1(3,MAXISO),IMIX2(MAXISO),ITOD2(MAXISO),
+     & ISTY2(MAXISO),HUSE2(3,MAXISO),HNAM2(3,MAXISO),MILVO(NMIX),
+     & IPLIST(MAXISO))
+      ALLOCATE(DENS2(MAXISO),ENER(NGRP+1))
+*----
+*  MICROLIB INITIALIZATION
+*----
+      ITRANC=0
+      DENS2(:MAXISO)=0.0
+      IMIX2(:MAXISO)=0
+      ITOD2(:MAXISO)=0
+      ISTY2(:MAXISO)=3
+      IPLIST(:MAXISO)=C_NULL_PTR
+      IF(IACCS.EQ.0) THEN
+         NBISO2=0
+         NCOMB2=0
+         NED2=0
+         TEXT12='L_LIBRARY'
+         CALL LCMPTC(IPLIB,'SIGNATURE',12,TEXT12)
+      ELSE
+         CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+         IF(ISTATE(1).NE.NMIX) CALL XABORT('PCRMIC: INVALID NUMBER OF '
+     1   //'MATERIAL MIXTURES IN THE MICROLIB.')
+         IF(ISTATE(3).NE.NGRP) CALL XABORT('PCRMIC: INVALID NUMBER OF '
+     1   //'ENERGY GROUPS IN THE MICROLIB.')
+         NBISO2=ISTATE(2)
+         NCOMB2=ISTATE(12)
+         IF(NBISO2.GT.MAXISO) CALL XABORT('PCRMIC: MAXISO OVERFLOW(1).')
+         NED2=ISTATE(13)
+         IF(NED2.GT.MAXED) CALL XABORT('PCRMIC: MAXED OVERFLOW.')
+         CALL LCMGET(IPLIB,'ISOTOPESUSED',HUSE2)
+         CALL LCMGET(IPLIB,'ISOTOPERNAME',HNAM2)
+         CALL LCMGET(IPLIB,'ISOTOPESDENS',DENS2)
+         CALL LCMGET(IPLIB,'ISOTOPESMIX',IMIX2)
+         CALL LCMGET(IPLIB,'ISOTOPESTODO',ITOD2)
+         CALL LCMGET(IPLIB,'ISOTOPESTYPE',ISTY2)
+         IF(NED2.GT.0) CALL LCMGTC(IPLIB,'ADDXSNAME-P0',8,NED2,HVECT2)
+         CALL LCMGET(IPLIB,'ENERGY',ENER)
+      ENDIF
+*----
+*  LOOP OVER MICROLIB MIXTURES
+*----
+      MILVO(:NMIX)=0
+      NCOMB=0
+      DO 190 IBM=1,NMIX
+      IF(.NOT.LMIXC(IBM)) GO TO 190
+      IF(NISO(IBM).GT.MAXNIS) CALL XABORT('PCRMIC: MAXNIS OVERFLOW.')
+*----
+*  FIND THE VALUE OF NBISO1 AND HUSE1 IN MIXTURE IBM
+*----
+      NBISO1=1
+      TEXT12='*MAC*RES'
+      READ(TEXT12,'(3A4)') (HUSE1(I,1),I=1,3)
+      IF(NXST.GT.4) THEN
+        NBISO1=3
+        TEXT12='Xe135'
+        READ(TEXT12,'(3A4)') (HUSE1(I,2),I=1,3)
+        TEXT12='Sm149'
+        READ(TEXT12,'(3A4)') (HUSE1(I,3),I=1,3)
+      ENDIF
+*----
+*  LOOP OVER ELEMENTARY CALCULATIONS
+*----
+      CALL LCMOP(IPTMP,'*CALCULATIONS*',0,1,0)
+      JPTMP=LCMLID(IPTMP,'CALCULATIONS',NCAL)
+      DO 70 ICAL=1,NCAL
+      WEIGHT=TERP(ICAL,IBM)
+      IF(WEIGHT.EQ.0.0) GO TO 70
+      KPTMP=LCMDIL(JPTMP,ICAL)
+      CALL PCRONE(IMPX,ICAL,KPTMP,NCAL,NGRP,XS_CALC)
+      IF(IMPX.GT.0) THEN
+        WRITE(IOUT,'(33H PCRMIC: PMAXS ACCESS FOR MIXTURE,I8,6H AND C,
+     1  10HALCULATION,I8,9H. WEIGHT=,1P,E12.4)') IBM,ICAL,WEIGHT
+        IF(IMPX.GT.50) CALL LCMLIB(KPTMP)
+      ENDIF
+      CALL LCMGET(KPTMP,'STATE-VECTOR',ISTATE)
+      IF(ISTATE(1).NE.1) CALL XABORT('PCRMIC: INVALID NUMBER OF MATERI'
+     1 //'AL MIXTURES IN THE PMAXS FILE.')
+      IF(ISTATE(2).NE.NBISO1) CALL XABORT('PCRMIC: INVALID NBISO1.')
+      IF(ISTATE(3).NE.NGRP) CALL XABORT('PCRMIC: INVALID NUMBER OF ENE'
+     1 //'RGY GROUPS IN THE COMPO.')
+      NL=ISTATE(4)
+      ITRANC=ISTATE(5)
+      NDEPL=0
+      NED1=ISTATE(13)
+      NDEL=ISTATE(19)
+      IF(NED1.GT.MAXED) CALL XABORT('PCRMIC: MAXED OVERFLOW.')
+      IF(NED1.GT.0) CALL LCMGTC(KPTMP,'ADDXSNAME-P0',8,NED1,HVECT1)
+      CALL LCMGET(KPTMP,'ENERGY',ENER)
+      DO 30 IED1=1,NED1
+      DO 20 IED2=1,NED2
+      IF(HVECT1(IED1).EQ.HVECT2(IED2)) GO TO 30
+   20 CONTINUE
+      NED2=NED2+1
+      HVECT2(NED2)=HVECT1(IED1)
+   30 CONTINUE
+      CALL LCMGPD(KPTMP,'ISOTOPESUSED',ISONA_PTR)
+      CALL LCMGPD(KPTMP,'ISOTOPESDENS',DENIS_PTR)
+      CALL C_F_POINTER(ISONA_PTR,ISONA,(/ NBISO1 /))
+      CALL C_F_POINTER(DENIS_PTR,DENIS,(/ NBISO1 /))
+      DO 60 ISO=1,NBISO1
+      WRITE(TEXT8,'(2A4)') (ISONA(3*(ISO-1)+I0),I0=1,2)
+      IF(TEXT8.EQ.'*MAC*RES') THEN
+        DENIS(ISO)=1.0
+      ELSE
+        KSO1=0
+        DO 40 KSO=1,NISO(IBM) ! user-selected isotope
+        WRITE(HHISO,'(2A4)') (HISO(I0,IBM,KSO),I0=1,2)
+        IF(TEXT8.EQ.HHISO) THEN
+          KSO1=KSO
+          GO TO 50
+        ENDIF
+   40   CONTINUE
+   50   IF(KSO1.GT.0) DENIS(ISO)=CONC(IBM,KSO1)
+      ENDIF
+   60 CONTINUE
+      CALL LCMPPD(KPTMP,'ISOTOPESDENS',NBISO1,2,DENIS_PTR)
+   70 CONTINUE
+*----
+*  SELECT MICROLIB ISOTOPES CORRESPONDING TO PMAXS ISOTOPES
+*----
+      DO 90 ISO=1,NBISO1 ! PMAXS isotope
+      WRITE(TEXT12,'(2A4)') (HUSE1(I,ISO),I=1,2)
+      NBISO2=NBISO2+1
+      IF(NBISO2.GT.MAXISO) THEN
+        WRITE(IOUT,'(/16H PCRMIC: NBISO2=,I6,8H MAXISO=,I6)') NBISO2,
+     1  MAXISO
+        CALL XABORT('PCRMIC: MAXISO OVERFLOW(2).')
+      ENDIF
+      READ(TEXT12,'(3A4)') (HUSE2(I0,NBISO2),I0=1,3)
+      DO 80 I0=1,3
+      HNAM2(I0,NBISO2)=HUSE1(I0,ISO)
+   80 CONTINUE
+      IMIX2(NBISO2)=IBM
+      DENS2(NBISO2)=DENIS(ISO)
+   90 CONTINUE
+      ALLOCATE(IMICR(NBISO1))
+      IMICR(:NBISO1)=0
+      DO 130 ISO=1,NBISO2 ! microlib isotope
+      IF(IMIX2(ISO).NE.IBM) GO TO 130
+      DO 120 JSO=1,NBISO1 ! PMAXS isotope
+      IF((HUSE1(1,JSO).EQ.HUSE2(1,ISO)).AND.(HUSE1(2,JSO).EQ.
+     1 HUSE2(2,ISO))) THEN
+        IMICR(JSO)=ISO
+        GO TO 130
+      ENDIF
+  120 CONTINUE
+      WRITE(TEXT12,'(3A4)') (HUSE2(I0,ISO),I0=1,3)
+      CALL XABORT('PCRMIC: UNABLE TO FIND '//TEXT12//'.')
+  130 CONTINUE
+*----
+*  PROCESS ISOTOPE DIRECTORIES FOR MICROLIB MIXTURE IBM
+*----
+      DO 180 JSO=1,NBISO1 ! PMAXS isotope
+      ISO=IMICR(JSO) ! microlib isotope
+      IF(ISO.EQ.0) GO TO 180
+      WRITE(HNAME,'(3A4)') (HUSE1(I0,JSO),I0=1,3)
+      CALL LCMOP(KPLIB,'*ISOTOPE*',0,1,0)
+      IPLIST(ISO)=KPLIB ! set isot ISO
+      CALL PCRISO(KPLIB,JPTMP,HNAME,JSO,NCAL,NGRP,NL,NED2,HVECT2,NDEL,
+     1 IMPX,TERP(1,IBM))
+  180 CONTINUE
+      DEALLOCATE(IMICR)
+      CALL LCMCL(IPTMP,2)
+  190 CONTINUE
+*----
+*  END OF LOOP OVER MICROLIB MIXTURES
+*----
+*----
+*  CREATE ISOTOPE LIST DIRECTORY IN MICROLIB
+*----
+      JPLIB=LCMLID(IPLIB,'ISOTOPESLIST',NBISO2)
+      DO 195 ISO=1,NBISO2 ! microlib isotope
+      IF(C_ASSOCIATED(IPLIST(ISO))) THEN
+        KPLIB=LCMDIL(JPLIB,ISO) ! step up isot ISO
+        CALL LCMEQU(IPLIST(ISO),KPLIB)
+        CALL LCMCL(IPLIST(ISO),2)
+        IPLIST(ISO)=C_NULL_PTR
+      ENDIF
+  195 CONTINUE
+*----
+*  MICROLIB FINALIZATION
+*----
+      ISTATE(:NSTATE)=0
+      ISTATE(1)=NMIX
+      ISTATE(2)=NBISO2
+      ISTATE(3)=NGRP
+      ISTATE(4)=NL
+      ISTATE(5)=ITRANC
+      ISTATE(7)=1
+      ISTATE(11)=NDEPL
+      ISTATE(12)=NCOMB+NCOMB2
+      ISTATE(13)=NED2
+      ISTATE(14)=NMIX
+      ISTATE(18)=1
+      ISTATE(19)=NDEL
+      ISTATE(22)=MAXISO/NMIX
+      IF(NBISO2.EQ.0) CALL XABORT('PCRMIC: NBISO2=0.')
+      CALL LCMPUT(IPLIB,'STATE-VECTOR',NSTATE,1,ISTATE)
+      CALL LCMPUT(IPLIB,'ISOTOPESUSED',3*NBISO2,3,HUSE2)
+      CALL LCMPUT(IPLIB,'ISOTOPERNAME',3*NBISO2,3,HNAM2)
+      CALL LCMPUT(IPLIB,'ISOTOPESDENS',NBISO2,2,DENS2)
+      CALL LCMPUT(IPLIB,'ISOTOPESMIX',NBISO2,1,IMIX2)
+      IF(NED2.GT.0) CALL LCMPTC(IPLIB,'ADDXSNAME-P0',8,NED2,HVECT2)
+      CALL LCMPUT(IPLIB,'ISOTOPESTODO',NBISO2,1,ITOD2)
+      CALL LCMPUT(IPLIB,'ISOTOPESTYPE',NBISO2,1,ISTY2)
+      CALL LCMPUT(IPLIB,'ENERGY',NGRP+1,2,ENER)
+      IF(IMPX.GT.5) CALL LCMLIB(IPLIB)
+      IACCS=1
+*----
+*  BUILD EMBEDDED MACROLIB
+*----
+      CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+      MAXMIX=ISTATE(1)
+      IF(MAXMIX.NE.NMIX) CALL XABORT('PCRMIC: INVALID NMIX.')
+      NBISO=ISTATE(2)
+      ALLOCATE(MASKL(NGRP))
+      CALL LCMGPD(IPLIB,'ISOTOPESUSED',ISONA_PTR)
+      CALL LCMGPD(IPLIB,'ISOTOPESMIX',ISOMI_PTR)
+      CALL LCMGPD(IPLIB,'ISOTOPESDENS',DENIS_PTR)
+      CALL C_F_POINTER(ISONA_PTR,ISONA,(/ NBISO /))
+      CALL C_F_POINTER(ISOMI_PTR,ISOMI,(/ NBISO /))
+      CALL C_F_POINTER(DENIS_PTR,DENIS,(/ NBISO /))
+      MASKL(:NGRP)=.TRUE.
+      ITSTMP=0
+      TMPDAY(1)=0.0
+      TMPDAY(2)=0.0
+      TMPDAY(3)=0.0
+      CALL LIBMIX(IPLIB,MAXMIX,NGRP,NBISO,ISONA,ISOMI,DENIS,LMIXC,MASKL,
+     1 ITSTMP,TMPDAY)
+      DEALLOCATE(MASKL)
+*----
+*  INCLUDE LEAKAGE IN THE MACROLIB (USED ONLY FOR NON-REGRESSION TESTS)
+*----
+      IF(B2.NE.0.0) THEN
+        IF(IMPX.GT.0) WRITE(6,'(/34H PCRMIC: INCLUDE LEAKAGE IN THE MA,
+     1  11HCROLIB (B2=,1P,E12.5,2H).)') B2
+        CALL LCMSIX(IPLIB,'MACROLIB',1)
+        JPLIB=LCMGID(IPLIB,'GROUP')
+        ALLOCATE(GAR1(NMIX),GAR2(NMIX))
+        DO 210 IGR=1,NGRP
+          KPLIB=LCMGIL(JPLIB,IGR)
+          CALL LCMGET(KPLIB,'NTOT0',GAR1)
+          CALL LCMGET(KPLIB,'DIFF',GAR2)
+          DO 200 IBM=1,NMIX
+            IF(LMIXC(IBM)) GAR1(IBM)=GAR1(IBM)+B2*GAR2(IBM)
+  200     CONTINUE
+          CALL LCMPUT(KPLIB,'NTOT0',NMIX,2,GAR1)
+  210   CONTINUE
+        DEALLOCATE(GAR2,GAR1)
+        CALL LCMSIX(IPLIB,' ',2)
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(ENER,DENS2)
+      DEALLOCATE(IPLIST,MILVO,HNAM2,HUSE2,ISTY2,ITOD2,IMIX2,HUSE1)
+      RETURN
+      END
diff --git a/Donjon/src/PCRONE.f b/Donjon/src/PCRONE.f
new file mode 100644
index 0000000..bb8aee2
--- /dev/null
+++ b/Donjon/src/PCRONE.f
@@ -0,0 +1,346 @@
+*DECK PCRONE
+      SUBROUTINE PCRONE(IMPX,ICAL,IPMIC,NCAL,NGRP,XS_CALC)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Copy an elementary calculation of the PMAXS file into a microlib.
+*
+*Copyright:
+* Copyright (C) 2019 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert and D. Calic
+*
+*Parameters: input
+* IMPX    print parameter.
+* ICAL    index of the elementary calculation.
+* IPMIC   address of the microlib.
+* NCAL    number of elementary calculations in the PMAXS file.
+* NGRP    number of energy groups.
+* XS_CALC pointers towards PMAXS elementary calculations.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      USE PCRDATA
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER IMPX,ICAL,NCAL,NGRP
+      TYPE(C_PTR) IPMIC
+      TYPE(XSBLOCK_ITEM),TARGET :: XS_CALC(NCAL)
+*----
+*  LOCAL VARIABLES
+*----
+      TYPE(C_PTR) JPMIC,KPMIC
+      INTEGER NSTATE
+      PARAMETER(NSTATE=40)
+      INTEGER ISTATE(NSTATE),ITYPR(1)
+      REAL DENS(3)
+      DOUBLE PRECISION DELTA
+      LOGICAL LEX
+      CHARACTER(LEN=8) :: HVECT(3)
+      CHARACTER(LEN=12) :: HNAME,HISONA(3)
+      CHARACTER(LEN=131) :: HSMG
+      TYPE(XSBLOCK_TYPE),POINTER :: XSONE,XSREF
+      TYPE(TH_INDEP_VAR),POINTER :: TIVONE
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      REAL, ALLOCATABLE, DIMENSION(:) :: SIG1,GAR,ENERGY
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: SIG2
+*----
+*  SET SIGNATURE AND STATE VECTOR
+*----
+      INQUIRE(FILE='PCRONE.txt',EXIST=LEX)
+      IF(LEX) THEN
+        NUNIT=KDROPN('PCRONE.txt',1,3,0)
+      ELSE
+        NUNIT=KDROPN('PCRONE.txt',0,3,0)
+      ENDIF
+      IF(NUNIT.LE.0) THEN
+        WRITE(HSMG,'(28HPCRONE: KDROPN FAILURE (IER=,I5,2H).)') NUNIT
+        CALL XABORT(HSMG)
+      ENDIF
+
+      NED=1
+      HVECT(1)='H-FACTOR'
+      IF(NXST.GE.7) THEN
+         NED=2
+         HVECT(2)='NFTOT'
+      ENDIF
+      IF(NXST.EQ.8) THEN
+         NED=3
+         HVECT(3)='DETEC'
+      ENDIF
+      NBISO=1 ! number of isotopes
+      IF(NXST.GT.4) NBISO=3 ! include Xe and Sm
+      HNAME='L_LIBRARY'
+      CALL LCMPTC(IPMIC,'SIGNATURE',12,HNAME)
+      ISTATE(:)=0
+      ISTATE(1)=1
+      ISTATE(2)=NBISO
+      ISTATE(3)=NGRP
+      ISTATE(4)=1 ! isotropic scattering
+      ISTATE(13)=NED ! number of additional edits
+      ISTATE(19)=NDLAY ! number of delayed neutron groups
+      CALL LCMPUT(IPMIC,'STATE-VECTOR',NSTATE,1,ISTATE)
+      CALL LCMPTC(IPMIC,'ADDXSNAME-P0',8,NED,HVECT)
+      JPMIC=LCMLID(IPMIC,'ISOTOPESLIST',NBISO)
+*
+      ALLOCATE(SIG1(NGRP),SIG2(NGRP,NGRP))
+      XSONE=>XS_CALC(ICAL)%XS
+      XSREF=>XS_CALC(XS_CALC(ICAL)%IBURN)%XS
+      WRITE(NUNIT,*)XS_CALC(ICAL)%IBURN
+      TIVONE=>XS_CALC(ICAL)%TIV
+      KPMIC=LCMDIL(JPMIC,1) ! step up isot 1
+      HISONA(1)='*MAC*RES'
+      DENS(1)=1.0
+      CALL LCMPTC(KPMIC,'ALIAS',12,HISONA(1))
+*----
+*  PROCESS VECTORIAL CROSS SECTIONS
+*----
+*    1   2   3   4   5   6   7
+*   xtr,xab,xnf,xkf,xfi,xxe,xsm
+*----
+*  RUN ELEMENTARY CALC IN CASE THE PMAXS FILE IS GIVEN AS DERIVATIVES
+*----
+      IF(derivatives) THEN
+        DELTA=XS_CALC(ICAL)%DELTA
+        DO IG=1,NGRP
+          SIG1(IG)=REAL(XSREF%sig(IG,1)+DELTA*XSONE%sig(IG,1))
+        ENDDO
+        CALL LCMPUT(KPMIC,'STRD',NGRP,2,SIG1)
+        DO IG=1,NGRP
+          SIG1(IG)=REAL(XSREF%sig(IG,2)+SUM(XSREF%sct(IG,:))+DELTA*
+     1    XSONE%sig(IG,2)+SUM(XSONE%sct(IG,:)))
+        ENDDO
+        CALL LCMPUT(KPMIC,'NTOT0',NGRP,2,SIG1)
+        DO IG=1,NGRP
+          SIG1(IG)=REAL(XSREF%sig(IG,3)+DELTA*XSONE%sig(IG,3))
+          WRITE(NUNIT,*)SIG1(IG)
+        ENDDO
+        CALL LCMPUT(KPMIC,'NUSIGF',NGRP,2,SIG1)
+        DO IG=1,NGRP
+          SIG1(IG)=REAL(XSREF%sig(IG,4)+DELTA*XSONE%sig(IG,4))
+        ENDDO
+        CALL LCMPUT(KPMIC,'H-FACTOR',NGRP,2,SIG1)
+        IF(NXST.GT.4) THEN
+          DO IG=1,NGRP
+            SIG1(IG)=REAL(XSREF%sig(IG,7)+DELTA*XSONE%sig(IG,7))
+          ENDDO
+          CALL LCMPUT(KPMIC,'NFTOT',NGRP,2,SIG1)
+          SIG1(:NGRP)=0.0
+          SIG1(1)=1.0
+          CALL LCMPUT(KPMIC,'CHI',NGRP,2,SIG1)
+        ENDIF
+        IF(NXST.EQ.8) THEN
+          DO IG=1,NGRP
+            SIG1(IG)=REAL(XSREF%sig(IG,8)+DELTA*XSONE%sig(IG,8))
+          ENDDO
+          CALL LCMPUT(KPMIC,'DETEC',NGRP,2,SIG1)
+        ENDIF
+        IF(lamb) THEN
+          ALLOCATE(GAR(ELAM-BLAM+1))
+          GAR(:ELAM-BLAM+1)=REAL(TIVONE%kinp(BLAM:ELAM))
+          CALL LCMPUT(KPMIC,'LAMBDA',ELAM-BLAM+1,2,GAR)
+          DEALLOCATE(GAR)
+        ENDIF
+        DO j=1,iXSTI
+          k=iTIV(j)
+          IF(k.GT.0) THEN
+            DO IG=1,NGRP
+              SIG1(IG)=REAL(TIVONE%sig(IG,k))
+            ENDDO
+            IF(j.EQ.1) THEN
+              CALL LCMPUT(KPMIC,'CHI',NGRP,2,SIG1)
+            ELSE IF(j.EQ.2) THEN
+              CALL LCMPUT(KPMIC,'CHID',NGRP,2,SIG1)
+            ELSE IF(j.EQ.3) THEN
+              CALL LCMPUT(KPMIC,'INVEL',NGRP,2,SIG1)
+            ENDIF
+          ENDIF
+        ENDDO
+*----
+*  PROCESS SCATTERING INFORMATION (JG --> IG)
+*----
+        DO IG=1,NGRP
+          SIG1(IG)=REAL(SUM(XSREF%sct(IG,:))+DELTA*SUM(XSONE%sct(IG,:)))
+          DO JG=1,NGRP
+            SIG2(IG,JG)=REAL(XSREF%sct(JG,IG)+DELTA*XSONE%sct(JG,IG))
+          ENDDO
+        ENDDO
+        ITYPR(1)=1
+        CALL XDRLGS(KPMIC,1,IMPX,0,0,1,NGRP,SIG1,SIG2,ITYPR)
+        IF(IMPX.GT.5) CALL LCMLIB(KPMIC)
+*----
+*  PROCESS Xe and Sm
+*----
+        IF(NXST.GT.4) THEN
+          KPMIC=LCMDIL(JPMIC,2) ! step up isot 2
+          HISONA(2)='Xe135'
+          DENS(2)=0.0
+          CALL LCMPTC(KPMIC,'ALIAS',12,HISONA(2))
+          DO IG=1,NGRP
+            SIG1(IG)=REAL(XSREF%sig(IG,5)+DELTA*XSONE%sig(IG,5))
+          ENDDO
+          CALL LCMPUT(KPMIC,'NTOT0',NGRP,2,SIG1)
+          CALL LCMPUT(KPMIC,'STRD',NGRP,2,SIG1)
+          DO IG=1,NGRP
+            SIG1(IG)=0.0
+            DO JG=1,NGRP
+              SIG2(IG,JG)=0.0
+            ENDDO
+          ENDDO
+          ITYPR(1)=1
+          CALL XDRLGS(KPMIC,1,IMPX,0,0,1,NGRP,SIG1,SIG2,ITYPR)
+          KPMIC=LCMDIL(JPMIC,3) ! step up isot 3
+          HISONA(3)='Sm149'
+          DENS(3)=0.0
+          CALL LCMPTC(KPMIC,'ALIAS',12,HISONA(3))
+          DO IG=1,NGRP
+            SIG1(IG)=REAL(XSREF%sig(IG,6)+DELTA*XSONE%sig(IG,6))
+          ENDDO
+          CALL LCMPUT(KPMIC,'NTOT0',NGRP,2,SIG1)
+          CALL LCMPUT(KPMIC,'STRD',NGRP,2,SIG1)
+          DO IG=1,NGRP
+            SIG1(IG)=0.0
+            DO JG=1,NGRP
+              SIG2(IG,JG)=0.0
+            ENDDO
+          ENDDO
+          ITYPR(1)=1
+          CALL XDRLGS(KPMIC,1,IMPX,0,0,1,NGRP,SIG1,SIG2,ITYPR)
+        ENDIF
+        CALL LCMPTC(IPMIC,'ISOTOPESUSED',12,NBISO,HISONA)
+        CALL LCMPUT(IPMIC,'ISOTOPESDENS',NBISO,2,DENS)
+        DEALLOCATE(SIG2,SIG1)
+      ELSE
+*----
+*  RUN ELEMENTARY CALC IN CASE THE PMAXS FILE IS GIVEN AS RAW CROSS
+*  SECTIONS
+*----
+        DELTA=XS_CALC(ICAL)%DELTA
+        DO IG=1,NGRP
+          SIG1(IG)=REAL(XSONE%sig(IG,1))
+        ENDDO
+        CALL LCMPUT(KPMIC,'STRD',NGRP,2,SIG1)
+        DO IG=1,NGRP
+          SIG1(IG)=REAL(XSONE%sig(IG,2)+SUM(XSONE%sct(IG,:)))
+        ENDDO
+        CALL LCMPUT(KPMIC,'NTOT0',NGRP,2,SIG1)
+        DO IG=1,NGRP
+          SIG1(IG)=REAL(XSONE%sig(IG,3))
+          WRITE(NUNIT,*)XSONE%sig(IG,3)
+        ENDDO
+        CALL LCMPUT(KPMIC,'NUSIGF',NGRP,2,SIG1)
+        DO IG=1,NGRP
+          SIG1(IG)=REAL(XSONE%sig(IG,4))
+        ENDDO
+        CALL LCMPUT(KPMIC,'H-FACTOR',NGRP,2,SIG1)
+        IF(NXST.GT.4) THEN
+          DO IG=1,NGRP
+            SIG1(IG)=REAL(XSONE%sig(IG,7))
+          ENDDO
+          CALL LCMPUT(KPMIC,'NFTOT',NGRP,2,SIG1)
+          SIG1(:NGRP)=0.0
+          SIG1(1)=1.0
+          CALL LCMPUT(KPMIC,'CHI',NGRP,2,SIG1)
+        ENDIF
+        IF(NXST.EQ.8) THEN
+          DO IG=1,NGRP
+            SIG1(IG)=REAL(XSONE%sig(IG,8))
+          ENDDO
+          CALL LCMPUT(KPMIC,'DETEC',NGRP,2,SIG1)
+        ENDIF
+        IF(lamb) THEN
+          ALLOCATE(GAR(ELAM-BLAM+1))
+          GAR(:ELAM-BLAM+1)=REAL(TIVONE%kinp(BLAM:ELAM))
+          CALL LCMPUT(KPMIC,'LAMBDA',ELAM-BLAM+1,2,GAR)
+          DEALLOCATE(GAR)
+        ENDIF
+        DO j=1,iXSTI
+          k=iTIV(j)
+          IF(k.GT.0) THEN
+            DO IG=1,NGRP
+              SIG1(IG)=REAL(TIVONE%sig(IG,k))
+            ENDDO
+            IF(j.EQ.1) THEN
+              CALL LCMPUT(KPMIC,'CHI',NGRP,2,SIG1)
+            ELSE IF(j.EQ.2) THEN
+              CALL LCMPUT(KPMIC,'CHID',NGRP,2,SIG1)
+            ELSE IF(j.EQ.3) THEN
+              CALL LCMPUT(KPMIC,'INVEL',NGRP,2,SIG1)
+            ENDIF
+          ENDIF
+        ENDDO
+*----
+*  PROCESS SCATTERING INFORMATION
+*----
+        DO IG=1,NGRP
+           SIG1(IG)=REAL(SUM(XSONE%sct(IG,:)))
+          DO JG=1,NGRP
+            SIG2(IG,JG)=REAL(XSONE%sct(JG,IG)) ! JG --> IG
+          ENDDO
+        ENDDO
+        ITYPR(1)=1
+        CALL XDRLGS(KPMIC,1,IMPX,0,0,1,NGRP,SIG1,SIG2,ITYPR)
+        IF(IMPX.GT.5) CALL LCMLIB(KPMIC)
+*----
+*  PROCESS Xe and Sm
+*----
+        IF(NXST.GT.4) THEN
+          KPMIC=LCMDIL(JPMIC,2) ! step up isot 2
+          HISONA(2)='Xe135'
+          DENS(2)=0.0
+          CALL LCMPTC(KPMIC,'ALIAS',12,HISONA(2))
+          DO IG=1,NGRP
+            SIG1(IG)=REAL(XSONE%sig(IG,5))
+          ENDDO
+          CALL LCMPUT(KPMIC,'NTOT0',NGRP,2,SIG1)
+          CALL LCMPUT(KPMIC,'STRD',NGRP,2,SIG1)
+          DO IG=1,NGRP
+            SIG1(IG)=0.0
+            DO JG=1,NGRP
+              SIG2(IG,JG)=0.0
+            ENDDO
+          ENDDO
+          ITYPR(1)=1
+          CALL XDRLGS(KPMIC,1,IMPX,0,0,1,NGRP,SIG1,SIG2,ITYPR)
+          KPMIC=LCMDIL(JPMIC,3) ! step up isot 3
+          HISONA(3)='Sm149'
+          DENS(3)=0.0
+          CALL LCMPTC(KPMIC,'ALIAS',12,HISONA(3))
+          DO IG=1,NGRP
+            SIG1(IG)=REAL(XSONE%sig(IG,6))
+          ENDDO
+          CALL LCMPUT(KPMIC,'NTOT0',NGRP,2,SIG1)
+          CALL LCMPUT(KPMIC,'STRD',NGRP,2,SIG1)
+          DO IG=1,NGRP
+            SIG1(IG)=0.0
+            DO JG=1,NGRP
+              SIG2(IG,JG)=0.0
+            ENDDO
+          ENDDO
+          ITYPR(1)=1
+          CALL XDRLGS(KPMIC,1,IMPX,0,0,1,NGRP,SIG1,SIG2,ITYPR)
+        ENDIF
+        CALL LCMPTC(IPMIC,'ISOTOPESUSED',12,NBISO,HISONA)
+        CALL LCMPUT(IPMIC,'ISOTOPESDENS',NBISO,2,DENS)
+        DEALLOCATE(SIG2,SIG1)
+      ENDIF
+      CLOSE(NUNIT)
+*----
+*  SET ENERGY MESH
+*----
+      ALLOCATE(ENERGY(NGRP+1))
+      IF(NGRP.EQ.2) THEN
+        ENERGY(:)=(/ 1.964E7,  6.25E-1,  1.1E-4 /)
+      ELSE
+        CALL XABORT('PCRONE: UNKNOWN ENERGY MESH')
+      ENDIF
+      CALL LCMPUT(IPMIC,'ENERGY',NGRP+1,2,ENERGY)
+      DEALLOCATE(ENERGY)
+      RETURN
+      END
diff --git a/Donjon/src/PCRRGR.f b/Donjon/src/PCRRGR.f
new file mode 100644
index 0000000..85dfecb
--- /dev/null
+++ b/Donjon/src/PCRRGR.f
@@ -0,0 +1,860 @@
+*DECK PCRRGR
+      SUBROUTINE PCRRGR(IPMAP,LCUBIC,NMIX,IMPX,NCAL,NCH,NB,NFUEL,
+     1 NPARM,ITER,MAXNIS,TERP,NISO,HISO,CONC,LMIXC,XS_CALC)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute TERP factors for PMAXS file interpolation. Use global and
+* local parameters from a fuel-map object and optional user-defined
+* values.
+*
+*Copyright:
+* Copyright (C) 2019 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPMAP   address of the fuel-map object.
+* LCUBIC  =.TRUE.: cubic Ceschino interpolation; =.FALSE: linear
+*         Lagrange interpolation.
+* NMIX    number of material mixtures in the fuel-map macrolib.
+* IMPX    printing index (=0 for no print).
+* NCAL    number of elementary calculations in the PMAXS file.
+* NCH     number of reactor channels.
+* NB      number of fuel bundles per channel.
+* NFUEL   number of fuel types.
+* NPARM   number of additional parameters (other than burnup) defined
+*         in FMAP object
+*
+*Parameters: output
+* ITER    completion flag (=0: all over; =1: use another PMAXS file;
+*         =2 use another L_MAP + PMAXS file).
+* MAXNIS  maximum value of NISO(I) in user data.
+* TERP    interpolation factors.
+* NISO    number of user-selected isotopes.
+* HISO    name of the user-selected isotopes.
+* CONC    user-defined number density of the user-selected isotopes.
+* LMIXC   flag set to .true. for fuel-map mixtures to process.
+* XS_CALC pointers towards PMAXS elementary calculations.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      USE PCRDATA
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER, PARAMETER::MAXISD=400
+      TYPE(C_PTR) IPMAP
+      INTEGER NMIX,IMPX,NCAL,NFUEL,NCH,NB,ITER,MAXNIS,NPARM,
+     1 HISO(2,NMIX,MAXISD),NISO(NMIX)
+      REAL TERP(NCAL,NMIX),CONC(NMIX,MAXISD)
+      LOGICAL LCUBIC,LMIXC(NMIX)
+      TYPE(XSBLOCK_ITEM) XS_CALC(NCAL)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXADD=10
+      INTEGER, PARAMETER::MAXLIN=50
+      INTEGER, PARAMETER::MAXPAR=50
+      INTEGER, PARAMETER::MAXVAL=200
+      REAL, PARAMETER::REPS=1.0E-4
+      REAL BURN0, BURN1, FLOTT, SUM, VALR1, VALR2, VARVAL
+      INTEGER I0, IBM, IBTYP, IB, ICAL, ICH, IFUEL, ILONG, IMIX,
+     & IMPY, INDIC, IPAR, ISO, ITYPE, ITYP, IVARTY, I, JBM, JB,
+     & JCAL, JPARM, JPAR, J, NCOMLI, NISOMI, NITMA, NPARMP, NPAR,
+     & NTOT, N, IBRA, IBSET, NBURN, IND, II, INDELT, NNV
+      CHARACTER TEXT12*12,PARKEY(MAXPAR)*12,HSMG*131,RECNAM*12,
+     1 COMMEN(MAXLIN)*80,PARNAM*12,HCUBIC*12,HNAVAL*12
+      INTEGER NVALUE(MAXPAR),MUPLET(MAXPAR),MUTYPE(MAXPAR),
+     1 MAPLET(MAXPAR,MAXADD),MATYPE(MAXPAR,MAXADD),IDLTA(MAXPAR,MAXADD),
+     2 NDLTA(MAXPAR),IDLTA1,MUPLT2(MAXPAR),MUTYP2(MAXPAR),
+     3 HISOMI(2,MAXISD)
+      DOUBLE PRECISION DFLOTT
+      REAL VALR(MAXPAR,2),VREAL(MAXVAL,MAXPAR),CONCMI(MAXISD),
+     1 VALRA(MAXPAR,2,MAXADD)
+      LOGICAL LDELT(MAXPAR),LDELT1,LSET(MAXPAR),LADD(MAXPAR),
+     1 LSET1,LADD1,LDMAP(MAXPAR,2),LAMAP(MAXPAR,2,MAXADD),
+     2 LCUB2(MAXPAR),LTST
+      TYPE(C_PTR) JPMAP,KPMAP
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: FMIX,ZONEC
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ZONEDP,MUBASE
+      REAL, ALLOCATABLE, DIMENSION(:) :: BRN0,BRN1,VARC,TERPA
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: WPAR
+      LOGICAL, ALLOCATABLE, DIMENSION(:) :: LPARM,LDELTA
+      CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: HPAR
+*----
+*  SCRATCH STORAGE ALLOCATION
+*   FMIX    fuel mixture indices per fuel bundle.
+*   BRN0    contains either low burnup integration limits or
+*           instantaneous burnups per fuel bundle.
+*   BRN1    upper burnup integration limits per fuel bundle.
+*   WPAR    other parameter distributions.
+*   HPAR    'PARKEY' name of the other parameters.
+*----
+      ALLOCATE(LPARM(NPARM+1),FMIX(NCH*NB),ZONEDP(NCH,NB),
+     1 ZONEC(NCH),BRN0(NCH*NB),BRN1(NCH*NB),WPAR(NCH*NB,NPARM),
+     2 LDELTA(NMIX),HPAR(NPARM+1))
+*----
+*  RECOVER TABLE-OF-CONTENT INFORMATION FOR THE PMAXS FILE. THE I-TH
+*  PMAXS FILE INFORMATION CORRESPONDS TO POINTERS bran_i and PMAX.
+*----
+      NPAR=bran_i%Nstat_var
+      NVALUE(:NPAR)=0
+      DO IPAR=1,bran_i%Nstat_var
+        PARKEY(IPAR)=bran_i%var_nam(IPAR)
+      ENDDO
+      IF(PMAX%NBset.GT.0) THEN
+        NPAR=NPAR+1
+        PARKEY(NPAR)='B'
+        NVALUE(NPAR)=PMAX%Bset(1)%NBURN
+        NNV=NVALUE(NPAR)
+        VREAL(:NNV,NPAR)=REAL(PMAX%Bset(1)%burns(:NNV))
+        VREAL(:NNV,NPAR)=REAL(PMAX%Bset(1)%burns(:NNV))*1000.0
+      ENDIF
+      IF(NPAR.GT.MAXPAR) CALL XABORT('PCRRGR: MAXPAR OVERFLOW.')
+      IF(NHST.NE.1) CALL XABORT('PCRRGR: MULTIPLE HISTORY CASE NOT IMP'
+     1 //'LEMENTED.')
+      NCOMLI=6
+      COMMEN(:6)=hcomment(:6)
+      DO IBRA=1,NBRA
+        DO IPAR=1,bran_i%Nstat_var
+          FLOTT=REAL(bran_i%state(IPAR,IBRA))
+          IF(PARKEY(IPAR).EQ.'TF') FLOTT=(FLOTT**2)-273.15
+          IF(NVALUE(IPAR).EQ.0) THEN
+            NVALUE(IPAR)=1
+            VREAL(1,IPAR)=FLOTT
+          ELSE
+            DO I=1,NVALUE(IPAR)
+              IF(FLOTT.EQ.VREAL(I,IPAR)) THEN
+                GO TO 10
+              ELSE IF(FLOTT.LT.VREAL(I,IPAR)) THEN
+                DO J=NVALUE(IPAR),I,-1
+                  VREAL(J+1,IPAR)=VREAL(J,IPAR)
+                ENDDO
+                VREAL(I,IPAR)=FLOTT
+                NVALUE(IPAR)=NVALUE(IPAR)+1
+                GO TO 10
+              ENDIF
+            ENDDO
+            IF(FLOTT.GT.VREAL(NVALUE(IPAR),IPAR)) THEN
+              NVALUE(IPAR)=NVALUE(IPAR)+1
+              VREAL(NVALUE(IPAR),IPAR)=FLOTT
+            ENDIF
+          ENDIF
+   10     CONTINUE
+        ENDDO
+      ENDDO
+      IF((IMPX.GT.0).AND.(bran_i%Nstat_var.GT.0))THEN
+        DO IPAR=1,NPAR
+          WRITE(RECNAM,'(''pval'',I8.8)') IPAR
+          WRITE(IOUT,'(13H PCRRGR: KEY=,A,18H TABULATED POINTS=,
+     1    1P,6E12.4/(43X,6E12.4))') PARKEY(IPAR),(VREAL(I,IPAR),I=1,
+     2    NVALUE(IPAR))
+        ENDDO
+      ENDIF
+*----
+*  PRINT PMAXS FILE AND FUELMAP STATISTICS
+*----
+      IF(IMPX.GT.0) THEN
+        WRITE(IOUT,'(43H PCRRGR: NUMBER OF CALCULATIONS IN PMAXS FI,
+     1  3HLE=,I6)') NCAL
+        WRITE(IOUT,'(43H PCRRGR: NUMBER OF MATERIAL MIXTURES IN FUE,
+     1  6HL MAP=,I6)') NMIX
+        WRITE(IOUT,'(43H PCRRGR: NUMBER OF LOCAL VARIABLES INCLUDIN,
+     1  9HG BURNUP=,I6)') NPAR
+        WRITE(IOUT,'(28H PCRRGR: PMAXS FILE COMMENTS,60(1H-))')
+        WRITE(IOUT,'(1X,A)') (COMMEN(I),I=1,NCOMLI)
+        WRITE(IOUT,'(9H PCRRGR: ,79(1H-))')
+      ENDIF
+*----
+*  SCAN THE PMAXS FILE INFORMATION TO RECOVER THE MUPLET DATABASE
+*----
+      IF(IMPX.GT.5) THEN
+        WRITE(IOUT,'(24H PCRRGR: MUPLET DATABASE/12H CALCULATION,4X,
+     1  6HMUPLET)')
+        WRITE(IOUT,'(16X,20A4)') PARKEY(:NPAR)
+      ENDIF
+      ALLOCATE(MUBASE(NPAR,NCAL))
+      ICAL=0
+      DO IBRA=1,NBRA
+        INDELT=0
+        DO IPAR=1,NPAR
+          IF(bran_i%state_nam(IBRA).EQ.PARKEY(IPAR)) THEN
+            INDELT=IPAR
+            CYCLE
+          ENDIF
+        ENDDO
+        IBSET=PMAX%BRANCH(IBRA,1)%IBSET
+        NBURN=PMAX%Bset(IBSET)%NBURN
+        DO IPAR=1,bran_i%Nstat_var
+          FLOTT=REAL(bran_i%state(IPAR,IBRA))
+          IF(PARKEY(IPAR).EQ.'TF') FLOTT=(FLOTT**2)-273.15
+          IND=0
+          DO I=1,NVALUE(IPAR)
+            IF(FLOTT.EQ.VREAL(I,IPAR)) THEN
+               IND=I
+               EXIT
+            ENDIF
+          ENDDO
+          IF(IND.EQ.0) THEN
+            CALL XABORT('PCRRGR: MUPLET ALGORITHM FAILURE.')
+          ELSE
+            MUPLET(IPAR)=IND
+          ENDIF
+        ENDDO
+        IF((NBURN.EQ.PMAX%Bset(1)%NBURN).OR.(NBURN.EQ.1)) THEN
+          DO I=1,NBURN
+            MUPLET(bran_i%Nstat_var+1)=I
+            II=ICAL+I
+            MUBASE(:bran_i%Nstat_var+1,II)=MUPLET(:bran_i%Nstat_var+1)
+            XS_CALC(ICAL+I)%IBURN=I
+            XS_CALC(ICAL+I)%XS=>PMAX%BRANCH(IBRA,1)%XS(I)
+            XS_CALC(ICAL+I)%TIV=>PMAX%TIVB(1)%TIV(I)
+            IF(INDELT.GT.0) THEN
+              XS_CALC(ICAL+I)%DELTA=bran_i%state(INDELT,IBRA)-
+     1        bran_i%state(INDELT,1)
+            ELSE
+              XS_CALC(ICAL+I)%DELTA=0.0
+            ENDIF
+          ENDDO
+        ELSE
+          CALL XABORT('PCRRGR: INVALID VALUE OF NBURN.')
+        ENDIF
+        IF(IMPX.GT.5) THEN
+          DO I=ICAL+1,ICAL+NBURN
+            WRITE(IOUT,'(I8,2X,A2,2X,20I4/(14X,20I4))') I,
+     1      bran_i%state_nam(IBRA),MUBASE(:NPAR,I)
+          ENDDO
+        ENDIF
+        ICAL=ICAL+NBURN
+      ENDDO !IBRA
+      IF(ICAL.NE.NCAL) CALL XABORT('PCRRGR: MUPLET ALGORITHM FAILURE.')
+*----
+*  READ (INTERP_DATA) AND SET VALR PARAMETERS CORRESPONDING TO THE
+*  INTERPOLATION POINT. FILL MUPLET FOR PARAMETERS SET WITHOUT
+*  INTERPOLATION.
+*----
+      IBM=0
+      MAXNIS=0
+      NISOMI=0
+      LDELT1=.FALSE.
+      LADD1=.FALSE.
+      NISO(:NMIX)=0
+      LDELTA(:NMIX)=.FALSE.
+      IDLTA1=0
+      DO I=1,MAXPAR
+         LSET(I)=.FALSE.
+         LDELT(I)=.FALSE.
+         LADD(I)=.FALSE.
+         LDMAP(I,:2)=.FALSE.
+         LAMAP(I,:2,:MAXADD)=.FALSE.
+         NDLTA(I)=0
+      ENDDO
+      TERP(:NCAL,:NMIX)=0.0
+      LMIXC(:NMIX)=.FALSE.
+*----
+*  ADD THE PARKEY NAME OF THE BURNUP FOR THIS PMAX FILE.
+*----
+      NPARMP=NPARM+1
+      HPAR(NPARMP)='B'
+*----
+*  MAIN LOOP OF THE SUBROUTINE (UNTIL THE END)
+*----
+   20 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+      IF(INDIC.NE.3)CALL XABORT('PCRRGR: CHARACTER DATA EXPECTED(2).')
+   30 IF(TEXT12.EQ.'MIX')THEN
+        NISOMI=0
+        IVARTY=0
+        IBTYP=0
+        HNAVAL=' '
+        MUPLET(:NPAR)=0
+        MUTYPE(:NPAR)=0
+        VALR(:NPAR,1)=0.0
+        VALR(:NPAR,2)=0.0
+        DO 35 I=1,MAXADD
+          MAPLET(:NPAR,I)=0
+          MATYPE(:NPAR,I)=0
+          VALRA(:NPAR,1,I)=0.0
+          VALRA(:NPAR,2,I)=0.0
+   35   CONTINUE
+        DO I=1,MAXPAR
+          LSET(I)=.FALSE.
+          LDELT(I)=.FALSE.
+          LADD(I)=.FALSE.
+          LDMAP(I,:2)=.FALSE.
+          LAMAP(I,:2,:MAXADD)=.FALSE.
+        ENDDO
+        LCUB2(:NPAR)=LCUBIC
+        CALL REDGET(INDIC,IBM,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1)CALL XABORT('PCRRGR: INTEGER DATA EXPECTED.')
+*       CHECK FUEL MIXTURE
+        JPMAP=LCMGID(IPMAP,'FUEL')
+        DO IFUEL=1,NFUEL
+          KPMAP=LCMGIL(JPMAP,IFUEL)
+          CALL LCMGET(KPMAP,'MIX',IMIX)
+          IF(IMIX.EQ.IBM)GOTO 50
+        ENDDO
+        WRITE(IOUT,*)'PCRRGR: UNABLE TO FIND FUEL MIXTURE ',IBM
+        CALL XABORT('PCRRGR: WRONG MIXTURE NUMBER.')
+   50   CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3)CALL XABORT('PCRRGR: CHARACTER DATA EXPECTED(3).')
+        GOTO 30
+      ELSEIF(TEXT12.EQ.'MICRO')THEN
+        IF(IBM.EQ.0) CALL XABORT('PCRRGR: MIX NOT SET (1).')
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3)CALL XABORT('PCRRGR: CHARACTER DATA EXPECTED(5).')
+   60   IF(TEXT12.EQ.'ENDMIX')THEN
+          GOTO 30
+        ELSE
+          NISOMI=NISOMI+1
+          IF(NISOMI.GT.MAXISD) CALL XABORT('PCRRGR: MAXISD OVERFLOW.')
+          MAXNIS=MAX(MAXNIS,NISOMI)
+          READ(TEXT12,'(2A4)') (HISOMI(I0,NISOMI),I0=1,2)
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          IF(INDIC.EQ.2)THEN
+            CONCMI(NISOMI)=FLOTT
+          ELSE
+            CALL XABORT('PCRRGR: INVALID HISO DATA.')
+          ENDIF
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          IF(INDIC.NE.3)CALL XABORT('PCRRGR: CHARACTER DATA EXPECTED.')
+          GOTO 60
+        ENDIF
+      ELSEIF((TEXT12.EQ.'SET').OR.(TEXT12.EQ.'DELTA').OR.
+     1       (TEXT12.EQ.'ADD'))THEN
+        IF(IBM.EQ.0) CALL XABORT('PCRRGR: MIX NOT SET (2).')
+        ITYPE=0
+        LSET1=.FALSE.
+        LDELT1=.FALSE.
+        LADD1=.FALSE.
+        IF(TEXT12.EQ.'SET')THEN
+          ITYPE=1
+          LSET1=.TRUE.
+        ELSEIF(TEXT12.EQ.'DELTA')THEN
+          ITYPE=2
+          LDELT1=.TRUE.
+        ELSEIF(TEXT12.EQ.'ADD')THEN
+          ITYPE=2
+          LADD1=.TRUE.
+          IDLTA1=IDLTA1+1
+          DO 65 JPAR=1,NPAR
+            MAPLET(JPAR,IDLTA1)=MUPLET(JPAR)
+            MATYPE(JPAR,IDLTA1)=MUTYPE(JPAR)
+   65     CONTINUE
+        ENDIF
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3)CALL XABORT('PCRRGR: CHARACTER DATA EXPECTED(7).')
+        IF((TEXT12.EQ.'LINEAR').OR.(TEXT12.EQ.'CUBIC')) THEN
+          HCUBIC=TEXT12
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        ELSE
+          HCUBIC=' '
+        ENDIF
+        IF(INDIC.NE.3)CALL XABORT('PCRRGR: CHARACTER DATA EXPECTED(8).')
+        IPAR=-99
+        DO I=1,NPAR
+          IF(TEXT12.EQ.PARKEY(I))THEN
+            IPAR=I
+            PARNAM=TEXT12
+            GOTO 70
+          ENDIF
+        ENDDO
+        WRITE(HSMG,'(18HPCRRGR: PARAMETER ,A,14H NOT FOUND(1).)') TEXT12
+        CALL XABORT(HSMG)
+*
+   70   IF(HCUBIC.EQ.'LINEAR') THEN
+          LCUB2(IPAR)=.FALSE.
+        ELSE IF(HCUBIC.EQ.'CUBIC') THEN
+          LCUB2(IPAR)=.TRUE.
+        ENDIF
+        IF((IPAR.GT.NPAR).OR.(IPAR.LE.NPAR))THEN
+          CALL REDGET(INDIC,NITMA,VALR1,TEXT12,DFLOTT)
+          IF(INDIC.EQ.2)THEN
+            VALR2=VALR1
+            IF(LSET1) THEN
+              LSET(IPAR)=.TRUE.
+              VALR(IPAR,1)=VALR1
+              VALR(IPAR,2)=VALR1
+            ENDIF
+            IF(LDELT1) THEN
+              LDELT(IPAR)=.TRUE.
+              VALR(IPAR,1)=VALR1
+              VALR(IPAR,2)=VALR1
+            ELSEIF(LADD1) THEN
+              LADD(IPAR)=.TRUE.
+              VALRA(IPAR,1,IDLTA1)=VALR1
+              VALRA(IPAR,2,IDLTA1)=VALR1
+              NDLTA(IPAR)=NDLTA(IPAR)+1
+              IF(NDLTA(IPAR).GT.MAXADD) CALL XABORT('PCRRGR: MAXADD OV'
+     1        //'ERFLOW.')
+              IDLTA(IPAR,NDLTA(IPAR))=IDLTA1
+            ENDIF
+          ELSEIF(TEXT12.EQ.'MAP')THEN
+            IF(LDELT1)THEN
+              LDELT(IPAR)=.TRUE.
+              LDMAP(IPAR,1)=.TRUE.
+            ELSEIF(LADD1)THEN
+              LADD(IPAR)=.TRUE.
+              NDLTA(IPAR)=NDLTA(IPAR)+1
+              IF(NDLTA(IPAR).GT.MAXADD) CALL XABORT('PCRRGR: MAXADD OV'
+     1        //'ERFLOW.')
+              LAMAP(IPAR,1,NDLTA(IPAR))=.TRUE.
+              IDLTA(IPAR,NDLTA(IPAR))=IDLTA1
+            ENDIF
+            IF(LSET1.AND.(.NOT.LSET(IPAR))) GO TO 20
+          ELSE
+            CALL XABORT('PCRRGR: real value or "MAP" expected(1).')
+          ENDIF
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          IF(ITYPE.GE.2)THEN
+            IF(INDIC.EQ.2)THEN
+              VALR2=FLOTT
+              IF(LDELT1)THEN
+                VALR(IPAR,2)=VALR2
+              ELSEIF(LADD1)THEN
+                VALRA(IPAR,2,IDLTA1)=VALR2
+              ENDIF
+            ELSEIF(TEXT12.EQ.'MAP')THEN
+              IF(LDELT1)THEN
+                LDMAP(IPAR,2)=.TRUE.
+              ELSEIF(LADD1)THEN
+                LAMAP(IPAR,2,IDLTA1)=.TRUE.
+              ENDIF
+            ELSE
+              CALL XABORT('PCRRGR: real value or "MAP" expected(2).')
+            ENDIF
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          ENDIF
+          LTST=.FALSE.
+          IF(.NOT.LADD1)THEN
+            IF(VALR(IPAR,1).EQ.VALR(IPAR,2)) LTST=.TRUE.
+            MUPLET(IPAR)=-1
+            MUTYPE(IPAR)=ITYPE
+          ELSE
+            MAPLET(IPAR,IDLTA1)=-1
+            MATYPE(IPAR,IDLTA1)=2
+          ENDIF
+          IF((LTST).AND.(ITYPE.EQ.1))THEN
+            DO J=1,NVALUE(IPAR)
+              IF(ABS(VALR(IPAR,1)-VREAL(J,IPAR)).LE.REPS*
+     1        ABS(VREAL(J,IPAR)))THEN
+                MUPLET(IPAR)=J
+                GOTO 30
+              ENDIF
+            ENDDO
+          ENDIF
+*----
+*  ERRORS HANDLING
+*----
+          IF(VALR1.LT.VREAL(1,IPAR))THEN
+*           OUTSIDE OF THE DOMAIN (1)
+            WRITE(HSMG,'(23HPCRRGR: REAL PARAMETER ,A,10H WITH VALU,
+     1       1HE,1P,E12.4,26H IS OUTSIDE THE DOMAIN.(1))') PARNAM,VALR1
+             WRITE(6,*)'Domain:',VREAL(1,IPAR),' <-> ',
+     1       VREAL(NVALUE(IPAR),IPAR)
+            CALL XABORT(HSMG)
+          ELSEIF(VALR2.GT.VREAL(NVALUE(IPAR),IPAR))THEN
+*           OUTSIDE OF THE DOMAIN (2)
+            WRITE(HSMG,'(23HPCRRGR: REAL PARAMETER ,A,10H WITH VALU,
+     1       1HE,1P,E12.4,26H IS OUTSIDE THE DOMAIN.(2))') PARNAM,VALR2
+             WRITE(6,*)'Domain:',VREAL(1,IPAR),' <-> ',
+     1       VREAL(NVALUE(IPAR),IPAR)
+            CALL XABORT(HSMG)
+          ELSEIF((VALR1.GT.VALR2).AND.(ITYPE.EQ.1))THEN
+*           ITYPE=1 correspond to an integral between VALR1 and VALR2
+*           otherwise it is a simple difference
+            WRITE(HSMG,'(23HPCRRGR: REAL PARAMETER ,A,9H IS DEFIN,
+     1       7HED WITH,1P,E12.4,2H >,E12.4,4H.(1))') PARNAM,
+     2       VALR1,VALR2
+            CALL XABORT(HSMG)
+          ENDIF
+          IF((LADD1).AND.(TEXT12.EQ.'REF'))THEN
+  120       IPAR=-99
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+            IF(TEXT12.EQ.'ENDREF') GOTO 140
+            DO I=1,NPAR
+              IF(TEXT12.EQ.PARKEY(I))THEN
+                IPAR=I
+                GOTO 130
+              ENDIF
+            ENDDO
+            CALL XABORT('PCRRGR: PARAMETER '//TEXT12//' NOT FOUND(2).')
+  130       CONTINUE
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+            IF(INDIC.EQ.2)THEN
+              VALRA(IPAR,1,IDLTA1)=FLOTT
+              VALRA(IPAR,2,IDLTA1)=FLOTT
+              MAPLET(IPAR,IDLTA1)=-1
+              MATYPE(IPAR,IDLTA1)=1
+              DO J=1,NVALUE(IPAR)
+                IF(ABS(VALRA(IPAR,1,IDLTA1)-VREAL(J,IPAR)).LE.
+     1             REPS*ABS(VREAL(J,IPAR)))THEN
+                  MAPLET(IPAR,IDLTA1)=J
+                  GOTO 120
+                ENDIF
+              ENDDO
+            ELSEIF(TEXT12.EQ.'SAMEASREF')THEN
+              MAPLET(IPAR,IDLTA1)=-1
+              MATYPE(IPAR,IDLTA1)=-1
+            ELSE
+              CALL XABORT('PCRRGR: REAL or "SAMEASREF" expected')
+            ENDIF
+            GOTO 120
+  140       CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          ELSE IF((LDELT1).AND.(TEXT12.EQ.'REF'))THEN
+  150       IPAR=-99
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+            IF(TEXT12.EQ.'ENDREF') GOTO 170
+            DO I=1,NPAR
+              IF(TEXT12.EQ.PARKEY(I))THEN
+                IPAR=I
+                GOTO 160
+              ENDIF
+            ENDDO
+            CALL XABORT('PCRRGR: PARAMETER '//TEXT12//' NOT FOUND(3).')
+  160       CONTINUE
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+            IF(INDIC.EQ.2)THEN
+              VALR(IPAR,1)=FLOTT
+              VALR(IPAR,2)=FLOTT
+              MUPLET(IPAR)=-1
+              MUTYPE(IPAR)=1
+              DO J=1,NVALUE(IPAR)
+                IF(ABS(VALR(IPAR,1)-VREAL(J,IPAR)).LE.REPS*
+     1          ABS(VREAL(J,IPAR)))THEN
+                  MUPLET(IPAR)=J
+                  GOTO 150
+                ENDIF
+              ENDDO
+            ELSEIF(TEXT12.EQ.'SAMEASREF')THEN
+              MUPLET(IPAR)=-1
+              MUTYPE(IPAR)=-1
+            ELSE
+              CALL XABORT('PCRRGR: REAL or "SAMEASREF" expected')
+            ENDIF
+            GOTO 150
+  170       CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          ENDIF
+          GOTO 30
+        ENDIF
+      ELSEIF(TEXT12.EQ.'TIMAV-BURN')THEN
+        IF(IBM.EQ.0) CALL XABORT('PCRRGR: MIX NOT SET (3).')
+        IBTYP=1
+      ELSEIF(TEXT12.EQ.'INST-BURN')THEN
+        IF(IBM.EQ.0) CALL XABORT('PCRRGR: MIX NOT SET (4).')
+        IBTYP=2
+      ELSEIF(TEXT12.EQ.'AVG-EX-BURN')THEN
+        IF(IBM.EQ.0) CALL XABORT('PCRRGR: MIX NOT SET (5).')
+        IBTYP=3
+        CALL REDGET(INDIC,IVARTY,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1)CALL XABORT('PCRRGR: INTEGER DATA EXPECTED.')
+      ELSEIF(TEXT12.EQ.'ENDMIX')THEN
+*----
+*  RECOVER FUEL-MAP INFORMATION.
+*----
+        IF(IMPX.GT.0) THEN
+          DO IPAR=1,NPAR
+            IF(LCUB2(IPAR)) THEN
+              WRITE(IOUT,'(26H PCRRGR: GLOBAL PARAMETER:,A12,5H ->CU,
+     1        18HBIC INTERPOLATION.)') PARKEY(IPAR)
+            ELSE
+              WRITE(IOUT,'(26H PCRRGR: GLOBAL PARAMETER:,A12,5H ->LI,
+     1        19HNEAR INTERPOLATION.)') PARKEY(IPAR)
+            ENDIF
+          ENDDO
+        ENDIF
+        FMIX(:NCH*NB)=0
+        CALL LCMGET(IPMAP,'FLMIX',FMIX)
+        CALL NCRMAP(IPMAP,NPARM,HPAR,NCH,NB,IBTYP,HNAVAL,IMPX,BRN0,BRN1,
+     1              WPAR,LPARM)
+        IF(IBTYP.EQ.3) THEN
+          IF(IVARTY.EQ.0) CALL XABORT('PCRRGR: IVARTY NOT SET.')
+          CALL LCMGET(IPMAP,'B-ZONE',ZONEC)
+          DO ICH=1,NCH
+            DO J=1,NB
+              IF(ZONEC(ICH).EQ.IVARTY) THEN
+                ZONEDP(ICH,J)=1
+              ELSE
+                ZONEDP(ICH,J)=0
+              ENDIF
+            ENDDO
+          ENDDO
+          CALL LCMLEN(IPMAP,'B-VALUE',ILONG,ITYP)
+          IF (ILONG.EQ.0) CALL XABORT('PCRRGR: NO SAVED VALUES FOR '
+     1    //'THIS TYPE OF VARIABLE IN L_MAP')
+          ALLOCATE(VARC(ILONG))
+          CALL LCMGET(IPMAP,'B-VALUE',VARC)
+          VARVAL=VARC(IVARTY)
+          DEALLOCATE(VARC)
+        ENDIF
+*----
+*  PERFORM INTERPOLATION OVER THE FUEL MAP.
+*----
+        DO 185 JPARM=1,NPARMP
+          IPAR=-99
+          DO I=1,NPAR
+            IF(HPAR(JPARM).EQ.PARKEY(I))THEN
+              IPAR=I
+              IF(LSET(IPAR)) THEN
+                WRITE(6,*) 'L_MAP values overwritten by the SET option'
+     1          // ' for parameter '//HPAR(JPARM)
+                IF(.NOT.LADD(IPAR)) LPARM(JPARM)=.FALSE.
+              ENDIF
+              GOTO 185
+            ENDIF
+          ENDDO
+          LPARM(JPARM)=.FALSE.
+  185   CONTINUE
+*----
+*  COMPUTE ALL THE MUPLETS FOR EACH BUNDLE
+*----
+        IMPY=MAX(0,IMPX-1)
+        NTOT=0
+        DO 285 JB=1,NB
+        DO 280 ICH=1,NCH
+        IB=(JB-1)*NCH+ICH
+        IF(FMIX(IB).EQ.0) GO TO 280
+        NTOT=NTOT+1
+        IPAR=-99
+        IF(FMIX(IB).EQ.IBM)THEN
+          IF(NTOT.GT.NMIX) CALL XABORT('PCRRGR: NMIX OVERFLOW.')
+          DO 260 JPARM=1,NPARMP
+          IF(.NOT.LPARM(JPARM))GOTO 260
+        DO I=1,NPAR
+          IF(HPAR(JPARM).EQ.PARKEY(I))THEN
+            IPAR=I
+            PARNAM=HPAR(JPARM)
+            GOTO 190
+          ENDIF
+        ENDDO
+        WRITE(HSMG,'(18HPCRRGR: PARAMETER ,A,14H NOT FOUND(4).)')
+     1  HPAR(JPARM)
+        CALL XABORT(HSMG)
+  190   CONTINUE
+        ITYPE=0
+        IF((JPARM.EQ.NPARMP).AND.(NPARMP.EQ.NPARM+1))THEN
+*         parameter JPARAM is burnup
+          IF(.NOT.LSET(IPAR))THEN
+            MUTYPE(IPAR)=1
+            MUPLET(IPAR)=-1
+            BURN0=0.0
+            BURN1=0.0
+            IF(IBTYP.EQ.1)THEN
+*             TIME-AVERAGE
+              BURN0=BRN0(IB)
+              BURN1=BRN1(IB)
+            ELSEIF(IBTYP.EQ.2)THEN
+*             INSTANTANEOUS
+              BURN0=BRN0(IB)
+              BURN1=BURN0
+            ELSEIF(IBTYP.EQ.3)THEN
+*             DIFFERENCIATION RELATIVE TO EXIT BURNUP
+              ITYPE=3
+              BURN0=BRN0(IB)
+              BURN1=BRN1(IB)
+            ENDIF
+            VALR(IPAR,1)=BURN0
+            VALR(IPAR,2)=BURN1
+            VALR1=VALR(IPAR,1)
+            VALR2=VALR(IPAR,2)
+            ITYPE=1
+          ENDIF
+        ELSE
+          IF(.NOT.LSET(IPAR))THEN
+            VALR(IPAR,1)=WPAR(IB,JPARM)
+            VALR(IPAR,2)=WPAR(IB,JPARM)
+            MUPLET(IPAR)=-1
+            MUTYPE(IPAR)=1
+            VALR1=VALR(IPAR,1)
+            VALR2=VALR(IPAR,2)
+            ITYPE=1
+          ENDIF
+          IF(LDMAP(IPAR,1).OR.LDMAP(IPAR,2))THEN
+            IF(LDMAP(IPAR,1)) VALR(IPAR,1)=WPAR(IB,JPARM)
+            IF(LDMAP(IPAR,2)) VALR(IPAR,2)=WPAR(IB,JPARM)
+            MUPLET(IPAR)=-1
+            MUTYPE(IPAR)=2
+            VALR1=VALR(IPAR,1)
+            VALR2=VALR(IPAR,2)
+            ITYPE=2
+          ELSE IF(LADD(IPAR))THEN
+            DO N=1,NDLTA(IPAR)
+              IDLTA1=IDLTA(IPAR,N)
+              IF(LAMAP(IPAR,1,IDLTA1)) THEN
+                VALRA(IPAR,1,IDLTA1)=WPAR(IB,JPARM)
+                MAPLET(IPAR,IDLTA1)=-1
+                MATYPE(IPAR,IDLTA1)=2
+              ENDIF
+              IF(LAMAP(IPAR,2,IDLTA1)) THEN
+                VALRA(IPAR,2,IDLTA1)=WPAR(IB,JPARM)
+                MAPLET(IPAR,IDLTA1)=-1
+                MATYPE(IPAR,IDLTA1)=2
+              ENDIF
+            ENDDO
+            VALR1=VALRA(IPAR,1,IDLTA(IPAR,1))
+            VALR2=VALRA(IPAR,2,IDLTA(IPAR,1))
+            ITYPE=2
+          ENDIF
+        ENDIF
+        IF(ITYPE.EQ.1)THEN
+          IF(VALR1.EQ.VALR2)THEN
+            DO J=1,NVALUE(IPAR)
+             IF(ABS(VALR1-VREAL(J,IPAR)).LE.REPS*ABS(VREAL(J,IPAR)))THEN
+               MUPLET(IPAR)=J
+               MUTYPE(IPAR)=ITYPE
+               GOTO 260
+             ENDIF
+            ENDDO
+          ENDIF
+        ENDIF
+*----
+*  ERRORS HANDLING
+*----
+        IF(VALR1.LT.VREAL(1,IPAR))THEN
+*         OUTSIDE OF THE DOMAIN (1)
+          WRITE(HSMG,'(23HPCRRGR: REAL PARAMETER ,A,10H WITH VALU,
+     1    1HE,1P,E12.4,26H IS OUTSIDE THE DOMAIN(3).)') PARNAM,VALR1
+          WRITE(6,*)'Domain:',VREAL(1,IPAR),' <-> ',
+     1    VREAL(NVALUE(IPAR),IPAR)
+          CALL XABORT(HSMG)
+        ELSEIF(VALR2.GT.VREAL(NVALUE(IPAR),IPAR))THEN
+*         OUTSIDE OF THE DOMAIN (2)
+          WRITE(HSMG,'(23HPCRRGR: REAL PARAMETER ,A,10H WITH VALU,
+     1    1HE,1P,E12.4,26H IS OUTSIDE THE DOMAIN(4).)') PARNAM,VALR2
+          WRITE(6,*)'Domain:',VREAL(1,IPAR),' <-> ',
+     1    VREAL(NVALUE(IPAR),IPAR)
+          CALL XABORT(HSMG)
+        ELSEIF((ITYPE.EQ.1).AND.(VALR1.GT.VALR2))THEN
+*         VALR1 > VALR2
+          WRITE(HSMG,'(23HPCRRGR: REAL PARAMETER ,A,9H IS DEFIN,
+     1    7HED WITH,1P,E12.4,2H >,E12.4,4H.(2))') PARNAM,
+     2    VALR1,VALR2
+          CALL XABORT(HSMG)
+        ENDIF
+*----
+*  COMPUTE THE TERP FACTORS USING TABLE-OF-CONTENT INFORMATION.
+*----
+  260     CONTINUE
+          LMIXC(NTOT)=.TRUE.
+          IF(IMPY.GT.2) WRITE(6,'(32H PCRRGR: COMPUTE TERP FACTORS IN,
+     1    17H FUEL-MAP MIXTURE,I5,1H.)') NTOT
+          NISO(NTOT)=NISOMI
+          LDELTA(NTOT)=LDELT1
+          DO ISO=1,NISOMI
+            HISO(1,NTOT,ISO)=HISOMI(1,ISO)
+            HISO(2,NTOT,ISO)=HISOMI(2,ISO)
+            CONC(NTOT,ISO)=CONCMI(ISO)
+          ENDDO
+          DO JPAR=1,NPAR
+            MUPLT2(JPAR)=MUPLET(JPAR)
+          ENDDO
+          IF(IBTYP.EQ.3)THEN
+             IF(ZONEDP(ICH,JB).NE.0) THEN
+                CALL PCRTRP(LCUB2,IMPY,NPAR,NCAL,NVALUE,MUPLT2,
+     1                      MUTYPE,VALR(1,1),VARVAL,MUBASE,VREAL,
+     2                      TERP(1,NTOT))
+             ELSE
+                TERP(:NCAL,NTOT)=0.0
+             ENDIF
+          ELSE
+             CALL PCRTRP(LCUB2,IMPY,NPAR,NCAL,NVALUE,MUPLT2,
+     1                   MUTYPE,VALR(1,1),VARVAL,MUBASE,VREAL,
+     2                   TERP(1,NTOT))
+          ENDIF
+*         DELTA-ADD
+          DO 270 IPAR=1,NPAR
+            IF(LADD(IPAR))THEN
+              DO N=1,NDLTA(IPAR)
+                IDLTA1=IDLTA(IPAR,N)
+                DO JPAR=1,NPAR
+                  MUPLT2(JPAR)=MAPLET(JPAR,IDLTA1)
+                  MUTYP2(JPAR)=MATYPE(JPAR,IDLTA1)
+                ENDDO
+                DO JPAR=1,NPAR
+                  IF(MUTYP2(JPAR).LT.0)THEN
+                    MUPLT2(JPAR)=MUPLET(JPAR)
+                    MUTYP2(JPAR)=MUTYPE(JPAR)
+                    VALRA(JPAR,1,IDLTA1)=VALR(JPAR,1)
+                    VALRA(JPAR,2,IDLTA1)=VALR(JPAR,2)
+                  ENDIF
+                ENDDO
+                ALLOCATE(TERPA(NCAL))
+                CALL PCRTRP(LCUB2,IMPY,NPAR,NCAL,NVALUE,MUPLT2,
+     1          MUTYP2,VALRA(1,1,IDLTA1),VARVAL,MUBASE,VREAL,
+     2          TERPA(1))
+                DO 275 JCAL=1,NCAL
+                TERP(JCAL,NTOT)=TERP(JCAL,NTOT)+TERPA(JCAL)
+  275           CONTINUE
+                DEALLOCATE(TERPA)
+              ENDDO
+            ENDIF
+  270     CONTINUE
+        ENDIF
+  280   CONTINUE
+  285   CONTINUE
+        IF(NTOT.GT.NMIX) CALL XABORT('PCRRGR: ALGORITHM FAILURE.')
+        IBM=0
+      ELSEIF((TEXT12.EQ.'PMAXS').OR.(TEXT12.EQ.'TABLE').OR.
+     1  (TEXT12.EQ.'CHAIN').OR.(TEXT12.EQ.';')) THEN
+*----
+*  CHECK TERP FACTORS AND RETURN
+*----
+        IF(TEXT12.EQ.';') ITER=0
+        IF(TEXT12.EQ.'PMAXS') ITER=1
+        IF(TEXT12.EQ.'TABLE') ITER=2
+        IF(TEXT12.EQ.'CHAIN') ITER=3
+        DO 300 IBM=1,NMIX
+        IF(.NOT.LMIXC(IBM)) GO TO 300
+        IF(NISO(IBM).GT.MAXNIS) CALL XABORT('PCRRGR: MAXNIS OVERFLOW.')
+        IF(LDELTA(IBM)) THEN
+          SUM=0.0
+        ELSE
+          SUM=1.0
+        ENDIF
+        DO 290 ICAL=1,NCAL
+        SUM=SUM-TERP(ICAL,IBM)
+  290   CONTINUE
+        IF(ABS(SUM).GT.1.0E-4) THEN
+           WRITE(HSMG,'(43HPCRRGR: INVALID INTERPOLATION FACTORS IN MI,
+     1     5HXTURE,I4,1H.)') IBM
+           CALL XABORT(HSMG)
+        ENDIF
+  300   CONTINUE
+*----
+*  EXIT MAIN LOOP OF THE SUBROUTINE
+*----
+        GO TO 310
+      ELSE
+        CALL XABORT('PCRRGR: '//TEXT12//' IS AN INVALID KEYWORD.')
+      ENDIF
+      GOTO 20
+*----
+*  PRINT INTERPOLATION (TERP) FACTORS
+*----
+  310 IF(IMPX.GT.2) THEN
+        WRITE(IOUT,'(/30H PCRRGR: INTERPOLATION FACTORS)')
+        DO ICAL=1,NCAL
+          DO IBM=1,NMIX
+            IF(TERP(ICAL,IBM).NE.0.0) THEN
+              WRITE(IOUT,320) ICAL,(TERP(ICAL,JBM),JBM=1,NMIX)
+              EXIT
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(MUBASE)
+      DEALLOCATE(HPAR,LDELTA,WPAR,BRN1,BRN0,ZONEC,ZONEDP,FMIX,LPARM)
+      RETURN
+  320 FORMAT(6H CALC=,I8,6H TERP=,1P,8E13.5/(20X,8E13.5))
+      END
diff --git a/Donjon/src/PCRTRP.f b/Donjon/src/PCRTRP.f
new file mode 100644
index 0000000..a19ba85
--- /dev/null
+++ b/Donjon/src/PCRTRP.f
@@ -0,0 +1,189 @@
+*DECK PCRTRP
+      SUBROUTINE PCRTRP(LCUB2,IMPX,NPAR,NCAL,NVALUE,MUPLET,MUTYPE,VALR,
+     1 VARVAL,MUBASE,VREAL,TERP)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute the TERP interpolation/derivation/integration factors using
+* table-of-content information of the PMAXS file.
+*
+*Copyright:
+* Copyright (C) 2018 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* LCUB2   interpolation type for each parameter (=.TRUE.: cubic Ceschino
+*         interpolation; =.FALSE: linear Lagrange interpolation).
+* IMPX    print parameter (equal to zero for no print).
+* NPAR    number of parameters.
+* NCAL    number of elementary calculations in the PMAXS file.
+* NVALUE  number of tabulation values for each parameter.
+* MUPLET  tuple used to identify an elementary calculation.
+* MUTYPE  type of interpolation (=1: interpolation; =2: delta-sigma).
+* VALR    real values of the interpolated point.
+* VARVAL  exit burnup used if MUTYPE(IPAR(ID))=3.
+* MUBASE  muplet database.
+* VREAL   local parameter values at tabulation points.
+*
+*Parameters: output
+* TERP    interpolation factors.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER, PARAMETER::MAXVAL=200
+      INTEGER, PARAMETER::MAXPAR=50
+      INTEGER IMPX,NPAR,NCAL,NVALUE(NPAR),MUPLET(NPAR),MUTYPE(NPAR),
+     1 MUBASE(NPAR,NCAL)
+      REAL VALR(MAXPAR,2),VARVAL,VREAL(MAXVAL,MAXPAR),TERP(NCAL)
+      LOGICAL LCUB2(NPAR)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXDIM=10
+      INTEGER IPAR(MAXDIM),NVAL(MAXDIM),IDDIV(MAXDIM)
+      REAL T1D(MAXVAL,MAXDIM),WORK(MAXVAL)
+      REAL BURN0, BURN1, DENOM, TERTMP
+      INTEGER ICAL, IDTMP, IDTOT, ID, I, JD, NDELTA, NDIM, NID, NTOT,
+     1 IIPAR, MCRCAL
+      CHARACTER HSMG*131,RECNAM*12
+      LOGICAL LCUBIC,LSINGL
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      REAL, ALLOCATABLE, DIMENSION(:) :: TERPA
+*----
+*  COMPUTE TERP FACTORS
+*----
+      TERP(:NCAL)=0.0
+      IPAR(:MAXDIM)=0
+      NDIM=0
+      NDELTA=0
+      DO 10 I=1,NPAR
+        IF(MUPLET(I).EQ.-1) THEN
+          NDIM=NDIM+1
+          IF(MUTYPE(I).NE.1) NDELTA=NDELTA+1
+          IF(NDIM.GT.MAXDIM) THEN
+            WRITE(HSMG,'(7HPCRTRP:,I4,29H-DIMENSIONAL INTERPOLATION NO,
+     1      14HT IMPLEMENTED.)') NDIM
+            CALL XABORT(HSMG)
+          ENDIF
+          IPAR(NDIM)=I
+        ENDIF
+   10 CONTINUE
+      IF(IMPX.GT.2) THEN
+        WRITE(IOUT,'(16H PCRTRP: MUPLET=,10I4/(16X,10I4))')
+     1  (MUPLET(I),I=1,NPAR)
+        WRITE(IOUT,'(8H PCRTRP:,I4,27H-DIMENSIONAL INTERPOLATION.)')
+     1  NDIM
+      ENDIF
+      IF(NDIM.EQ.0) THEN
+        ICAL=MCRCAL(NPAR,NCAL,MUPLET,MUBASE)
+        IF(ICAL.GT.NCAL) CALL XABORT('PCRTRP: TERP OVERFLOW(1).')
+        IF(ICAL.EQ.0) GO TO 200
+        IF(ICAL.EQ.-1) GO TO 210
+        TERP(ICAL)=1.0
+      ELSE
+        NTOT=1
+        IDDIV(:MAXDIM)=1
+        DO 70 ID=1,NDIM
+        IIPAR=IPAR(ID)
+        NID=NVALUE(IIPAR)
+        NTOT=NTOT*NID
+        DO 15 IDTMP=1,NDIM-ID
+        IDDIV(IDTMP)=IDDIV(IDTMP)*NID
+   15   CONTINUE
+        BURN0=VALR(IIPAR,1)
+        BURN1=VALR(IIPAR,2)
+        LSINGL=(BURN0.EQ.BURN1)
+        LCUBIC=LCUB2(IIPAR)
+        IF((MUTYPE(IIPAR).EQ.1).AND.LSINGL) THEN
+          CALL ALTERP(LCUBIC,NID,VREAL(1,IIPAR),BURN0,.FALSE.,
+     1    T1D(1,ID))
+        ELSE IF(MUTYPE(IIPAR).EQ.1) THEN
+          IF(BURN0.GE.BURN1) CALL XABORT('@PCRTRP: INVALID BURNUP'
+     1     //' LIMITS(1).')
+          CALL ALTERI(LCUBIC,NID,VREAL(1,IIPAR),BURN0,BURN1,T1D(1,ID))
+          DO 20 I=1,NID
+          T1D(I,ID)=T1D(I,ID)/(BURN1-BURN0)
+   20     CONTINUE
+        ELSE IF((MUTYPE(IIPAR).EQ.2).AND.(.NOT.LSINGL)) THEN
+          CALL ALTERP(LCUBIC,NID,VREAL(1,IIPAR),BURN0,.FALSE.,WORK(1))
+          CALL ALTERP(LCUBIC,NID,VREAL(1,IIPAR),BURN1,.FALSE.,T1D(1,ID))
+          DO 30 I=1,NID
+          T1D(I,ID)=T1D(I,ID)-WORK(I)
+   30     CONTINUE
+        ELSE IF((MUTYPE(IIPAR).EQ.2).AND.(LSINGL)) THEN
+          T1D(:NID,ID)=0.0
+        ELSE IF(MUTYPE(IIPAR).EQ.3) THEN
+*          DERIVATIVE WITH RESPECT TO A SINGLE EXIT BURNUP. USE
+*          EQ.(3.3) OF RICHARD CHAMBON'S THESIS.
+          IF(BURN0.GE.BURN1) CALL XABORT('@PCRTRP: INVALID BURNUP'
+     1    //' LIMITS(2).')
+          IF(RECNAM.NE.'BURN') CALL XABORT('@PCRTRP: BURN EXPECTED.')
+          ALLOCATE(TERPA(NID))
+          CALL ALTERI(LCUBIC,NID,VREAL(1,IIPAR),BURN0,BURN1,TERPA(1))
+          DO 40 I=1,NID
+          T1D(I,ID)=-TERPA(I)
+   40     CONTINUE
+          CALL ALTERP(LCUBIC,NID,VREAL(1,IIPAR),BURN0,.FALSE.,TERPA(1))
+          DO 50 I=1,NID
+          T1D(I,ID)=T1D(I,ID)-TERPA(I)*BURN0
+   50     CONTINUE
+          CALL ALTERP(LCUBIC,NID,VREAL(1,IIPAR),BURN1,.FALSE.,TERPA(1))
+          DENOM=VARVAL*(BURN1-BURN0)
+          DO 60 I=1,NID
+          T1D(I,ID)=(T1D(I,ID)+TERPA(I)*BURN1)/DENOM
+   60     CONTINUE
+          DEALLOCATE(TERPA)
+        ELSE
+          CALL XABORT('PCRTRP: INVALID OPTION.')
+        ENDIF
+        NVAL(ID)=NID
+   70   CONTINUE
+
+* Example: NDIM=3, NVALUE=(3,2,2)
+* IDTOT 1  2  3  4  5  6  7  8  9 10 11 12
+* ID(1) 1  2  3  1  2  3  1  2  3  1  2  3
+* ID(2) 1  1  1  2  2  2  1  1  1  2  2  2
+* ID(3) 1  1  1  1  1  1  2  2  2  2  2  2
+* (NTOT=12, IDDIV=(6,3,1))
+        DO 100 IDTOT=1,NTOT               ! Ex.: IDTOT       = 9
+          TERTMP=1.0
+          IDTMP=IDTOT
+          DO 80 JD=1,NDIM                 ! Ex.: JD          = 1,2,3
+            ID=(IDTMP-1)/IDDIV(JD)+1      ! Ex.: ID(NDIM...1)= 2,1,3
+            IDTMP=IDTMP-(ID-1)*IDDIV(JD)  ! Ex.: IDTMP       = 3,3,1
+            MUPLET(IPAR(NDIM-JD+1))=ID
+            TERTMP=TERTMP*T1D(ID,NDIM-JD+1)
+   80     CONTINUE
+          ICAL=MCRCAL(NPAR,NCAL,MUPLET,MUBASE)
+          IF(ICAL.GT.NCAL) CALL XABORT('PCRTRP: TERP OVERFLOW(2).')
+          IF(ICAL.EQ.0) GO TO 200
+          IF(ICAL.EQ.-1) GO TO 210
+          TERP(ICAL)=TERP(ICAL)+TERTMP
+  100   CONTINUE
+      ENDIF
+      IF(IMPX.GT.3) THEN
+        WRITE(IOUT,'(25H PCRTRP: TERP PARAMETERS:/(1X,1P,10E12.4))')
+     1  (TERP(I),I=1,NCAL)
+      ENDIF
+      RETURN
+*----
+*  MISSING ELEMENTARY CALCULATION EXCEPTION.
+*----
+  200 WRITE(IOUT,'(16H PCRTRP: MUPLET=,10I4/(16X,10I4))')
+     1 (MUPLET(I),I=1,NPAR)
+      CALL XABORT('PCRTRP: MISSING ELEMENTARY CALCULATION.')
+  210 WRITE(IOUT,'(16H PCRTRP: MUPLET=,10I4/(16X,10I4))')
+     1 (MUPLET(I),I=1,NPAR)
+      CALL XABORT('PCRTRP: DEGENERATE ELEMENTARY CALCULATION.')
+      END
diff --git a/Donjon/src/PKIDRV.f b/Donjon/src/PKIDRV.f
new file mode 100644
index 0000000..fc3dcad
--- /dev/null
+++ b/Donjon/src/PKIDRV.f
@@ -0,0 +1,182 @@
+*DECK PKIDRV
+      SUBROUTINE PKIDRV(IPMAP,NALPHA,NGROUP,LAMBDA,EPSILON,BETAI,
+     1 LAMBDAI,DT,PARAMI,PARAMB,T,Y)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Solution of the point kinetic equations using the Runge-Kutta method.
+*
+*Copyright:
+* Copyright (C) 2017 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPMAP   pointer to the point kinetic directory
+* NALPHA  number of feedback parameters
+* NGROUP  number of delayed precursor groups
+* LAMBDA  prompt neutron generation time
+* EPSILON Runge-Kutta epsilon
+* BETAI   delayed neutron fraction vector
+* LAMBDAI delayed neutron time constant vector
+* DT      stage duration (double precision value)
+* PARAMI  initial values of the global parameters corresponding to
+*         RHO=0
+* PARAMB  values of global parameters at beginning of stage
+* T       time at beggining of stage (double precision value)
+* Y       solution of the point kinetic equations at beginning of stage
+*
+*Parameters: ouput
+* PARAMB  values of global parameters at end of stage
+* T       time at end of stage
+* Y       solution of the point kinetic equations at end of stage
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  Subroutine arguments
+*----
+      TYPE(C_PTR) IPMAP
+      INTEGER NALPHA,NGROUP
+      REAL LAMBDA,EPSILON,BETAI(NGROUP),LAMBDAI(NGROUP),PARAMI(NALPHA),
+     1 PARAMB(NALPHA)
+      DOUBLE PRECISION DT,T,Y(NGROUP+1)
+*----
+*  Local variables
+*----
+      PARAMETER(NRKMIN=100,NRKMAX=100000)
+      DOUBLE PRECISION DH,DPP,P0,T1,BETA,MAXI,RHO(3)
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: YSAV,YSUM,Y1,Y2,
+     1 Y3,Y4
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: A
+*----
+*  Scratch storage allocation
+*----
+      ALLOCATE(YSAV(NGROUP+1),YSUM(NGROUP+1),Y1(NGROUP+1),Y2(NGROUP+1),
+     1 Y3(NGROUP+1),Y4(NGROUP+1),A(NGROUP+1,NGROUP+1))
+*----
+*   Runge-Kutta and calcul parameters initialisation
+*----
+      DPP=1.D0
+      NRK=NRKMIN
+      P0=-1.D0
+*----
+*  Set the Runge-Kutta evolution matrix
+*----
+      BETA=0.D0
+      DO I=1,NGROUP
+         BETA=BETA+BETAI(I)
+      ENDDO
+      A(:NGROUP+1,:NGROUP+1)=0.0D0
+      DO I=2,NGROUP+1
+         A(I,1)=BETAI(I-1)/LAMBDA
+      ENDDO
+      DO I=2,NGROUP+1
+         A(1,I)=LAMBDAI(I-1)
+      ENDDO
+      DO I=2,NGROUP+1
+         A(I,I)=-LAMBDAI(I-1)
+      ENDDO
+*----
+*  Runge-Kutta convergence loop
+*----
+      RHO(:3)=0.0D0
+      DO WHILE ((DPP.GE.EPSILON).AND.(NRK.LE.NRKMAX))
+*       time and time-step initialisation
+        DH=DT/REAL(NRK)
+        T1=T
+*
+*       save of the working vector
+        DO I=1,NGROUP+1
+          YSAV(I)=Y(I)
+        ENDDO       
+*
+*       Runge-Kutta iteration loop
+        DO I=1,NRK
+*         total reactivity calculation with feedback
+          IF(NALPHA.GT.0) CALL PKIRHO(IPMAP,NALPHA,T,DH,PARAMI,PARAMB,
+     1    RHO)
+*
+*         Runge-Kutta procedure
+          A(1,1)=(RHO(1)-BETA)/LAMBDA
+          DO J=1,NGROUP+1
+             Y1(J)=0.0D0
+             DO K=1,NGROUP+1
+                Y1(J)=Y1(J)+A(J,K)*Y(K)
+             ENDDO
+          ENDDO
+          DO J=1,NGROUP+1
+             YSUM(J)=Y(J)+(DH/6.D0)*Y1(J)
+             Y1(J)=Y(J)+DH/2.D0*Y1(J)
+          ENDDO
+          A(1,1)=(RHO(2)-BETA)/LAMBDA
+          DO J=1,NGROUP+1
+             Y2(J)=0.0D0
+             DO K=1,NGROUP+1
+                Y2(J)=Y2(J)+A(J,K)*Y1(K)
+             ENDDO
+          ENDDO
+          DO J=1,NGROUP+1
+             YSUM(J)=YSUM(J)+(DH/3.D0)*Y2(J)
+             Y2(J)=Y(J)+DH/2.D0*Y2(J)
+          ENDDO
+          A(1,1)=(RHO(2)-BETA)/LAMBDA
+          DO J=1,NGROUP+1
+             Y3(J)=0.0D0
+             DO K=1,NGROUP+1
+                Y3(J)=Y3(J)+A(J,K)*Y2(K)
+             ENDDO
+          ENDDO
+          DO J=1,NGROUP+1
+             YSUM(J)=YSUM(J)+(DH/3.D0)*Y3(J)
+             Y3(J)=Y(J)+DH*Y3(J)
+          ENDDO
+          A(1,1)=(RHO(3)-BETA)/LAMBDA
+          DO J=1,NGROUP+1
+             Y4(J)=0.0D0
+             DO K=1,NGROUP+1
+                Y4(J)=Y4(J)+A(J,K)*Y3(K)
+             ENDDO
+          ENDDO
+          DO J=1,NGROUP+1
+             YSUM(J)=YSUM(J)+(DH/6.D0)*Y4(J)
+             Y(J)=YSUM(J)
+          ENDDO
+          T=T+DH
+*
+*         convergence test initialisation
+          MAXI=0.D0
+          DO J=1,NGROUP+1
+             MAXI=MAX(ABS(Y(J)),MAXI)
+          ENDDO
+          IF(MAXI.GT.1.0D30) GOTO 100
+        ENDDO
+* 
+*       convergence test
+ 100    IF(P0.NE.-1.D0) DPP=ABS(Y(1)-P0)/ABS(P0)
+        P0=Y(1)
+*
+*       reinitialisation of the number of Runge-Kutta time-steps
+        NRK=2*NRK
+*
+*       reinitialisation of the working vector if not converged
+        IF((DPP.GE.EPSILON).AND.(NRK.LE.NRKMAX)) THEN
+          DO I=1,NGROUP+1
+             Y(I)=YSAV(I)
+          ENDDO
+          T=T1
+        ENDIF
+      ENDDO
+*----
+*  Scratch storage deallocation
+*----
+      DEALLOCATE(A,Y4,Y3,Y2,Y1,YSUM,YSAV)
+      RETURN
+      END
diff --git a/Donjon/src/PKINI.f b/Donjon/src/PKINI.f
new file mode 100644
index 0000000..48fac0a
--- /dev/null
+++ b/Donjon/src/PKINI.f
@@ -0,0 +1,417 @@
+*DECK PKINI
+      SUBROUTINE PKINI(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Collect input information for the point kinetic module.
+*
+*Copyright:
+* Copyright (C) 2017 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The PKINI: module specification is:
+* MAPFL := PKINI: MAPFL :: (descpkini) ;
+* where
+*   MAPFL : name of the \emph{map} object containing fuel regions description 
+*     and global parameter informations.
+*   (descpkini) : structure describing the input data to the PKINI: module. 
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER (NSTATE=40,MAXALP=10,MAXTIM=2)
+      INTEGER ISTATE(NSTATE)
+      TYPE(C_PTR) IPMAP,JPMAP,KPMAP,JPPAR,KPPAR
+      REAL LAMBDA,TIMES(MAXTIM)
+      DOUBLE PRECISION DFLOT
+      LOGICAL LCUBIC
+      CHARACTER TEXT12*12,HSIGN*12,HPNAME*12,HSMG*131,HPARAM(MAXALP)*12
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      REAL, ALLOCATABLE, DIMENSION(:) :: BETAI,LAMBDAI,X,Y,PARAMI,FPOWER
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: VAL
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: YINIT
+*----
+*  RECOVER THE FUELMAP
+*----
+      IF(NENTRY.NE.1) CALL XABORT('PKINI: ONE PARAMETER EXPECTED.')
+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2))CALL XABORT('PKINI:'
+     1 //' LCM OBJECT EXPECTED.')
+      IF(JENTRY(1).NE.1) CALL XABORT('PKINI: SECOND ENTRY IN MODIFICATI'
+     1  //'ON MODE EXPECTED.')
+      IPMAP=KENTRY(1)
+      CALL LCMGTC(IPMAP,'SIGNATURE',12,HSIGN)
+      IF(HSIGN.NE.'L_MAP') THEN
+         TEXT12=HENTRY(1)
+         CALL XABORT('PKINI: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     1   '. L_MAP EXPECTED.')
+      ENDIF
+      CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+      NB=ISTATE(1)
+      NCH=ISTATE(2)
+      NPARM=ISTATE(8)
+      IF(NPARM.GT.0) JPPAR=LCMGID(IPMAP,'PARAM')
+      IF(NCH.NE.1) CALL XABORT('PKINI: ONE CHANNEL EXPECTED.')
+      CALL LCMSIX(IPMAP,'P-KINETIC',1)
+*----
+*  READ INPUT DATA
+*----
+      IMPX=1
+      NGROUP=0
+      NALPHA=0
+      NPTIME=0
+      EPSILON=1.0E-2
+      POW0=0.0
+      LAMBDA=0.0
+   10 CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('PKINI: CHARACTER DATA EXPECTED.')
+      IF(TEXT12.EQ.'EDIT') THEN
+*       READ PRINTING INDEX
+        CALL REDGET(ITYP,IMPX,FLOT,TEXT12,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('PKINI: INTEGER FOR EDIT EXPECTED.')
+      ELSE IF(TEXT12.EQ.'POWER') THEN
+*       Initial power (MW)
+        CALL REDGET(ITYP,NITMA,POW0,TEXT12,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('PKINI: REAL FOR P0 EXPECTED.')
+      ELSE IF(TEXT12.EQ.'LAMBDA') THEN
+*       Prompt neutron generation time (s)
+        CALL REDGET(ITYP,NITMA,LAMBDA,TEXT12,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('PKINI: REAL FOR LAMBDA EXPECTED.')
+        CALL LCMPUT(IPMAP,'LAMBDA',1,2,LAMBDA)
+      ELSE IF(TEXT12.EQ.'EPSILON') THEN
+*       Rugge-Kutta EPSILON
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('PKINI: REAL FOR EPSILON EXPECTED.')
+        CALL LCMPUT(IPMAP,'EPSILON',1,2,FLOT)
+      ELSE IF(TEXT12.EQ.'TIME') THEN
+*       Set initial time and stage length (s)
+        CALL REDGET(ITYP,NITMA,T,TEXT12,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('PKINI: REAL FOR T EXPECTED.')
+        CALL REDGET(ITYP,NITMA,DT,TEXT12,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('PKINI: REAL FOR DT EXPECTED.')
+        CALL LCMPUT(IPMAP,'T-VALUE_INIT',1,2,T)
+        IF(IMPX.GT.0) WRITE(6,100) T,DT
+      ELSE IF(TEXT12.EQ.'NGROUP') THEN
+*       Read printing index
+        CALL REDGET(ITYP,NGROUP,FLOT,TEXT12,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('PKINI: INTEGER FOR NGROUP EXPECTED.')
+      ELSE IF(TEXT12.EQ.'BETAI') THEN
+*       Delayed neutron fraction
+        IF(NGROUP.EQ.0)CALL XABORT('PKINI: NGROUP NOT DEFINED.')
+        ALLOCATE(BETAI(NGROUP))
+        DO IG=1,NGROUP
+          CALL REDGET(ITYP,NITMA,BETAI(IG),TEXT12,DFLOT)
+          IF(ITYP.NE.2)CALL XABORT('PKINI: REAL FOR BETAI EXPECTED.')
+        ENDDO
+        CALL LCMPUT(IPMAP,'BETAI',NGROUP,2,BETAI)
+      ELSE IF(TEXT12.EQ.'LAMBDAI') THEN
+*       Delayed neutron time constant
+        IF(NGROUP.EQ.0)CALL XABORT('PKINI: NGROUP NOT DEFINED.')
+        ALLOCATE(LAMBDAI(NGROUP))
+        DO IG=1,NGROUP
+          CALL REDGET(ITYP,NITMA,LAMBDAI(IG),TEXT12,DFLOT)
+          IF(ITYP.NE.2)CALL XABORT('PKINI: REAL FOR LAMBDAI EXPECTED.')
+        ENDDO
+        CALL LCMPUT(IPMAP,'LAMBDAI',NGROUP,2,LAMBDAI)
+      ELSE IF(TEXT12.EQ.'ALPHA') THEN
+        IF(NPARM.EQ.0)CALL XABORT('PKINI: NPARM NOT DEFINED.')
+        JPMAP=LCMLID(IPMAP,'ALPHA',MAXALP)
+   20   CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('PKINI: CHARACTER DATA EXPECTED.')
+        IF(TEXT12.EQ.'ENDA') GO TO 10
+        NALPHA=NALPHA+1
+        IF(NALPHA.GT.MAXALP) CALL XABORT('PKINI: MAXALP OVERFLOW.')
+        DO IPAR=1,NPARM
+          KPPAR=LCMGIL(JPPAR,IPAR)
+          CALL LCMGTC(KPPAR,'P-NAME',12,HPNAME)
+          IF(HPNAME.EQ.TEXT12) GO TO 25
+        ENDDO
+        WRITE(HSMG,'(24HPKINI: GLOBAL PARAMETER ,A,16H IS NOT DEFINED ,
+     1  15HIN THE FUELMAP.)') TEXT12
+        CALL XABORT(HSMG)
+   25   KPMAP=LCMDIL(JPMAP,NALPHA)
+        CALL LCMPTC(KPMAP,'P-NAME',12,TEXT12)
+        HPARAM(NALPHA)=TEXT12
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('PKINI: CHARACTER DATA EXPECTED.')
+        IF(TEXT12.EQ.'DIRECT') THEN
+          ITYPE=1
+        ELSE IF(TEXT12.EQ.'DERIV') THEN
+          ITYPE=2
+        ELSE IF(TEXT12.EQ.'SQDERIV') THEN
+          ITYPE=3
+        ELSE
+          CALL XABORT('PKINI: DIRECT OR DERIV EXPECTED.')
+        ENDIF
+        CALL REDGET(ITYP,NXY,FLOT,TEXT12,DFLOT)
+        LCUBIC=.FALSE.
+        IF(ITYP.EQ.3) THEN
+          IF(TEXT12.EQ.'LINEAR') THEN
+            LCUBIC=.FALSE.
+          ELSE IF(TEXT12.EQ.'CUBIC') THEN
+            LCUBIC=.TRUE.
+          ELSE
+            CALL XABORT('PKINI: LINEAR OR CUBIC EXPECTED.')
+          ENDIF
+          CALL REDGET(ITYP,NXY,FLOT,TEXT12,DFLOT)
+        ENDIF
+        IF(ITYP.NE.1)CALL XABORT('PKINI: INTEGER FOR NXY EXPECTED(1).')
+        ALLOCATE(X(NXY),Y(NXY))
+        DO I=1,NXY
+          CALL REDGET(ITYP,NITMA,X(I),TEXT12,DFLOT)
+          IF(ITYP.NE.2)CALL XABORT('PKINI: REAL FOR X EXPECTED(1).')
+          CALL REDGET(ITYP,NITMA,Y(I),TEXT12,DFLOT)
+          IF(ITYP.NE.2)CALL XABORT('PKINI: REAL FOR Y EXPECTED(1).')
+        ENDDO
+        CALL LCMPUT(KPMAP,'ALPHA-LAW-P',NXY,2,X)
+        CALL LCMPUT(KPMAP,'ALPHA-LAW-R',NXY,2,Y)
+        CALL LCMPUT(KPMAP,'ALPHA-LAW-T',1,1,ITYPE)
+        CALL LCMPUT(KPMAP,'ALPHA-LAW-I',1,5,LCUBIC)
+        DEALLOCATE(Y,X)
+        GO TO 20
+      ELSE IF(TEXT12.EQ.'PTIME') THEN
+        IF(NALPHA.EQ.0)CALL XABORT('PKINI: NO FEEDBACK PARAMETERS.')
+        JPMAP=LCMGID(IPMAP,'ALPHA')
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('PKINI: CHARACTER DATA EXPECTED.')
+   30   IF(TEXT12.EQ.'ENDP') GO TO 10
+        NPTIME=NPTIME+1
+        IALP=0
+        DO IAL=1,NALPHA
+          IALP=IAL
+          IF(TEXT12.EQ.HPARAM(IAL)) GO TO 40
+        ENDDO
+        WRITE(HSMG,'(24HPKINI: GLOBAL PARAMETER ,A,16H IS NOT A FEEDBA,
+     1  13HCK PARAMETER.)') TEXT12
+        CALL XABORT(HSMG)
+   40   KPMAP=LCMDIL(JPMAP,IALP)
+        LCUBIC=.FALSE.
+   50   CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+        IF(ITYP.EQ.1) THEN
+          NXY=NITMA
+          ALLOCATE(X(NXY),Y(NXY))
+          DO I=1,NXY
+            CALL REDGET(ITYP,NITMA,X(I),TEXT12,DFLOT)
+            IF(ITYP.NE.2)CALL XABORT('PKINI: REAL FOR X EXPECTED(2).')
+            CALL REDGET(ITYP,NITMA,Y(I),TEXT12,DFLOT)
+            IF(ITYP.NE.2)CALL XABORT('PKINI: REAL FOR Y EXPECTED(2).')
+          ENDDO
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+          IF(ITYP.NE.3)CALL XABORT('PKINI: CHARACTER DATA EXPECTED.')
+        ELSE IF(ITYP.EQ.3) THEN
+          IF(TEXT12.EQ.'LINEAR') THEN
+            LCUBIC=.FALSE.
+            GO TO 50
+          ELSE IF(TEXT12.EQ.'CUBIC') THEN
+            LCUBIC=.TRUE.
+            GO TO 50
+          ELSE IF(TEXT12.EQ.'T-DELT') THEN
+            GO TO 60
+          ELSE
+            CALL XABORT('PKINI: LINEAR, CUBIC OR T-DELT EXPECTED.')
+          ENDIF
+   60     CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+          IF(ITYP.EQ.1) THEN
+            NXY=NITMA
+            CALL REDGET(ITYP,NITMA,T1,TEXT12,DFLOT)
+            IF(ITYP.NE.2) CALL XABORT('PKINI: REAL DATA EXPECTED(1).')
+          ELSE IF (ITYP.EQ.2) THEN
+            NXY=1001
+            T1=FLOT
+          ELSE
+            CALL XABORT('PKINI: INTEGER OR REAL DATA EXPECTED.')
+          ENDIF
+          ALLOCATE(X(NXY),Y(NXY))
+          CALL REDGET(ITYP,NITMA,T2,TEXT12,DFLOT)
+          IF(ITYP.NE.2) CALL XABORT('PKINI: REAL DATA EXPECTED(2).')
+          IF(T2.LE.T1) CALL XABORT('PKINI: T2 > T1 EXPECTED.')
+          DELT=(T2-T1)/REAL(NXY-1)
+          TT=T1
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+          IF(ITYP.NE.3)CALL XABORT('PKINI: CHARACTER DATA EXPECTED.')
+          IF(TEXT12.NE.'P-VALV') CALL XABORT('PKINI: P-VALV EXPECTED.')
+          CALL REDGET(ITYP,NITMA,GAMMA,TEXT12,DFLOT)
+          IF(ITYP.NE.2) CALL XABORT('PKINI: REAL DATA EXPECTED(3).')
+          CALL REDGET(ITYP,NITMA,PINIT,TEXT12,DFLOT)
+          IF(ITYP.NE.2) CALL XABORT('PKINI: REAL DATA EXPECTED(4).')
+          CALL REDGET(ITYP,NITMA,PFINAL,TEXT12,DFLOT)
+          IF(ITYP.NE.2) CALL XABORT('PKINI: REAL DATA EXPECTED(5).')
+          CALL REDGET(ITYP,NITMA,TB1,TEXT12,DFLOT)
+          IF(ITYP.NE.2) CALL XABORT('PKINI: REAL DATA EXPECTED(6).')
+          IF(TB1.LT.T1) CALL XABORT('PKINI: INVALID VALUE OF TB1.')
+          CALL REDGET(ITYP,NITMA,B1,TEXT12,DFLOT)
+          IF(ITYP.NE.2) CALL XABORT('PKINI: REAL DATA EXPECTED(7).')
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+          IF(ITYP.NE.3)CALL XABORT('PKINI: CHARACTER DATA EXPECTED.')
+          TB2=T2
+          PFINA2=PFINAL
+          IF(TEXT12.EQ.'RESET') THEN
+            CALL REDGET(ITYP,NITMA,PFINA2,TEXT12,DFLOT)
+            IF(ITYP.NE.2) CALL XABORT('PKINI: REAL DATA EXPECTED(8).')
+            IF(PFINA2.GT.PFINAL) CALL XABORT('PKINI: INVALID VALUE OF'
+     >      //' PFINA2.')
+            CALL REDGET(ITYP,NITMA,TB2,TEXT12,DFLOT)
+            IF(ITYP.NE.2) CALL XABORT('PKINI: REAL DATA EXPECTED(9).')
+            IF(TB2.LE.TB1) CALL XABORT('PKINI: INVALID VALUE OF TB2.')
+            CALL REDGET(ITYP,NITMA,B2,TEXT12,DFLOT)
+            IF(ITYP.NE.2) CALL XABORT('PKINI: REAL DATA EXPECTED(10).')
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+            IF(ITYP.NE.3)CALL XABORT('PKINI: CHARACTER DATA EXPECTED.')
+          ENDIF
+*
+          ALPHA=2.0*GAMMA/(GAMMA-1.0)
+          YGAR=PINIT
+          DO I=1,NXY
+            X(I)=TT
+            IF(TT.LE.TB1) THEN
+              Y(I)=PINIT
+            ELSE IF(TT.LE.TB2) THEN
+              Y(I)=MAX(PINIT/((B1*(TT-TB1)+1.0))**ALPHA,PFINAL)
+              YGAR=Y(I)
+            ELSE
+              Y(I)=MAX(YGAR/((B2*(TT-TB2)+1.0))**ALPHA,PFINA2)
+            ENDIF
+            TT=TT+DELT
+          ENDDO
+        ELSE
+          CALL XABORT('PKINI: INTEGER OR CHARACTER DATA EXPECTED.')
+        ENDIF
+        CALL LCMPUT(KPMAP,'TIME-LAW-T',NXY,2,X)
+        CALL LCMPUT(KPMAP,'TIME-LAW-P',NXY,2,Y)
+        CALL LCMPUT(KPMAP,'TIME-LAW-I',1,5,LCUBIC)
+        DEALLOCATE(Y,X)
+        GO TO 30
+      ELSE IF(TEXT12.EQ.';') THEN
+        GO TO 70
+      ELSE
+        CALL XABORT('PKINI: INVALID KEYWORD: '//TEXT12//'.')
+      ENDIF
+      GO TO 10
+*----
+*  RECOVER THE INITIAL GLOBAL PARAMETER VALUES
+*----
+   70 ALLOCATE(PARAMI(NALPHA))
+      IF(IMPX.GT.0) WRITE(6,110)
+      DO IAL=1,NALPHA
+        DO IPAR=1,NPARM
+          KPPAR=LCMGIL(JPPAR,IPAR)
+          CALL LCMGTC(KPPAR,'P-NAME',12,HPNAME)
+          IF(HPNAME.EQ.HPARAM(IAL)) GO TO 80
+        ENDDO
+        CALL XABORT('PKINI: GLOBAL PARAMETER NOT FOUND.')
+   80   CALL LCMLEN(KPPAR,'P-VALUE',ILONG,ITYLCM)
+        IF(ILONG.EQ.0) THEN
+          WRITE(HSMG,'(33HPKINI: VALUE OF GLOBAL PARAMETER ,A,6H IS NO,
+     1    20H SET IN THE FUELMAP.)') HPNAME
+          CALL XABORT(HSMG)
+        ENDIF
+        CALL LCMGET(KPPAR,'P-VALUE',PARAMI(IAL))
+        IF(IMPX.GT.0) WRITE(6,120) IAL,HPNAME,PARAMI(IAL)
+      ENDDO
+      CALL LCMPUT(IPMAP,'P-VALUE-INIT',NALPHA,2,PARAMI)
+      CALL LCMPTC(IPMAP,'P-NAME',12,NALPHA,HPARAM)
+*----
+*  SET INITIAL SOLUTION OF POINT KINETIC EQUATIONS
+*----
+      IF(POW0.EQ.0.0) CALL XABORT('PKINI: INITIAL POWER NOT DEFINED.')
+      IF(NGROUP.EQ.0) CALL XABORT('PKINI: NGROUP NOT DEFINED.')
+      ALLOCATE(YINIT(NGROUP+1))
+      YINIT(1)=POW0
+      DO I=2,NGROUP+1
+         YINIT(I)=POW0*BETAI(I-1)/(LAMBDAI(I-1)*LAMBDA)
+      ENDDO  
+*----
+*  SAVE INITIAL CONDITIONS
+*----
+      ISTAGE=1
+      TIMES(:MAXTIM)=-1.0E30
+      TIMES(1)=T
+      TEXT12='PKIN-DAT0001'
+      IF(IMPX.GT.0) WRITE(6,130) T,TEXT12
+      CALL LCMSIX(IPMAP,TEXT12,1)
+        CALL LCMPUT(IPMAP,'P-VALUE',NALPHA,2,PARAMI)
+        CALL LCMPUT(IPMAP,'Y-VALUE',NGROUP+1,4,YINIT)
+        CALL LCMPUT(IPMAP,'T-VALUE',1,2,T)
+        CALL LCMPUT(IPMAP,'DT-VALUE',1,2,DT)
+        CALL LCMPUT(IPMAP,'I-VALUE',1,1,ISTAGE)
+      CALL LCMSIX(IPMAP,' ',2)
+      DEALLOCATE(PARAMI,YINIT,LAMBDAI,BETAI)
+      CALL LCMPUT(IPMAP,'PKIN-TIMES',MAXTIM,2,TIMES)
+*----
+*  CREATE STATE VECTOR AND SAVE POWER INFORMATION
+*----
+      ISTATE(:NSTATE)=0
+      ISTATE(1)=ISTAGE
+      ISTATE(2)=NGROUP
+      ISTATE(3)=NALPHA
+      ISTATE(4)=NPTIME
+      CALL LCMPUT(IPMAP,'STATE-VECTOR',NSTATE,1,ISTATE)
+      IF(IMPX.GT.0) WRITE(6,140) ISTATE(2:4)
+      IF(IMPX.GT.1) CALL LCMLIB(IPMAP)
+      CALL LCMSIX(IPMAP,' ',2)
+      IF(IMPX.GT.0) WRITE(6,150) POW0
+      CALL LCMPUT(IPMAP,'REACTOR-PW',1,2,POW0)
+      CALL LCMLEN(IPMAP,'BUND-PW',ILONG,ITYLCM)
+      CALL LCMLEN(IPMAP,'AXIAL-FPW',JLONG,ITYLCM)
+      IF((ILONG.EQ.NCH*NB).AND.(JLONG.EQ.NB)) THEN
+        ALLOCATE(VAL(NCH,NB),FPOWER(ILONG))
+        CALL LCMGET(IPMAP,'AXIAL-FPW',FPOWER)
+        DSUM=0.0
+        DO IB=1,NB
+          DSUM=DSUM+FPOWER(IB)
+        ENDDO
+        DO ICH=1,NCH
+          DO IB=1,NB
+            VAL(ICH,IB)=FPOWER(IB)*POW0*1.0E3/(DSUM*REAL(NCH))
+          ENDDO
+        ENDDO
+        CALL LCMPUT(IPMAP,'BUND-PW',NCH*NB,2,VAL)
+        DEALLOCATE(FPOWER,VAL)
+      ENDIF
+      RETURN
+*
+  100 FORMAT(/34H PKINI: DEFINE INITIAL STAGE TIME=,1P,E12.4,2H S,
+     1 10H DURATION=,E12.4,2H S)
+  110 FORMAT(43H PKINI: GLOBAL PARAMETER -- INITIAL VALUES:)
+  120 FORMAT(1X,I8,A14,3H = ,1P,E12.4)
+  130 FORMAT(/40H PKINI: SAVE INFORMATION RELATED TO TIME,1P,E12.4,
+     1 27H S IN LCM DIRECTORY NAMED ',A12,2H'.)
+  140 FORMAT(/
+     1 14H STATE VECTOR:/
+     2 7H NGROUP,I9,39H   (NUMBER OF DELAYED PRECURSOR GROUPS)/
+     3 7H NALPHA,I9,34H   (NUMBER OF FEEDBACK PARAMETERS)/
+     4 7H NPTIME,I9,40H   (NUMBER OF TIME-DEPENDENT PARAMETERS))
+  150 FORMAT(/22H PKINI: INITIAL POWER=,1P,E12.4,3H MW)
+      END
diff --git a/Donjon/src/PKINS.f b/Donjon/src/PKINS.f
new file mode 100644
index 0000000..97e4088
--- /dev/null
+++ b/Donjon/src/PKINS.f
@@ -0,0 +1,371 @@
+*DECK PKINS
+      SUBROUTINE PKINS(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Solve the point kinetic equations and apply global feedback.
+*
+*Copyright:
+* Copyright (C) 2017 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The PKINS: module specification is:
+* [ MAPFL := ] PKINS: MAPFL :: (descpkins) ;
+* where
+*   MAPFL : name of the \emph{map} object containing fuel regions description 
+*     and global parameter informations. This object is declared in read-only 
+*     mode if and only if keyword PICKR is set.
+*   (descpkins) : structure describing the input data to the PKINS: module. 
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER (NSTATE=40,MAXTIM=2)
+      INTEGER ISTATE(NSTATE)
+      TYPE(C_PTR) IPMAP,JPMAP,JPPAR,KPPAR
+      REAL LAMBDA,TIMES(MAXTIM)
+      DOUBLE PRECISION DFLOT,DT_D,T_D,DH,RHO(3)
+      CHARACTER TEXT12*12,HSIGN*12,HPNAME*12,HSMG*131
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      REAL, ALLOCATABLE, DIMENSION(:) :: BETAI,LAMBDAI,PARAMI,PARAMB,
+     1 FPOWER
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: VAL
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: Y
+      CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: HPARAM
+*----
+*  RECOVER THE FUELMAP
+*----
+      IF(NENTRY.NE.1) CALL XABORT('PKINS: ONE PARAMETER EXPECTED.')
+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2))CALL XABORT('PKINS:'
+     1 //' LCM OBJECT EXPECTED.')
+      IF(JENTRY(1).EQ.0) CALL XABORT('PKINS: SECOND ENTRY IN READ-ONLY'
+     1  //' OR MODIFICATION MODE EXPECTED.')
+      IPMAP=KENTRY(1)
+      CALL LCMGTC(IPMAP,'SIGNATURE',12,HSIGN)
+      IF(HSIGN.NE.'L_MAP') THEN
+         TEXT12=HENTRY(1)
+         CALL XABORT('PKINS: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     1   '. L_MAP EXPECTED.')
+      ENDIF
+      CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+      NB=ISTATE(1)
+      NCH=ISTATE(2)
+      NPARM=ISTATE(8)
+      IF(NPARM.GT.0) JPPAR=LCMGID(IPMAP,'PARAM')
+      IF(NCH.NE.1) CALL XABORT('PKINS: ONE CHANNEL EXPECTED.')
+      JPMAP=LCMGID(IPMAP,'P-KINETIC')
+      CALL LCMGET(JPMAP,'STATE-VECTOR',ISTATE)
+      NGROUP=ISTATE(2)
+      NALPHA=ISTATE(3)
+      ALLOCATE(HPARAM(NALPHA),PARAMI(NALPHA),PARAMB(NALPHA),Y(NGROUP+1))
+*----
+*  READ INPUT DATA
+*----
+      IMPX=1
+      T=0.0
+      DT=0.0
+   10 CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('PKINS: CHARACTER DATA EXPECTED.')
+      IF(TEXT12.EQ.'EDIT') THEN
+*       READ PRINTING INDEX
+        CALL REDGET(ITYP,IMPX,FLOT,TEXT12,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('PKINS: INTEGER FOR EDIT EXPECTED.')
+      ELSE IF(TEXT12.EQ.'TIME') THEN
+*       Set initial time and stage length (s)
+        CALL REDGET(ITYP,NITMA,T,TEXT12,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('PKINS: REAL FOR T EXPECTED.')
+        CALL REDGET(ITYP,NITMA,DT,TEXT12,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('PKINS: REAL FOR DT EXPECTED.')
+        IF(IMPX.GT.0) WRITE(6,100) T,DT
+      ELSE IF(TEXT12.EQ.'Y-INIT') THEN
+*       Read solution of point kinetic equations at beginning-of-stage
+        IF(DT.EQ.0.0) CALL XABORT('PKINS: DT NOT SET.')
+        DO I=1,NGROUP+1
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT12,Y(I))
+          IF(ITYP.NE.4)CALL XABORT('PKINS: DOUBLE FOR Y EXPECTED.')
+        ENDDO
+        CALL LCMGET(JPMAP,'PKIN-TIMES',TIMES)
+        ITIM=0
+        DO I=1,MAXTIM
+          IF(ABS(TIMES(I)-T).LE.1.0E-4*DT) ITIM=I
+        ENDDO
+        IF(ITIM.EQ.0) THEN
+*         unable to find initial contitions
+          WRITE(HSMG,'(44HPKINS: UNABLE TO FIND BEGINNING-OF-STAGE CON,
+     1    13HTITIONS AT T=,1P E12.4,6H S(1).)') T
+          CALL XABORT(HSMG)
+        ENDIF
+        WRITE(TEXT12,'(8HPKIN-DAT,I4.4)') ITIM
+        IF(IMPX.GT.0) WRITE(6,160) T,TEXT12
+        CALL LCMSIX(JPMAP,TEXT12,1)
+          CALL LCMPUT(JPMAP,'Y-VALUE',NGROUP+1,4,Y)
+        CALL LCMSIX(JPMAP,' ',2)
+      ELSE IF(TEXT12.EQ.'POWER') THEN
+*       Read power (MW)
+        IF(DT.EQ.0.0) CALL XABORT('PKINS: DT NOT SET.')
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('PKINS: REAL FOR POW EXPECTED.')
+        CALL LCMGET(JPMAP,'Y-VALUE',Y)
+        Y(1)=DFLOT
+        CALL LCMGET(JPMAP,'PKIN-TIMES',TIMES)
+        ITIM=0
+        DO I=1,MAXTIM
+          IF(ABS(TIMES(I)-T).LE.1.0E-4*DT) ITIM=I
+        ENDDO
+        IF(ITIM.EQ.0) THEN
+*         unable to find initial contitions
+          WRITE(HSMG,'(44HPKINS: UNABLE TO FIND BEGINNING-OF-STAGE CON,
+     1    13HTITIONS AT T=,1P E12.4,6H S(2).)') T
+          CALL XABORT(HSMG)
+        ENDIF
+        WRITE(TEXT12,'(8HPKIN-DAT,I4.4)') ITIM
+        IF(IMPX.GT.0) WRITE(6,160) T,TEXT12
+        CALL LCMSIX(JPMAP,TEXT12,1)
+          CALL LCMPUT(JPMAP,'Y-VALUE',NGROUP+1,4,Y)
+        CALL LCMSIX(JPMAP,' ',2)
+      ELSE IF(TEXT12.EQ.';') THEN
+        IPICK=0
+        GO TO 20
+      ELSE IF(TEXT12.EQ.'PICK') THEN
+        IPICK=1
+        GO TO 20
+      ELSE IF(TEXT12.EQ.'PICKR') THEN
+        IPICK=2
+        GO TO 20
+      ELSE
+        CALL XABORT('PKINS: INVALID KEYWORD: '//TEXT12//'.')
+      ENDIF
+      GO TO 10
+*----
+*  RECOVER THE GLOBAL PARAMETER VALUES AT THE BEGINNING OF TIME STAGE
+*----
+   20 IF(IMPX.GT.0) WRITE(6,110)
+      CALL LCMGTC(JPMAP,'P-NAME',12,NALPHA,HPARAM)
+      DO IAL=1,NALPHA
+        DO IPAR=1,NPARM
+          KPPAR=LCMGIL(JPPAR,IPAR)
+          CALL LCMGTC(KPPAR,'P-NAME',12,HPNAME)
+          IF(HPNAME.EQ.HPARAM(IAL)) GO TO 30
+        ENDDO
+        CALL XABORT('PKINS: GLOBAL PARAMETER NOT FOUND.')
+   30   CALL LCMLEN(KPPAR,'P-VALUE',ILONG,ITYLCM)
+        IF(ILONG.EQ.0) THEN
+          WRITE(HSMG,'(33HPKINS: VALUE OF GLOBAL PARAMETER ,A,6H IS NO,
+     1    20H SET IN THE FUELMAP.)') HPNAME
+          CALL XABORT(HSMG)
+        ENDIF
+        CALL LCMGET(KPPAR,'P-TYPE',ITYPE)
+        IF(ITYPE.EQ.1) THEN
+          CALL LCMGET(KPPAR,'P-VALUE',PARAMB(IAL))
+        ELSE IF(ITYPE.EQ.2) THEN
+          ALLOCATE(VAL(NCH,NB),FPOWER(NB))
+          CALL LCMGET(KPPAR,'P-VALUE',VAL)
+          CALL LCMLEN(IPMAP,'AXIAL-FPW',JLONG,ITYLCM)
+          IF((ILONG.NE.NCH*NB).OR.(JLONG.NE.NB)) CALL XABORT('PKINS: U'
+     1    //'NABLE TO FIND RECORD AXIAL-FPW IN THE FUELMAP.')
+          CALL LCMGET(IPMAP,'AXIAL-FPW',FPOWER)
+          DD1=0.0
+          DD2=0.0
+          DO ICH=1,NCH
+            DO IB=1,NB
+              DD1=DD1+VAL(ICH,IB)*FPOWER(IB)**2
+              DD2=DD2+FPOWER(IB)**2
+            ENDDO
+          ENDDO
+          PARAMB(IAL)=DD1/DD2
+          DEALLOCATE(FPOWER,VAL)
+        ENDIF
+        IF(IMPX.GT.0) WRITE(6,120) IAL,HPNAME,PARAMB(IAL)
+      ENDDO
+*----
+*  COMPUTE THE REACTIVITY AT TIME T
+*----
+      RHO(1)=0.0D0
+      IF((DT.EQ.0.0).AND.(NALPHA.GT.0)) THEN
+        CALL LCMGET(JPMAP,'P-VALUE-INIT',PARAMI)
+        DH=0.0D0
+        T_D=T
+        CALL PKIRHO(JPMAP,NALPHA,T_D,DH,PARAMI,PARAMB,RHO)
+      ENDIF
+*----
+*  SOLVE THE POINT KINETIC EQUATIONS
+*----
+      IF(DT.GT.0.0) THEN
+        ALLOCATE(BETAI(NGROUP),LAMBDAI(NGROUP))
+        CALL LCMGET(JPMAP,'LAMBDA',LAMBDA)
+        CALL LCMGET(JPMAP,'EPSILON',EPSILON)
+        CALL LCMGET(JPMAP,'BETAI',BETAI)
+        CALL LCMGET(JPMAP,'LAMBDAI',LAMBDAI)
+        CALL LCMGET(JPMAP,'P-VALUE-INIT',PARAMI)
+*
+        CALL LCMGET(JPMAP,'PKIN-TIMES',TIMES)
+        ITIM=0
+        DO I=1,MAXTIM
+          IF(ABS(TIMES(I)-T).LE.1.0E-4*DT) ITIM=I
+        ENDDO
+        IF(ITIM.EQ.0) THEN
+*         unable to find initial contitions
+          WRITE(HSMG,'(44HPKINS: UNABLE TO FIND BEGINNING-OF-STAGE CON,
+     1    13HTITIONS AT T=,1P E12.4,6H S(3).)') T
+          CALL XABORT(HSMG)
+        ENDIF
+        WRITE(TEXT12,'(8HPKIN-DAT,I4.4)') ITIM
+        IF(IMPX.GT.0) WRITE(6,130) T,TEXT12
+        CALL LCMSIX(JPMAP,TEXT12,1)
+          CALL LCMGET(JPMAP,'T-VALUE',TT)
+          IF(ABS(T-TT).GT.1.0E-4*DT) CALL XABORT('PKINS: INVALID TIME '
+     1    //'RECORD.')
+          CALL LCMGET(JPMAP,'Y-VALUE',Y)
+          CALL LCMGET(JPMAP,'I-VALUE',ISTAGE)
+        CALL LCMSIX(JPMAP,' ',2)
+        IF(IMPX.GT.0) WRITE(6,140) ISTAGE
+        IF(IMPX.GT.0) WRITE(6,150) T,T+DT,Y(1)
+        ISTAGE=ISTAGE+1
+        DT_D=DT
+        T_D=T
+        CALL PKIDRV(JPMAP,NALPHA,NGROUP,LAMBDA,EPSILON,BETAI,LAMBDAI,
+     1  DT_D,PARAMI,PARAMB,T_D,Y)
+        T=REAL(T_D)
+        ITIM=0
+        DO I=1,MAXTIM
+          IF(ABS(TIMES(I)-T).LE.1.0E-4*DT) ITIM=I
+        ENDDO
+        IF(ITIM.EQ.0) THEN
+*         add end-of-stage info in a new slot
+          ITIM=MOD(ISTAGE-1,MAXTIM)+1
+          TIMES(ITIM)=T
+        ENDIF
+        WRITE(TEXT12,'(8HPKIN-DAT,I4.4)') ITIM
+        IF(IMPX.GT.0) WRITE(6,160) T,TEXT12
+        CALL LCMSIX(JPMAP,TEXT12,1)
+          CALL LCMPUT(JPMAP,'Y-VALUE',NGROUP+1,4,Y)
+          CALL LCMPUT(JPMAP,'T-VALUE',1,2,T)
+          CALL LCMPUT(JPMAP,'DT-VALUE',1,2,DT)
+          CALL LCMPUT(JPMAP,'I-VALUE',1,1,ISTAGE)
+        CALL LCMSIX(JPMAP,' ',2)
+        CALL LCMPUT(JPMAP,'PKIN-TIMES',MAXTIM,2,TIMES)
+        IF(IMPX.GT.0) WRITE(6,170) ISTAGE,T,Y(1)
+        DEALLOCATE(LAMBDAI,BETAI)
+        POW=REAL(Y(1))
+*----
+*  SAVE THE GLOBAL PARAMETER VALUES AT THE END OF TIME STAGE
+*----
+        IF(IMPX.GT.0) WRITE(6,180)
+        DO IAL=1,NALPHA
+          DO IPAR=1,NPARM
+            KPPAR=LCMGIL(JPPAR,IPAR)
+            CALL LCMGTC(KPPAR,'P-NAME',12,HPNAME)
+            IF(HPNAME.EQ.HPARAM(IAL)) GO TO 40
+          ENDDO
+          CALL XABORT('PKINS: GLOBAL PARAMETER NOT FOUND.')
+   40     CALL LCMPUT(KPPAR,'P-VALUE',1,2,PARAMB(IAL))
+          ITYPE=1
+          CALL LCMPUT(KPPAR,'P-TYPE',1,1,ITYPE)
+          IF(IMPX.GT.0) WRITE(6,120) IAL,HPNAME,PARAMB(IAL)
+        ENDDO
+      ENDIF
+      DEALLOCATE(PARAMB,PARAMI,HPARAM)
+*----
+*  RECOVER THE FINAL POWER AND SAVE IT IN A CLE-2000 VARIABLE
+*----
+      IF(IPICK.EQ.1) THEN
+         IF(DT.EQ.0.0) CALL XABORT('PKINS: DT>0 EXPECTED.')
+         CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+         IF(ITYP.NE.-2) CALL XABORT('PKINS: OUTPUT REAL EXPECTED(1).')
+         ITYP=2
+         FLOT=REAL(Y(1))
+         CALL REDPUT(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+         CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+         IF((ITYP.NE.3).OR.(TEXT12.NE.';')) THEN
+           CALL XABORT('PKINS: ; CHARACTER EXPECTED(1).')
+         ENDIF      
+      ELSE IF(IPICK.EQ.2) THEN
+         IF(DT.NE.0.0) CALL XABORT('PKINS: DT=0 EXPECTED.')
+         IF(JENTRY(1).NE.2) CALL XABORT('PKINS: SECOND ENTRY IN READ-O'
+     1  //'NLY MODE EXPECTED.')
+         CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+         IF(ITYP.NE.-2) CALL XABORT('PKINS: OUTPUT REAL EXPECTED(2).')
+         ITYP=2
+         FLOT=REAL(RHO(1))
+         CALL REDPUT(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+         CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+         IF((ITYP.NE.3).OR.(TEXT12.NE.';')) THEN
+           CALL XABORT('PKINS: ; CHARACTER EXPECTED(2).')
+         ENDIF      
+      ENDIF      
+      DEALLOCATE(Y)
+*----
+*  UPDATE STATE VECTOR AND SAVE POWER
+*----
+      IF(DT.GT.0.0) THEN
+        ISTATE(1)=ISTAGE
+        CALL LCMPUT(JPMAP,'STATE-VECTOR',NSTATE,1,ISTATE)
+        CALL LCMPUT(IPMAP,'REACTOR-PW',1,2,POW)
+        CALL LCMLEN(IPMAP,'BUND-PW',ILONG,ITYLCM)
+        CALL LCMLEN(IPMAP,'AXIAL-FPW',JLONG,ITYLCM)
+        IF((ILONG.EQ.NCH*NB).AND.(JLONG.EQ.NB)) THEN
+          ALLOCATE(VAL(NCH,NB),FPOWER(ILONG))
+          CALL LCMGET(IPMAP,'AXIAL-FPW',FPOWER)
+          DSUM=0.0
+          DO IB=1,NB
+            DSUM=DSUM+FPOWER(IB)
+          ENDDO
+          DO ICH=1,NCH
+            DO IB=1,NB
+              VAL(ICH,IB)=FPOWER(IB)*POW*1.0E3/(DSUM*REAL(NCH))
+            ENDDO
+          ENDDO
+          CALL LCMPUT(IPMAP,'BUND-PW',NCH*NB,2,VAL)
+          DEALLOCATE(FPOWER,VAL)
+        ENDIF
+      ENDIF
+      RETURN
+*
+  100 FORMAT(/36H PKINS: REDEFINE INITIAL STAGE TIME=,1P,E12.4,2H S,
+     1 15H WITH DURATION=,E12.4,2H S)
+  110 FORMAT(54H PKINS: GLOBAL PARAMETER -- BEGINNING-OF-STAGE VALUES:)
+  120 FORMAT(1X,I8,A14,3H = ,1P,E12.4)
+  130 FORMAT(/43H PKINS: RECOVER INFORMATION RELATED TO TIME,1P,E12.4,
+     1 29H S FROM LCM DIRECTORY NAMED ',A12,2H'.)
+  140 FORMAT(1X,18(1H*)/8H * STAGE,I9,2H */1X,18(1H*))
+  150 FORMAT(/27H PKINS: INITIAL STAGE TIME=,1P,E12.4,14H S FINAL TIME=,
+     1 E12.4,17H S INITIAL POWER=,E12.4,3H MW)
+  160 FORMAT(/40H PKINS: SAVE INFORMATION RELATED TO TIME,1P,E12.4,
+     1 27H S IN LCM DIRECTORY NAMED ',A12,2H'.)
+  170 FORMAT(/16H PKINS: ##STAGE=,I8,12H FINAL TIME=,1P,E12.4,
+     1 15H S FINAL POWER=,E12.4,3H MW)
+  180 FORMAT(48H PKINS: GLOBAL PARAMETER -- END-OF-STAGE VALUES:)
+      END
diff --git a/Donjon/src/PKIRHO.f b/Donjon/src/PKIRHO.f
new file mode 100644
index 0000000..ad560a5
--- /dev/null
+++ b/Donjon/src/PKIRHO.f
@@ -0,0 +1,156 @@
+*DECK PKIRHO
+      SUBROUTINE PKIRHO(IPMAP,NALPHA,T,H,PARAMI,PARAMB,RHO)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute the reactivity during a Runge-Kutta time step taking into
+* account feedback effects.
+*
+*Copyright:
+* Copyright (C) 2017 Ecole Polytechnique de Montreal
+* This library is free software; you can redIribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPMAP   pointer to the point kinetic directory
+* NALPHA  number of feedback parameters
+* T       time at beggining of step
+* H       time-step duration
+* PARAMI  initial values of the global parameters corresponding to
+*         RHO=0
+* PARAMB  values of global parameters at beginning of stage
+*
+*Parameters: ouput
+* PARAMB  values of global parameters at end of Runge-Kutta time step
+* RHO     reactivity during Runge-Kutta time step
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  Subroutine arguments
+*----
+      TYPE(C_PTR) IPMAP
+      INTEGER NALPHA
+      REAL PARAMI(NALPHA),PARAMB(NALPHA)
+      DOUBLE PRECISION T,H,RHO(3)
+*----
+*  Local variables
+*----
+      TYPE(C_PTR) JPPAR,KPPAR
+      TYPE(C_PTR) X_PTR,Y_PTR
+      DOUBLE PRECISION TS(3),DSUM
+      LOGICAL LCUBIC
+*----
+*  Allocatable arrays
+*----
+      REAL, POINTER, DIMENSION(:) :: X,Y
+      REAL, ALLOCATABLE, DIMENSION(:) :: TERP,GAR
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: PARAM
+*----
+*  Compute the values of the global parameters during the time step
+*----
+      TS(1)=T
+      TS(2)=T+H/2.0D0
+      TS(3)=T+H
+      ALLOCATE(PARAM(3,NALPHA))
+      DO IAL=1,NALPHA
+         PARAM(:3,IAL)=PARAMB(IAL)
+      ENDDO
+      JPPAR=LCMGID(IPMAP,'ALPHA')
+      DO IAL=1,NALPHA
+        KPPAR=LCMGIL(JPPAR,IAL)
+        CALL LCMLEN(KPPAR,'TIME-LAW-T',NXY,ITYLCM)
+        IF(NXY.NE.0) THEN
+          ALLOCATE(TERP(NXY))
+          CALL LCMGPD(KPPAR,'TIME-LAW-T',X_PTR)
+          CALL C_F_POINTER(X_PTR,X,(/ NXY /))
+          CALL LCMGPD(KPPAR,'TIME-LAW-P',Y_PTR)
+          CALL C_F_POINTER(Y_PTR,Y,(/ NXY /))
+          CALL LCMGET(KPPAR,'TIME-LAW-I',LCUBIC)
+          DO I=1,3
+            CALL ALTERP(LCUBIC,NXY,X,REAL(TS(I)),.FALSE.,TERP)
+            DSUM=0.0D0
+            DO J=1,NXY
+              DSUM=DSUM+TERP(J)*Y(J)
+            ENDDO
+            PARAM(I,IAL)=REAL(DSUM)
+          ENDDO
+          PARAMB(IAL)=PARAM(3,IAL)
+          DEALLOCATE(TERP)
+        ENDIF
+      ENDDO
+*----
+*  Compute the reactivity
+*----
+      RHO(:3)=0.0D0
+      JPPAR=LCMGID(IPMAP,'ALPHA')
+      DO IAL=1,NALPHA
+        KPPAR=LCMGIL(JPPAR,IAL)
+        CALL LCMLEN(KPPAR,'ALPHA-LAW-P',NXY,ITYLCM)
+        IF(NXY.NE.0) THEN
+          ALLOCATE(TERP(NXY),GAR(NXY))
+          CALL LCMGPD(KPPAR,'ALPHA-LAW-P',X_PTR)
+          CALL C_F_POINTER(X_PTR,X,(/ NXY /))
+          CALL LCMGPD(KPPAR,'ALPHA-LAW-R',Y_PTR)
+          CALL C_F_POINTER(Y_PTR,Y,(/ NXY /))
+          CALL LCMGET(KPPAR,'ALPHA-LAW-T',ITYPE)
+          CALL LCMGET(KPPAR,'ALPHA-LAW-I',LCUBIC)
+          DO I=1,3
+            IF(ITYPE.EQ.1) THEN
+              CALL ALTERP(LCUBIC,NXY,X,PARAM(I,IAL),.FALSE.,TERP)
+              CALL ALTERP(LCUBIC,NXY,X,PARAMI(IAL),.FALSE.,GAR)
+              DSUM=0.0D0
+              DO J=1,NXY
+                DSUM=DSUM+(TERP(J)-GAR(J))*Y(J)
+              ENDDO
+            ELSE IF((ITYPE.EQ.2).AND.(PARAMI(IAL).LT.PARAM(I,IAL))) THEN
+              CALL ALTERI(LCUBIC,NXY,X,PARAMI(IAL),PARAM(I,IAL),TERP)
+              DSUM=0.0D0
+              DO J=1,NXY
+                DSUM=DSUM+TERP(J)*Y(J)
+              ENDDO
+            ELSE IF((ITYPE.EQ.2).AND.(PARAMI(IAL).GT.PARAM(I,IAL))) THEN
+              CALL ALTERI(LCUBIC,NXY,X,PARAM(I,IAL),PARAMI(IAL),TERP)
+              DSUM=0.0D0
+              DO J=1,NXY
+                DSUM=DSUM-TERP(J)*Y(J)
+              ENDDO
+            ELSE IF(ITYPE.EQ.3) THEN
+              DO J=1,NXY
+                GAR(J)=SQRT(X(J))
+              ENDDO
+              GAR1=SQRT(PARAMI(IAL))
+              GAR2=SQRT(PARAM(I,IAL))
+              IF(GAR1.LT.GAR2) THEN
+                CALL ALTERI(LCUBIC,NXY,GAR,GAR1,GAR2,TERP)
+                DSUM=0.0D0
+                DO J=1,NXY
+                  DSUM=DSUM+TERP(J)*Y(J)
+                ENDDO
+              ELSE IF(GAR2.LT.GAR1) THEN
+                CALL ALTERI(LCUBIC,NXY,GAR,GAR2,GAR1,TERP)
+                DSUM=0.0D0
+                DO J=1,NXY
+                  DSUM=DSUM-TERP(J)*Y(J)
+                ENDDO
+              ELSE
+                CYCLE
+              ENDIF
+            ELSE
+              CYCLE
+            ENDIF
+            RHO(I)=RHO(I)+DSUM
+           ENDDO
+           DEALLOCATE(GAR,TERP)
+         ENDIF
+      ENDDO
+      DEALLOCATE(PARAM)
+      RETURN
+      END
diff --git a/Donjon/src/PLDRV.f b/Donjon/src/PLDRV.f
new file mode 100644
index 0000000..7b75d2a
--- /dev/null
+++ b/Donjon/src/PLDRV.f
@@ -0,0 +1,190 @@
+*DECK PLDRV
+      SUBROUTINE PLDRV(IPOPT,N0,NCST,M0,MINMAX,IMTHD,FCOST,XOBJ,PDG,
+     >           GRAD,INEGAL,CONTR,DINF,DSUP,XDROIT,EPSIM,IMPR,IERR)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Prepares the different matrices for the resolution of a linear
+* optimisation problem with a quadratic constraint. The different
+* available methods are the MAP technique, the lemke, the augmented-
+* Lagrangian and the penalty function.
+* PLDRV = Linear Programmation DRiVer for options
+*
+*Copyright:
+* Copyright (C) 2002 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert and R. Chambon
+*
+*Parameters: input
+* IPOPT   pointer to the L_OPTIMIZE object.
+* N0      number of control variables.
+* NCST    number of constraints.
+* M0      number of constraints plus the number of lower/upper bounds
+*         intercepting the quadratic constraint.
+* MINMAX  type of optimization (=-1: minimize; =1: maximize).
+* IMTHD   type of solution (=1: SIMPLEX/LEMKE; =2: LEMKE/LEMKE;
+*         =3: MAP; =4: Augmented Lagragian; =5: External penalty
+*         funnction).
+* FCOST   objective function.
+* XOBJ    control variables.
+* PDG     weights assigned to control variables in the quadratic
+*         constraint.
+* GRAD    linearized gradients (GRAD(:,1) are control variable costs
+*         and GRAD(:,2:NCST+1) are linear constraint coefficients).
+* INEGAL  constraint relations (=-1 for .GE.; =0 for .EQ.; =1 for .LE.).
+* CONTR   constraint right hand sides.
+* DINF    lower bounds of control variables.
+* DSUP    upper bounds of control variables.
+* XDROIT  quadratic constraint radius squared.
+* EPSIM   tolerence used for inner linear LEMKE or SIMPLEX calculation.
+* IMPR    print flag.
+*
+*Parameters: ouput
+* IERR    return code (=0: normal completion).
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPOPT
+      INTEGER N0,NCST,M0,MINMAX,IMTHD,INEGAL(NCST),IMPR,IERR
+      DOUBLE PRECISION FCOST,XOBJ(N0),PDG(N0),GRAD(N0,NCST+1),
+     >     CONTR(NCST),DINF(N0),DSUP(N0),XDROIT,EPSIM
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER      ME,MI,I,J,NPM
+      DOUBLE PRECISION  XX
+      CHARACTER    CLNAME*6
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: INPLUS
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: BPLUS,GF
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: APLUS
+*----
+*  DATA STATEMENTS
+*----
+      DATA         CLNAME /'PLDRV'/
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(INPLUS(M0+1))
+      ALLOCATE(BPLUS(M0+2),GF(N0),APLUS(M0+2,(M0+1)+N0))
+*----
+*  SET COSTS OF CONTROL VARIABLES
+*----
+      DO 10 I=1,N0
+         GF(I)=GRAD(I,1)*REAL(MINMAX)
+   10 CONTINUE
+*----
+*  ORGANIZE TABLES APLUS AND BPLUS FOR EQUALITY CONSTRAINTS
+*----
+      ME=0
+      DO 30 I=1,NCST
+         IF(INEGAL(I).EQ.0) THEN
+            ME = ME + 1
+            DO 20 J=1,N0
+               APLUS(ME,J) = GRAD(J,I+1)
+   20       CONTINUE
+            BPLUS(ME)  = CONTR(I)
+            INPLUS(ME) = 0
+         ENDIF
+   30 CONTINUE
+*----
+*  ORGANIZE TABLES APLUS AND BPLUS FOR INEQUALITY CONSTRAINTS
+*----
+      MI=0
+      DO 50 I=1,NCST
+         IF(INEGAL(I).NE.0) THEN
+            MI = MI + 1
+            DO 40 J=1,N0
+               APLUS(ME+MI,J) = GRAD(J,I+1)
+   40       CONTINUE
+            BPLUS(ME+MI)  = CONTR(I)
+            INPLUS(ME+MI) = INEGAL(I)
+         ENDIF
+   50 CONTINUE
+*----
+*  ORGANIZE TABLES APLUS AND BPLUS FOR CONTROL-VARIABLE BOUNDS
+*----
+      DO 80 I=1,N0
+         XX = SQRT(XDROIT/PDG(I))
+         IF(DINF(I).GT.-XX) THEN
+            MI = MI + 1
+            DO 60 J=1,N0
+               APLUS(ME+MI,J) = 0.0D0
+   60       CONTINUE
+            APLUS(ME+MI,I) = 1.0D0
+            BPLUS(ME+MI)   = DINF(I)
+            INPLUS(ME+MI)  = -1
+         ENDIF
+         IF(DSUP(I).LT.XX) THEN
+            MI = MI + 1
+            DO 70 J=1,N0
+               APLUS(ME+MI,J) = 0.0D0
+   70       CONTINUE
+            APLUS(ME+MI,I) = 1.0D0
+            BPLUS(ME+MI)   = DSUP(I)
+            INPLUS(ME+MI)  = 1
+         ENDIF
+   80 CONTINUE
+*
+      DO 90 J=1,N0
+         APLUS(M0+1,J) = 0.0D0
+   90 CONTINUE
+      BPLUS(M0+1)   = 0.0D0
+      INPLUS(M0+1)  = 0
+*
+      IF(M0.NE.ME+MI) THEN
+         WRITE (6,1000) M0,ME,MI
+         CALL XABORT('PLDRV: M0 AND ME+MI ARE NOT THE SAME')
+      ENDIF
+*----
+*  PRINT THE QUASILINEAR PROBLEM
+*----
+      IF(IMPR.GE.5) THEN
+         CALL PLNTAB(GF,APLUS,INPLUS,BPLUS,PDG,DINF,DSUP,N0,M0,
+     >             CLNAME)
+      ENDIF
+*----
+*  LEMKE METHOD
+*----
+      NPM=(M0+1)+N0
+      IF(IMTHD.LE.2) THEN
+         CALL PLMAP2(N0,M0,APLUS,PDG,BPLUS,INPLUS,XDROIT,GF,FCOST,XOBJ,
+     1   IMTHD,EPSIM,IMPR,IERR)
+*----
+*  MAP
+*----
+      ELSE IF(IMTHD.EQ.3) THEN
+         CALL PLMAP1(N0,M0,APLUS,PDG,BPLUS,INPLUS,XDROIT,GF,FCOST,
+     1   XOBJ,IMTHD,IMPR,IERR)
+*----
+*  AUGMENTED LAGRANGIAN
+*----
+      ELSE IF(IMTHD.EQ.4) THEN
+         CALL PLLA(IPOPT,N0,M0,APLUS,PDG,BPLUS,INPLUS,XDROIT,
+     1   FCOST,GF,XOBJ,IMPR,EPSIM,NCST,GRAD,CONTR,INEGAL,IERR)
+*----
+*  EXTERNAL PENALTY METHOD
+*----
+      ELSE IF(IMTHD.EQ.5) THEN
+         CALL PLPNLT(IPOPT,N0,M0,APLUS,PDG,BPLUS,INPLUS,XDROIT,
+     1   FCOST,GF,XOBJ,IMPR,EPSIM,NCST,GRAD,CONTR,INEGAL,IERR)
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(APLUS,GF,BPLUS)
+      DEALLOCATE(INPLUS)
+      RETURN
+*
+1000  FORMAT(/' PLDRV: INCONSISTENCY BETWEEN M0 AND ME+MI ',3I5)
+      END
diff --git a/Donjon/src/PLLA.f b/Donjon/src/PLLA.f
new file mode 100644
index 0000000..da3b884
--- /dev/null
+++ b/Donjon/src/PLLA.f
@@ -0,0 +1,240 @@
+*DECK PLLA
+      SUBROUTINE PLLA(IPOPT,N0,M0,APLUS,PDG,BPLUS,INPLUS,XDROIT,FCOST,
+     > GF,XOBJ,IMPR,EPSIM,NCST,GRAD,CONTR,INEGAL,IERR)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Solves the quasi-linear problem using the augmented Lagrangian.
+* PLLA = Linear Programmation Augmented Lagrangian
+*
+*Copyright:
+* Copyright (C) 2002 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): R. Chambon
+*
+*Parameters: input/ouput
+* IPOPT   pointer to the L_OPTIMIZE object.
+* N0      number of control variables.
+* M0      number of constraints.
+* APLUS   coefficient matrix for the linear constraints.
+* PDG     weights assigned to control variables in the quadratic
+*         constraint.
+* BPLUS   right hand sides corresponding to the coefficient matrix.
+* INPLUS  constraint relations (=-1 for .GE.; =0 for .EQ.; =1 for .LE.).
+* XDROIT  quadratic constraint radius squared.
+* FCOST   costs of control variables.
+* GF      objective function.
+* XOBJ    control variables.
+* IMPR    print flag.
+* EPSIM   tolerence used for inner linear SIMPLEX calculation.
+* NCST    number of constraints.
+* GRAD    linearized gradients (GRAD(:,1) are control variable costs
+*         and GRAD(:,2:NCST+1) are linear constraint coefficients).
+* CONTR   constraint right hand sides.
+* INEGAL  constraint relations (=-1 for .GE.; =0 for .EQ.; =1 for .LE.).
+*
+*Parameters: ouput
+* IERR    return code (=0: normal completion).
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPOPT
+      INTEGER N0,M0,INPLUS(M0+1),IMPR,NCST,INEGAL(NCST),IERR
+      DOUBLE PRECISION PDG(N0),BPLUS(M0+2),XDROIT,XOBJ(N0),EPSIM,
+     > GRAD(N0,NCST+1),CONTR(NCST),APLUS(M0+2,M0+N0+1),GF(N0),FCOST
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER   ITERMX,LENGT,ITYP,I,J,K,ITER,NPM,M0B
+      PARAMETER (ITERMX=10)
+      LOGICAL   LCST(NCST),LCST2(NCST),LTST
+      DOUBLE PRECISION LACOST,NORM,CRIT,LA0E
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: INPL2
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: LAFAC,CSTWGT,B2,
+     > CONTR2,LAGF
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: APLUS2
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(INPL2(M0-NCST+1))
+      ALLOCATE(LAFAC(NCST),CSTWGT(NCST),B2(M0-NCST+2),CONTR2(NCST))
+      ALLOCATE(LAGF(N0),APLUS2(M0-NCST+1,N0+M0-NCST))
+*----
+*  STEP 0: INITIALIZATION
+*  NPM: SIZE OF THE LINEARIZED SYSTEM.
+*  M0B: NUMBER OF LINEARIZED CONSTRAINTS FOR THE LA ALGORITHM.
+*       CORRESPONDS TO THE NUMBER OF POSSIBLY ACTIVE BOUNDS.
+*----
+      NPM=(M0+1)+N0
+      M0B=M0-NCST
+      IF(NCST.GT.0) THEN
+         CALL LCMLEN(IPOPT,'F-LA-MULT',LENGT,ITYP)
+         IF(LENGT.EQ.0) THEN
+            CALL XABORT('PLLA: LAGRANGIAN FACTORS NON INITIALIZED')
+         ELSEIF(LENGT.EQ.NCST) THEN
+            CALL LCMGET(IPOPT,'F-LA-MULT',LAFAC)
+         ELSE
+            CALL XABORT('PLLA: WRONG NUMBER OF LA COEFFICIENTS')
+         ENDIF
+         CALL LCMLEN(IPOPT,'CST-WEIGHT',LENGT,ITYP)
+         IF(LENGT.EQ.0) THEN
+            CALL XABORT('PLLA: CONSTRAINTS PENALTIES NON INITIALIZED')
+         ELSEIF(LENGT.EQ.NCST) THEN
+            CALL LCMGET(IPOPT,'CST-WEIGHT',CSTWGT)
+         ELSE
+            CALL XABORT('PLLA: WRONG NUMBER OF CONSTRAINT WEIGHTS')
+         ENDIF
+         DO 10 J=1,NCST
+         CONTR2(J)=-CONTR(J)
+   10    CONTINUE
+         LCST2(:NCST)=.TRUE.
+         LCST(:NCST)=.TRUE.
+      ENDIF
+      XOBJ(:N0)=0.0D0
+*----
+*  INTERNAL ITERATIONS FOR THE LINEAR PROBLEM
+*----
+      ITER=0
+   99 ITER=ITER+1
+      LTST=.TRUE.
+*----
+*  STEP 1: LA FUNCTION EVALUATION
+*----
+      DO 110 J=1,NCST
+         IF(INEGAL(J).NE.0) THEN
+            CRIT=CONTR2(J)
+            DO 100 I=1,N0
+               CRIT=CRIT+GRAD(I,J+1)*XOBJ(I)
+  100          CONTINUE
+            CRIT=CSTWGT(J)*INEGAL(J)*CRIT+LAFAC(J)
+            LCST(J)=(CRIT.LE.0.0)
+         ENDIF
+  110    CONTINUE
+
+      DO 150 I=1,N0
+         LAGF(I)=GF(I)
+         DO 140 J=1,NCST
+            IF(INEGAL(J).EQ.0) THEN
+              LAGF(I)=LAGF(I)+GRAD(I,J+1)*(LAFAC(J)+CSTWGT(J)*CONTR2(J))
+            ELSEIF(.NOT.LCST(J)) THEN
+              LAGF(I)=LAGF(I)+INEGAL(J)*GRAD(I,J+1)
+     1                       *(CSTWGT(J)*INEGAL(J)*CONTR2(J)+2*LAFAC(J))
+            ENDIF
+  140       CONTINUE
+  150    CONTINUE
+
+      LACOST=FCOST
+      DO 160 J=1,NCST
+         IF(INEGAL(J).EQ.0) THEN
+            LACOST=LACOST+(LAFAC(J)+CSTWGT(J)/2.0*CONTR2(J))*CONTR2(J)
+         ELSEIF(.NOT.LCST(J)) THEN
+            LACOST=LACOST+INEGAL(J)*CONTR2(J)*2.0*LAFAC(J)
+     1                   +CSTWGT(J)/2.0*CONTR2(J)**2
+         ELSE
+            LACOST=LACOST-3.0*LAFAC(J)**2/2.0/CSTWGT(J)
+         ENDIF
+  160    CONTINUE
+      IF(ITER.EQ.1) LA0E=LACOST
+      IF(IMPR.GE.3) THEN
+         WRITE(6,*) 'GF',(GF(I),I=1,N0)
+         WRITE(6,*) 'LAGF',(LAGF(I),I=1,N0)
+         WRITE(6,*) 'PDG',(PDG(I),I=1,N0)
+         WRITE(6,*) 'LACOST',LACOST,'M0B',M0B,'XDROIT',XDROIT
+      ENDIF
+*----
+*  STEP 2: SOLUTION
+*                         k,l
+*               compute DX
+*  case 1
+*  If there is no constraints for the LA problem (M0B=0), 
+*  then the solution is obvious: on the hypersphere(radius XDROIT) 
+*  in the direction LAGF
+*----
+      IF(M0B.EQ.0) THEN
+*
+      NORM=0.0
+      DO 200 I=1,N0
+         NORM=NORM+LAGF(I)**2/PDG(I)
+  200 CONTINUE
+      NORM=NORM**0.5
+*
+      IF(NORM.EQ.0.0) THEN
+         XOBJ(:N0)=0.0D0
+      ELSE
+         DO 210 I=1,N0
+            XOBJ(I)=-XDROIT**0.5*LAGF(I)/PDG(I)/NORM
+  210    CONTINUE
+      ENDIF
+*----
+*  CASE 2
+*  SOLUTION WITH THE LEMKE METHOD
+*----
+      ELSE
+*
+      DO 260 K=1,M0B
+         DO 250 I=1,N0
+            APLUS2(K,I)=APLUS(NCST+K,I)
+  250    CONTINUE
+         B2(K)=BPLUS(NCST+K)
+         INPL2(K)=INPLUS(NCST+K)
+  260    CONTINUE
+      DO 270 I=1,N0
+         APLUS2(M0B+1,I) = 0.0D0
+  270    CONTINUE
+      BPLUS(M0B+1)   = 0.0
+      INPL2(M0B+1)  = 0
+*
+      CALL PLMAP2(N0,M0B,APLUS2,PDG,B2,INPL2,XDROIT,LAGF,LACOST,XOBJ,2,
+     > EPSIM,IMPR,IERR)
+*
+      ENDIF
+      DO 410 J=1,NCST
+         IF(INEGAL(J).NE.0) THEN
+            CRIT=CONTR2(J)
+            DO 400 I=1,N0
+               CRIT=CRIT+GRAD(I,J+1)*XOBJ(I)
+  400          CONTINUE
+            CRIT=CSTWGT(J)*INEGAL(J)*CRIT+LAFAC(J)
+            LCST2(J)=(CRIT.LE.0.0)
+         ENDIF
+  410    CONTINUE
+      
+      IF((IMPR.GE.2).AND.(NCST.GT.0)) THEN
+         WRITE(6,*) (LCST(J),J=1,NCST)
+         WRITE(6,*) (LCST2(J),J=1,NCST)
+      ENDIF
+      DO 420 J=1,NCST
+         LTST=LTST.AND.(LCST(J).EQV.LCST2(J))
+  420    CONTINUE
+
+      IF((.NOT.LTST) .AND.(ITER.LE.ITERMX)) GO TO 99
+*----
+*                  k,l
+*    STEP 3: SAVE L
+*                  a
+*----
+      CALL LCMSIX(IPOPT,'OLD-VALUE',1)
+      CALL LCMPUT(IPOPT,'F-LA-EVAL',1,4,LA0E)
+      IF(IMPR.GE.1)   WRITE(6,*) 'LAGF',(LAGF(I),I=1,N0)
+      CALL LCMPUT(IPOPT,'DF-LA-PENAL',N0,4,LAGF)
+      CALL LCMSIX(IPOPT,' ',0)
+*
+      IF(IMPR.GE.1) WRITE(6,*) 'Dvar',(XOBJ(I),I=1,N0)
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(APLUS2,LAGF)
+      DEALLOCATE(CONTR2,B2,CSTWGT,LAFAC)
+      DEALLOCATE(INPL2)
+      RETURN
+      END
diff --git a/Donjon/src/PLMAP1.f b/Donjon/src/PLMAP1.f
new file mode 100644
index 0000000..3f4d677
--- /dev/null
+++ b/Donjon/src/PLMAP1.f
@@ -0,0 +1,341 @@
+*DECK PLMAP1
+      SUBROUTINE PLMAP1(N0,M0,APLUS,PDG,BPLUS,INPLUS,XDROIT,COUT,OBJ,
+     > XOBJ,IMTHD,IMPR,IERR,BINF,BSUP,SCALE,PX,RX,DELTA,BGAR)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Solves a linear optimization problem with quadratic constraint using
+* the method of approximation programming (MAP). 
+* PLMAP1 = Linear Programmation MAP1
+*
+*Reference:
+*  R.E. Griffith and R.A. Stewart, 'A non-linear programming technique
+*  for the optimization of continuous processing systems', Management
+*  Science, Vol. 7, NO. 4, 379 (1961).
+*
+*Copyright:
+* Copyright (C) 2002 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert and R. Chambon
+*
+*Parameters: input
+* N0      number of control variables.
+* M0      number of constraints.
+* APLUS   coefficient matrix for the linear constraints.
+* PDG     weights assigned to control variables in the quadratic
+*         constraint.
+* BPLUS   right hand sides corresponding to the coefficient matrix.
+* INPLUS  constraint relations (=-1 for .GE.; =0 for .EQ.; =1 for .LE.).
+* XDROIT  quadratic constraint radius squared.
+* COUT    costs of control variables.
+* OBJ     objective function.
+* XOBJ    control variables.
+* IMTHD   type of solution (=1: SIMPLEX/LEMKE; =3: MAP).
+* IMPR    print flag.
+*
+*Parameters: ouput
+* IERR    return code (=0: normal completion).
+*
+*Parameters: scratch
+* BINF
+* BSUP
+* SCALE
+* PX
+* RX
+* DELTA
+* BGAR
+*
+*-----------------------------------------------------------------------
+*
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER N0,M0,INPLUS(M0+1),IMTHD,IMPR,IERR
+      DOUBLE PRECISION PDG(N0),BPLUS(M0+2),XDROIT,XOBJ(N0),BINF(N0),
+     > BSUP(N0),SCALE(N0),PX(N0),RX(N0),DELTA(N0),BGAR(M0+1),
+     > APLUS(M0+2,N0),COUT(N0),OBJ
+*----
+*  LOCAL VARIABLES
+*----
+      DOUBLE PRECISION  DELF,X,DUMY,ZMAX,XVAL,SCAL,DELX,TEMP,ERR,
+     > CONT,EPSIR,EPS,EPSS
+      INTEGER     ITER,ITMAX,I,J,M
+      CHARACTER   CLNAME*6
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: ZMAXC,BGAR0
+*----
+*  DATA STATEMENTS
+*----
+      DATA     CLNAME /'PLMAP'/
+*
+      EPS   = 0.0001D0
+      EPSIR =EPS
+      ITMAX = 100
+*----
+*  CONTROL-VARIABLE SCALING
+*----
+      DO 10 J=1,N0
+         SCAL = SQRT(XDROIT/PDG(J))
+         SCALE(J) = SCAL
+         COUT(J) = COUT(J)*SCAL
+*
+         PDG(J)  = 1.0D0
+         BINF(J) = 0.0D0
+         BSUP(J) = 0.0D0
+*
+         DO 20 I=1,M0
+            APLUS(I,J) = APLUS(I,J)*SCAL
+   20    CONTINUE
+*
+  10  CONTINUE
+*----
+*  PRINT TABLES AFTER SCALING OF CONTROL VARIABLES
+*----
+      IF(IMPR.GE.5) THEN
+        CALL PLNTAB(COUT,APLUS,INPLUS,BPLUS,PDG,BINF,BSUP,
+     >              N0,M0,CLNAME//' AFTER SCALING OF CONTROL VARIABLES')
+      ENDIF
+*
+      XDROIT=1.0D0
+*----
+*  CONSTRAINT SCALING
+*----
+      ALLOCATE(ZMAXC(M0))
+      DO 30 I=1,M0
+         ZMAX = ABS(BPLUS(I))
+*
+         DO 40 J=1,N0
+            ZMAX = MAX(ZMAX,ABS(APLUS(I,J)))
+   40    CONTINUE
+         BGAR(I) = BPLUS(I)/ZMAX
+*
+         DO 42 J=1,N0
+            APLUS(I,J) = APLUS(I,J)/ZMAX
+   42    CONTINUE
+         ZMAXC(I) = ZMAX
+  30  CONTINUE
+*----
+*  COST SCALING
+*----
+      ZMAX = 0.0D0
+      DO 45 J=1,N0
+         ZMAX = MAX(ZMAX,ABS(COUT(J)))
+   45 CONTINUE
+      DO 50 J=1,N0
+         COUT(J) = COUT(J)/ZMAX
+   50 CONTINUE
+*----
+*  PRINT TABLES AFTER SCALING OF COSTS AND CONSTRAINTS
+*----
+      IF(IMPR.GE.5) THEN
+        CALL PLNTAB(COUT,APLUS,INPLUS,BGAR,PDG,BINF,BSUP,N0,M0,
+     >              CLNAME//' AFTER SCALING OF COSTS AND CONSTRAINTS')
+      ENDIF
+      ALLOCATE(BGAR0(M0))
+      DO 52 I=1,M0
+         BGAR0(I) = BGAR(I)
+   52 CONTINUE
+*----
+*  INITIAL ESTIMATES
+*----
+      DELX = SQRT(XDROIT)
+      EPSS = EPS*DELX
+*
+      DO 55 I=1,N0
+         DELTA(I) = DELX/10.0
+         RX(I)    = 0.0
+   55 CONTINUE
+      TEMP = DELX/SQRT(REAL(N0))/10
+*----
+*  MAP ITERATIONS
+*----
+      ITER = 0
+   60 ITER = ITER + 1
+      CONT = 0.0
+      DO 70 I=1,M0+1
+         BGAR(I) = BGAR0(I)
+   70 CONTINUE
+*----
+*  CONTROL VARIABLE BOUNDS
+*----
+      DO 90 I=1,N0
+         IF(ITER.EQ.1) THEN
+!            XOBJ(I) = EPSIR*10.0
+            XOBJ(I) = 0.0
+            BINF(I) = -TEMP
+            BSUP(I) = TEMP
+         ELSE
+            BINF(I) = -DELTA(I)
+            BSUP(I) = DELTA(I)
+         ENDIF
+*----
+*  LINEARIZATION OF THE QUADRATIC CONSTRAINT
+*----
+         CONT = CONT + XOBJ(I)**2
+         APLUS(M0+1,I) = 2.0*XOBJ(I)
+         DO 95 J=1,M0
+            BGAR(J) = BGAR(J) - APLUS(J,I)*XOBJ(I)
+   95    CONTINUE
+  90  CONTINUE
+*
+      INPLUS(M0+1) = 1
+      BGAR(M0+1)   = XDROIT - CONT
+      M = M0 + 1
+*----
+*  REORGANIZE TABLES FOR SIMPLEX
+*----
+      DO 120 I=1,M
+         DUMY = 0.0D0
+*
+         DO 100 J=1,N0
+            DUMY = DUMY + APLUS(I,J)*BINF(J)
+  100    CONTINUE
+*
+         BGAR(I) = BGAR(I) - DUMY
+         IF(BGAR(I).GE.0.0) GOTO 120
+*
+         DO 110 J=1,N0
+            APLUS(I,J) = -APLUS(I,J)
+  110    CONTINUE
+*
+         BGAR(I)   = -BGAR(I)
+         BGAR0(I)= -BGAR0(I)
+         BPLUS(I)  = -BPLUS(I)
+         INPLUS(I) = -INPLUS(I)
+*
+  120 CONTINUE
+*
+      DO 130 J=1,N0
+         BSUP(J) = BSUP(J) - BINF(J)
+         BINF(J) = 0.0
+  130 CONTINUE
+*----
+*  PRINT SIMPLEX TABLES
+*----
+      IF(IMPR.GE.5) THEN
+        CALL PLNTAB(COUT,APLUS,INPLUS,BGAR ,XOBJ  ,BINF  ,BSUP,N0,M0,
+     >              CLNAME//' AFTER REORGANIZATION FOR SIMPLEX')
+      ENDIF
+*----
+*  SOLUTION OF A LINEAR PROGRAMMING PROBLEM USING THE SIMPLEX
+*----
+      CALL PLSPLX(N0,M,M0+2,1,COUT,APLUS,BGAR,INPLUS,BINF,BSUP,PX,
+     >          DELF,EPSS,IMTHD,IMPR,IERR)
+*
+      DO 140 I=1,N0
+         IF(ITER.EQ.1) THEN
+            PX(I) = PX(I) - TEMP
+         ELSE
+            PX(I) = PX(I) - DELTA(I)
+         ENDIF
+  140 CONTINUE
+*----
+*  SOLUTION OF CURRENT ITERATION
+*----
+      IF(IMPR.GE.2) THEN
+         IF(((ITER.GE.1).AND.(IMPR.LE.2)).OR.(IMPR.GE.3)) THEN
+            WRITE (6,1000)
+         ENDIF
+         WRITE (6,2000) ITER,DELF,(PX(I),I=1,N0)
+      ENDIF
+*----
+*  DEGENERESCENCE OR EPS TOO SMALL
+*----
+      IF(IERR.EQ.1) THEN
+         WRITE(6,3000) ITER
+         IERR = 3
+         RETURN
+*----
+*  NO SOLUTION IF ITER=1
+*----
+      ELSE IF(IERR.EQ.2) THEN
+         IF(IMPR.GE.1) WRITE(6,4000) ITER
+         IF(ITER.GE.ITMAX) RETURN
+      ENDIF
+*
+      ERR = 0.0
+      DO 160 I=1,N0
+*
+         IF((RX(I)*PX(I).LT.0.0).AND.(IERR.EQ.0)) THEN
+            DELTA(I) = DELTA(I)*0.5
+         ENDIF
+*
+         RX(I)   = PX(I)
+         XOBJ(I) = XOBJ(I) + PX(I)
+         ERR = ERR + PX(I)**2
+  160 CONTINUE
+*
+      ERR  = SQRT(ERR)
+      EPSS = EPS*DELX/10.0
+*
+      IF(IMPR.GE.1) THEN
+         WRITE(6,2000) ITER,DELF,(XOBJ(I),I=1,N0)
+         WRITE(6,2000) ITER,0.0,(DELTA(I),I=1,N0)
+      ENDIF
+*
+      IF(ERR.LE.EPSS) THEN
+         IERR = 0
+         GOTO 170
+      ENDIF
+*
+      IF(ITER.GE.ITMAX) THEN
+         IERR = 5
+         WRITE (6,5000) ITER
+         RETURN
+      ENDIF
+      GO TO 60
+*----
+*  RESCALE BACK AND PRINT THE SOLUTION
+*----
+  170 DO 175 J=1,N0
+         SCAL    = SCALE(J)
+         COUT(J) = COUT(J)*ZMAX/SCAL
+         XOBJ(J) = XOBJ(J)*SCAL
+         PDG(J)  = XDROIT/SCAL**2
+*
+         DO 177 I=1,M0
+            APLUS(I,J) = APLUS(I,J)/SCAL
+  177    CONTINUE
+  175 CONTINUE
+*
+      X   = 0.0D0
+      OBJ = 0.0D0
+      DO 180 J=1,N0
+         X   = X   + PDG(J)*XOBJ(J)*XOBJ(J)
+         OBJ = OBJ + XOBJ(J)*COUT(J)
+  180 CONTINUE
+*
+      IF(IMPR.GE.1) THEN
+         WRITE (6,6000) OBJ,X,(XOBJ(J),J=1,N0)
+         IF(M0.GT.0) WRITE (6,7000)
+*
+         DO 190 I=1,M0
+            XVAL = BPLUS(I)
+            DO 185 J=1,N0
+               XVAL = XVAL - APLUS(I,J)*XOBJ(J)*ZMAXC(I)/SCALE(J)
+  185       CONTINUE
+            WRITE (6,8000) I,XVAL
+  190    CONTINUE
+      ENDIF
+      DEALLOCATE(ZMAXC,BGAR0)
+      RETURN
+*
+1000  FORMAT(/,5X,'ITERATION',8X,'DELF',5X,'CONTROL VARIABLES')
+2000  FORMAT(5X,I6,5X,8E12.4,/,(28X,5E12.4))
+3000  FORMAT(5X,I6,5X,'DEGENERESCENCE OR EPS TOO SMALL')
+4000  FORMAT(5X,I6,5X,'NO SOLUTION')
+5000  FORMAT(5X,I6,5X,'MAXIMUM ITERATION REACHED')
+6000  FORMAT(//,5X,'FINAL SOLUTION (MAP1-SIMPLEX) ',
+     >        /,5X,'------------------------',
+     >        /,5X,'OBJECTIVE FUNCTION    : ',1P,E12.5,
+     >        /,5X,'QUADRATIC CONSTRAINT  : ',1P,E12.5,
+     >        /,5X,'CONTROL VARIABLES     : ',/,(10X,10E12.4))
+7000  FORMAT(//,5X,'CONSTRAINT DEVIATIONS : ',/)
+8000  FORMAT(2X,I3,'...',2X,1P,D12.4)
+      END
diff --git a/Donjon/src/PLMAP2.f b/Donjon/src/PLMAP2.f
new file mode 100644
index 0000000..f1c4ddf
--- /dev/null
+++ b/Donjon/src/PLMAP2.f
@@ -0,0 +1,292 @@
+*DECK PLMAP2
+      SUBROUTINE PLMAP2(N0,M0,APLUS,PDG,BPLUS,INPLUS,XDROIT,COUT,OBJ,
+     > XOBJ,IMTHD,EPSIM,IMPR,IERR)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Solves a linear optimization problem with quadratic constraints using
+* the method of LEMKE. 
+* PLMAP2 = Linear Programmation MAP2
+*
+*Reference:
+*    J. A. Ferland, 'A linear programming problem with an additional
+*    quadratic constraint solved by parametric linear complementarity',
+*    Publication number 497, Departement d'informatique et de recherche
+*    operationnelle, Universite de Montreal, January 1984.
+*
+*Copyright:
+* Copyright (C) 2002 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert and R. Chambon
+*
+*Parameters: input
+* N0      number of control variables.
+* M0      number of constraints.
+* APLUS   coefficient matrix for the linear constraints.
+* PDG     weights assigned to control variables in the quadratic
+*         constraint.
+* BPLUS   right hand sides corresponding to the coefficient matrix.
+* INPLUS  constraint relations (=-1 for .GE.; =0 for .EQ.; =1 for .LE.).
+* XDROIT  quadratic constraint radius squared.
+* COUT    costs of control variables.
+* OBJ     objective function.
+* XOBJ    control variables.
+* IMTHD   type of solution (=1: SIMPLEX/LEMKE; =2: LEMKE/LEMKE).
+* EPSIM   tolerence used for inner linear SIMPLEX calculation.
+* IMPR    print flag.
+*
+*Parameters: ouput
+* IERR    return code (=0: normal completion).
+*
+*-----------------------------------------------------------------------
+*
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER N0,M0,INPLUS(M0+1),IMTHD,IMPR,IERR
+      DOUBLE PRECISION PDG(N0),BPLUS(M0+2),XDROIT,XOBJ(N0),EPSIM,
+     > APLUS(M0+2,(M0+1)+N0),COUT(N0),OBJ
+*----
+*  LOCAL VARIABLES
+*----
+      CHARACTER   CLNAME*6
+      DOUBLE PRECISION  X,ZMAX,XVAL,SCAL,EPS,FACTOR
+      INTEGER     I,J,M0NEW
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: BINF,BSUP,SCALE
+*----
+*  DATA STATEMENTS
+*----
+      DATA CLNAME /'PLMAP2'/
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(BINF(N0),BSUP(N0),SCALE(N0))
+*
+      EPS=EPSIM
+*----
+*  CONTROL-VARIABLE SCALING
+*----
+      FACTOR=MAX(XDROIT,EPSIM)
+      DO 10 J=1,N0
+         SCAL = SQRT(FACTOR/PDG(J))
+         SCALE(J) = SCAL
+         COUT(J) = COUT(J)*SCAL
+*
+         PDG(J)  = 1.0
+         BINF(J) = 0.0
+         BSUP(J) = 0.0
+*
+         DO 20 I=1,M0
+            APLUS(I,J) = APLUS(I,J)*SCAL
+   20    CONTINUE
+*
+   10 CONTINUE
+*----
+*  PRINT TABLES AFTER SCALING OF CONTROL VARIABLES
+*----
+      IF(IMPR.GE.5) THEN
+         CALL PLNTAB(COUT,APLUS,INPLUS,BPLUS,PDG,BINF,BSUP,
+     >               N0,M0,CLNAME//' AFTER SCALING OF VARIABLES')
+      ENDIF
+*
+      XDROIT = XDROIT/FACTOR
+*----
+*  CONSTRAINT SCALING
+*----
+      DO 30 I=1,M0
+         ZMAX = ABS(BPLUS(I))
+*
+         DO 40 J=1,N0
+            ZMAX = MAX(ZMAX,ABS(APLUS(I,J)))
+   40    CONTINUE
+         BPLUS(I) = BPLUS(I)/ZMAX
+*
+         DO 42 J=1,N0
+            APLUS(I,J) = APLUS(I,J)/ZMAX
+   42    CONTINUE
+   30 CONTINUE
+*----
+*  COST SCALING
+*----
+      ZMAX = 0.0D0
+      DO 45 J=1,N0
+         ZMAX = MAX(ZMAX,ABS(COUT(J)))
+   45 CONTINUE
+*
+      DO 50 J=1,N0
+         COUT(J) = COUT(J)/ZMAX
+   50 CONTINUE
+*----
+*  STEP 1
+*----
+      M0NEW = M0 + 1
+      DO 55 I=1,N0
+         BINF(I) = -SQRT(XDROIT)
+         BSUP(I) =  SQRT(XDROIT)
+         APLUS(M0NEW,I) = 0.0D0
+   55 CONTINUE
+      BPLUS(M0NEW) = 0.0D0
+*----
+*  PRINT TABLES AFTER SCALING OF COSTS AND CONSTRAINTS
+*----
+      IF(IMPR.GE.5) THEN
+         CALL PLNTAB(COUT,APLUS,INPLUS,BPLUS,PDG,BINF,BSUP,N0,M0,
+     >               CLNAME//' AFTER SCALING OF COSTS AND CONSTRAINTS')
+      ENDIF
+*
+      IF(IMTHD.EQ.1) THEN
+*----
+*  SOLUTION OF A LINEAR OPTIMIZATION PROBLEM USING THE SIMPLEX METHOD
+*----
+         CALL PLSPLX(N0,M0,M0+2,1,COUT,APLUS,BPLUS,INPLUS,BINF,BSUP,
+     >             XOBJ,OBJ,EPS,IMTHD,IMPR,IERR)
+*
+         DO 70 I=1,M0
+            IF(INPLUS(I).EQ.-1) THEN
+               DO 60 J=1,N0
+                  APLUS(I,J) = -APLUS(I,J)
+   60          CONTINUE
+               BPLUS(I)   = -BPLUS(I)
+               INPLUS(I)  = 1
+            ELSE IF(INPLUS(I).EQ.0) THEN
+               DO 65 J=1,N0
+                  APLUS(M0NEW,J) = APLUS(M0NEW,J) - APLUS(I,J)
+   65          CONTINUE
+               BPLUS(M0NEW)   = BPLUS(M0NEW)   - BPLUS(I)
+            ENDIF
+   70    CONTINUE
+      ELSE
+*----
+*  SOLUTION OF A LINEAR OPTIMIZATION PROBLEM USING THE LINEAR LEMKE
+*  METHOD
+*----
+         DO 90 I=1,M0
+            IF(INPLUS(I).EQ.-1) THEN
+               DO 75 J=1,N0
+                  APLUS(I,J) = -APLUS(I,J)
+   75          CONTINUE
+               BPLUS(I)  = -BPLUS(I)
+               INPLUS(I) = 1
+            ELSE IF(INPLUS(I).EQ.0) THEN
+               DO 80 J=1,N0
+                  APLUS(M0NEW,J) = APLUS(M0NEW,J) - APLUS(I,J)
+   80          CONTINUE
+               BPLUS(M0NEW) = BPLUS(M0NEW) - BPLUS(I)
+            ENDIF
+   90    CONTINUE
+         CALL PLLINR(N0,M0NEW,M0+2,COUT,APLUS,BPLUS,BINF,BSUP,XOBJ,OBJ,
+     >   EPS,IMPR,IERR)
+      ENDIF
+*
+      IF(IERR.GE.1) THEN
+         WRITE (6,6000) IERR
+         GO TO 500
+      ENDIF
+*
+      X = 0.0D0
+      DO 100 J=1,N0
+         X = X + PDG(J)*XOBJ(J)*XOBJ(J)
+  100 CONTINUE
+      IF(IMPR.GE.2) THEN
+         IF(IMTHD.EQ.1) THEN
+            WRITE (6,1000) OBJ,X,(XOBJ(I),I=1,N0)
+         ELSE IF(IMTHD.EQ.2) THEN
+            WRITE (6,1500) OBJ,X,(XOBJ(I),I=1,N0)
+         ENDIF
+      ENDIF
+*
+      IF(IMPR.GE.5) THEN
+         WRITE(6,*) 'AFTER LINEAR OPTIMIZATION'
+         WRITE(6,*) 'XOBJ   ',(XOBJ(J),J=1,N0)
+         WRITE(6,*) 'PDG    ',(PDG(J),J=1,N0)
+         WRITE(6,*) 'OBJ    ',OBJ
+         WRITE(6,*) 'X      ',X
+         WRITE(6,*) 'XDROIT ',XDROIT
+      ENDIF
+*----
+*  SOLUTION OF A LINEAR OPTIMIZATION PROBLEM WITH A QUADRATIC CONSTRAINT
+*  USING THE GENERAL LEMKE METHOD
+*----
+      IF(X.GT.XDROIT) THEN
+        DO J=1,N0
+          APLUS(M0NEW+1,J) = COUT(J)
+        ENDDO
+        BPLUS(M0NEW+1) = OBJ
+*
+        CALL PLQUAD(N0,M0NEW,M0+2,APLUS,BPLUS,PDG,XDROIT,COUT,XOBJ,EPS,
+     >  IMPR,IERR)
+*
+        IF(IERR.GE.1) THEN
+          WRITE(6,2000) IERR
+          IERR = IERR + 10
+          GO TO 500
+        ENDIF
+      ENDIF
+*----
+*  RESCALE BACK AND PRINT THE SOLUTION
+*----
+      DO 170 J=1,N0
+         SCAL = SCALE(J)
+         COUT(J) = COUT(J)*ZMAX/SCAL
+         XOBJ(J) = XOBJ(J)*SCAL
+         PDG(J)  = FACTOR/SCAL**2
+*
+         DO 175 I=1,M0
+            APLUS(I,J) = APLUS(I,J)/SCAL
+  175    CONTINUE
+  170 CONTINUE
+*----
+*  COMPUTE THE NEW OPTIMAL POINT
+*----
+      X   = 0.0D0
+      OBJ = 0.0D0
+      DO 180 J=1,N0
+         X   = X   + PDG(J)*XOBJ(J)*XOBJ(J)
+         OBJ = OBJ + XOBJ(J)*COUT(J)
+  180 CONTINUE
+*
+      IF(IMPR.GE.1) THEN
+         WRITE (6,3000) OBJ,X,(XOBJ(J),J=1,N0)
+         WRITE (6,4000)
+*
+         DO 190 I=1,M0
+            XVAL = BPLUS(I)
+            DO 185 J=1,N0
+               XVAL = XVAL - APLUS(I,J)*XOBJ(J)
+  185       CONTINUE
+            WRITE (6,5000) I,XVAL
+  190    CONTINUE
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+  500 DEALLOCATE(SCALE,BSUP,BINF)
+      RETURN
+*
+1000  FORMAT(//,5X,'SOLUTION WITHOUT QUADRATIC CONSTRAINT (SIMPLEX) :',
+     >        /,5X,'------------------------------------------------',
+     >        /,5X,'OBJECTIVE FUNCTION    : ',1P,E12.5,
+     >        /,5X,'QUADRATIC CONSTRAINT  : ',1P,E12.5,
+     >        /,5X,'CONTROL VARIABLES     : ',/,(10X,10E12.4))
+1500  FORMAT(//,5X,'SOLUTION WITHOUT QUADRATIC CONSTRAINT (LINR) :',
+     >        /,5X,'---------------------------------------------',
+     >        /,5X,'OBJECTIVE FUNCTION    : ',1P,E12.5,
+     >        /,5X,'QUADRATIC CONSTRAINT  : ',1P,E12.5,
+     >        /,5X,'CONTROL VARIABLES     : ',/,(10X,10E12.4))
+2000  FORMAT(//,5X,'PLMAP2: ECHEC DU MODULE QUADR  IERR = ',I2)
+3000  FORMAT(//,5X,'FINAL SOLUTION        :',
+     >        /,5X,'---------------------',
+     >        /,5X,'OBJECTIVE FUNCTION    : ',1P,E12.5,
+     >        /,5X,'QUADRATIC CONSTRAINT  : ',1P,E12.5,
+     >        /,5X,'CONTROL VARIABLES     : ',/,(10X,10E12.4))
+4000  FORMAT(//,5X,'CONSTRAINT DEVIATIONS :',/)
+5000  FORMAT(2X,I3,'...',2X,1P,E12.4)
+6000  FORMAT(//,5X,'PLMAP2: FAILURE OF LINEAR ALGORITHM (IERR=',I5,')')
+      END
diff --git a/Donjon/src/PLNTAB.f b/Donjon/src/PLNTAB.f
new file mode 100644
index 0000000..1e8a476
--- /dev/null
+++ b/Donjon/src/PLNTAB.f
@@ -0,0 +1,90 @@
+*DECK PLNTAB

+      SUBROUTINE PLNTAB(GF,APLUS,INPLUS,BPLUS,XITK,XINF,XSUP,NDEC,M0,

+     >                  SRCNAM)

+*----------------------------------------------------------------------*

+*                                                                      *

+*Purpose:

+* Print the arrays of the linear optimization problem. 

+*

+*Copyright:

+* Copyright (C) 2002 Ecole Polytechnique de Montreal

+* This library is free software; you can redistribute it and/or

+* modify it under the terms of the GNU Lesser General Public

+* License as published by the Free Software Foundation; either

+* version 2.1 of the License, or (at your option) any later version

+*

+*Author(s): 

+* R. Chambon

+*

+*Parameters: input

+* GF      costs of control variables.

+* APLUS   coefficient matrix for the linear constraints.

+* INPLUS  constraint relations (=-1 for .GE.; =0 for .EQ.; =1 for .LE.).

+* BPLUS   right hand sides corresponding to the coefficient matrix.

+* XITK    weights assigned to control variables in the quadratic

+*         constraint.

+* XINF    lower bounds of control variables.

+* XSUP    upper bounds of control variables.

+* NDEC    number of control variables.

+* M0      number of constraints plus the number of lower/upper bounds

+*         intercepting the quadratic constraint.

+* SRCNAM  character text to print.

+*

+*-----------------------------------------------------------------------

+*

+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)

+*----

+*  SUBROUTINE ARGUMENTS

+*----

+      INTEGER       M0

+      DOUBLE PRECISION BPLUS(M0+2),XITK(NDEC),XINF(NDEC),XSUP(NDEC),

+     >                 GF(NDEC),APLUS(M0+2,NDEC)

+      INTEGER       INPLUS(M0+1)

+      CHARACTER*(*) SRCNAM

+*----

+*  LOCAL VARIABLES

+*----

+      CHARACTER*2   CTYPES(-1:1)

+      CHARACTER*80  FMT

+*

+      DATA CTYPES / '>=',' =','<=' /

+*

+      WRITE(6,1000) SRCNAM

+*

+      IF (NDEC.GT.8) THEN

+         RETURN

+      ELSE

+         FMT = '(1P,XXE13.5,5X,A3,5X,1P,E13.5)'

+         NVAL = NDEC

+      ENDIF

+*

+      IDX = INDEX(FMT,'X')

+      WRITE(FMT(IDX:IDX+1),'(I2.2)') NVAL

+*----

+*  PRINT CONTROL-VARIABLE COSTS

+*----

+      WRITE(6,2000) (I,I=1,NDEC)

+      WRITE(6,3000) (GF(I),I=1,NDEC)

+*----

+*  PRINT COEFFICIENT MATRIX

+*----

+      IF(M0.GT.0) THEN

+        WRITE(6,4000)

+        DO 10 J=1,M0

+          WRITE(6,FMT) (APLUS(J,I),I=1,NDEC),CTYPES(INPLUS(J)),BPLUS(J)

+  10    CONTINUE

+      ENDIF

+*

+      WRITE(6,5000) (XINF(I),I=1,NDEC)

+      WRITE(6,6000) (XSUP(I),I=1,NDEC)

+      WRITE(6,7000) (XITK(I),I=1,NDEC)

+      RETURN

+*

+1000  FORMAT(//,5X,'PRINT LINEARIZED OPTIMIZATION PROBLEM IN ',A,/)

+2000  FORMAT( /,5X,'COST(NDEC)',//,(10(5X,I3,5X)),//)

+3000  FORMAT((1P,10E13.5))

+4000  FORMAT( /,5X,'APLUS(M0,NDEC)',35X,'INPLUS(M0)',35X,'BPLUS(M0)',/)

+5000  FORMAT( /,5X,'XINF(NDEC)  ',//,(1P,10E13.5))

+6000  FORMAT( /,5X,'XSUP(NDEC)  ',//,(1P,10E13.5))

+7000  FORMAT( /,5X,'WEIGHT(NDEC)',//,(1P,10E13.5))

+      END

diff --git a/Donjon/src/PLPNLT.f b/Donjon/src/PLPNLT.f
new file mode 100644
index 0000000..e399fd5
--- /dev/null
+++ b/Donjon/src/PLPNLT.f
@@ -0,0 +1,228 @@
+*DECK PLPNLT
+      SUBROUTINE PLPNLT(IPOPT,N0,M0,APLUS,PDG,BPLUS,INPLUS,XDROIT,
+     > FCOST,GF,XOBJ,IMPR,EPSIM,NCST,GRAD,CONTR,INEGAL,IERR)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Solves the quasi-linear problem using the external penalty function.
+* PLPNLT = Linear Programmation external PeNaLTy function
+*
+*Copyright:
+* Copyright (C) 2002 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* R. Chambon
+*
+*Parameters: input/ouput
+* IPOPT   pointer to the L_OPTIMIZE object.
+* N0      number of control variables.
+* M0      number of constraints.
+* APLUS   coefficient matrix for the linear constraints.
+* PDG     weights assigned to control variables in the quadratic
+*         constraint.
+* BPLUS   right hand sides corresponding to the coefficient matrix.
+* INPLUS  constraint relations (=-1 for .GE.; =0 for .EQ.; =1 for .LE.).
+* XDROIT  quadratic constraint radius squared.
+* FCOST   costs of control variables.
+* GF      objective function.
+* XOBJ    control variables.
+* IMPR    print flag.
+* EPSIM   tolerence used for inner linear SIMPLEX calculation.
+* NCST    number of constraints.
+* GRAD    linearized gradients (GRAD(:,1) are control variable costs
+*         and GRAD(:,2:NCST+1) are linear constraint coefficients).
+* CONTR   constraint right hand sides.
+* INEGAL  constraint relations (=-1 for .GE.; =0 for .EQ.; =1 for .LE.).
+*
+*Parameters: ouput
+* IERR    return code (=0: normal completion).
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPOPT
+      INTEGER N0,M0,INPLUS(M0+1),IMPR,NCST,INEGAL(NCST),IERR
+      DOUBLE PRECISION PDG(N0),BPLUS(M0+2),XDROIT,XOBJ(N0),EPSIM,
+     > GRAD(N0,NCST+1),CONTR(NCST),APLUS(M0+2,M0+N0+1),GF(N0),FCOST
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER   ITERMX
+      PARAMETER (ITERMX=10)
+      INTEGER   LENGT,ITYP,I,J,K,ITER
+      LOGICAL   LCST(NCST),LCST2(NCST),LTST
+      DOUBLE PRECISION NORM,CRIT,LA0E,LACOST
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: INPL2
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: CSTWGT,B2,CONTR2,
+     > LAGF
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: APLUS2
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(INPL2(M0-NCST+1))
+      ALLOCATE(CSTWGT(NCST),B2(M0-NCST+2),CONTR2(NCST))
+      ALLOCATE(LAGF(N0),APLUS2(M0-NCST+1,N0+M0-NCST))
+*----
+*  STEP 0: INITIALIZATION
+*  NPM: SIZE OF THE LINEARIZED SYSTEM.
+*  M0B: NUMBER OF LINEARIZED CONSTRAINTS FOR THE LA ALGORITHM.
+*       CORRESPONDS TO THE NUMBER OF POSSIBLY ACTIVE BOUNDS.
+*  NPMB: SIZE OF THE LINEARIZED SYSTEM FOR THE LA ALGORITHM.
+*----
+      NPM=(M0+1)+N0
+      M0B=M0-NCST
+      NPMB=N0+M0B
+      IF(NCST.GT.0) THEN
+         CALL LCMLEN(IPOPT,'CST-WEIGHT',LENGT,ITYP)
+         IF(LENGT.EQ.0) THEN
+            CALL XABORT('PLPNLT: CONSTRAINTS PENALTIES NON INITIALIZED')
+         ELSEIF(LENGT.EQ.NCST) THEN
+            CALL LCMGET(IPOPT,'CST-WEIGHT',CSTWGT)
+         ELSE
+            CALL XABORT('PLPNLT: WRONG NUMBER OF CONSTRAINT WEIGHTS')
+         ENDIF
+         DO 10 J=1,NCST
+            CONTR2(J)=-CONTR(J)
+   10    CONTINUE
+         LCST2(:NCST)=.TRUE.
+         LCST(:NCST)=.TRUE.
+      ENDIF
+      XOBJ(:N0)=0.0D0
+*----
+*  INTERNAL ITERATIONS FOR THE LINEAR PROBLEM
+*----
+      ITER=0
+   99 ITER=ITER+1
+      LTST=.TRUE.
+*----
+*  STEP 1: PENALTY FUNCTION EVALUATION
+*----
+      DO 110 J=1,NCST
+         IF(INEGAL(J).NE.0) THEN
+            CRIT=CONTR2(J)
+            DO 100 I=1,N0
+               CRIT=CRIT+GRAD(I,J+1)*XOBJ(I)
+  100       CONTINUE
+            CRIT=INEGAL(J)*CRIT
+            LCST(J)=(CRIT.LE.0.0)
+         ENDIF
+  110 CONTINUE
+
+      DO 150 I=1,N0
+         LAGF(I)=GF(I)
+         DO 140 J=1,NCST
+            IF(INEGAL(J).EQ.0) THEN
+               LAGF(I)=LAGF(I)+GRAD(I,J+1)*CSTWGT(J)*CONTR2(J)
+            ELSEIF(.NOT.LCST(J)) THEN
+               LAGF(I)=LAGF(I)+GRAD(I,J+1)*CSTWGT(J)*CONTR2(J)
+            ENDIF
+  140    CONTINUE
+  150 CONTINUE
+
+      LACOST=FCOST
+      DO 160 J=1,NCST
+         IF(INEGAL(J).EQ.0) THEN
+            LACOST=LACOST+CSTWGT(J)/2.0*CONTR2(J)**2
+         ELSEIF(.NOT.LCST(J)) THEN
+            LACOST=LACOST+CSTWGT(J)/2.0*CONTR2(J)**2
+         ENDIF
+  160 CONTINUE
+      IF(ITER.EQ.1) LA0E=LACOST
+      IF(IMPR.GE.3) THEN
+         WRITE(6,*) 'GF',(GF(I),I=1,N0)
+         WRITE(6,*) 'LAGF',(LAGF(I),I=1,N0)
+         WRITE(6,*) 'PDG',(PDG(I),I=1,N0)
+         WRITE(6,*) 'LACOST',LACOST,'M0B',M0B,'XDROIT',XDROIT
+      ENDIF
+*----
+*  STEP 2: SOLUTION
+*  case 1
+*  If there is no constraints for the LA problem (M0B=0), 
+*    then the solution is obvious: on the hypersphere(radius XDROIT) 
+*    in the direction LAGF
+*----
+      IF(M0B.EQ.0) THEN
+      NORM=0.0
+      DO 200 I=1,N0
+         NORM=NORM+LAGF(I)**2/PDG(I)
+  200 CONTINUE
+      NORM=NORM**0.5
+*
+      IF(NORM.EQ.0.0) THEN
+         XOBJ(:N0)=0.0D0
+      ELSE
+         DO 210 I=1,N0
+            XOBJ(I)=-XDROIT**0.5*LAGF(I)/PDG(I)/NORM
+  210    CONTINUE
+      ENDIF
+*----
+*  CASE 2
+*  SOLUTION WITH THE LEMKE METHOD
+*----
+      ELSE
+*
+      DO 260 K=1,M0B
+         DO 250 I=1,N0
+            APLUS2(K,I)=APLUS(NCST+K,I)
+  250    CONTINUE
+         B2(K)=BPLUS(NCST+K)
+         INPL2(K)=INPLUS(NCST+K)
+  260 CONTINUE
+      DO 270 I=1,N0
+         APLUS2(M0B+1,I) = 0.0D0
+  270 CONTINUE
+      BPLUS(M0B+1)   = 0.0
+      INPL2(M0B+1)  = 0
+*
+      CALL PLMAP2(N0,M0B,APLUS2,PDG,B2,INPL2,XDROIT,LAGF,LACOST,XOBJ,2,
+     > EPSIM,IMPR,IERR)
+*
+      ENDIF
+      DO 410 J=1,NCST
+         IF(INEGAL(J).NE.0) THEN
+            CRIT=CONTR2(J)
+            DO 400 I=1,N0
+               CRIT=CRIT+GRAD(I,J+1)*XOBJ(I)
+  400       CONTINUE
+            CRIT=INEGAL(J)*CRIT
+            LCST2(J)=(CRIT.LE.0.0)
+         ENDIF
+  410 CONTINUE
+      
+      IF((IMPR.GE.2).AND.(NCST.GT.0)) THEN
+         WRITE(6,*) (LCST(J),J=1,NCST)
+         WRITE(6,*) (LCST2(J),J=1,NCST)
+      ENDIF
+      DO 420 J=1,NCST
+         LTST=LTST.AND.(LCST(J).EQV.LCST2(J))
+  420 CONTINUE
+
+      IF((.NOT.LTST) .AND.(ITER.LE.ITERMX)) GO TO 99
+*----
+*                  k,l
+*    STEP 3: SAVE P
+*----
+      CALL LCMSIX(IPOPT,'OLD-VALUE',1)
+      CALL LCMPUT(IPOPT,'F-PENAL-EVAL',1,4,LA0E)
+      IF(IMPR.GE.1)   WRITE(6,*) 'LAGF',(LAGF(I),I=1,N0)
+      CALL LCMPUT(IPOPT,'DF-LA-PENAL',N0,4,LAGF)
+      CALL LCMSIX(IPOPT,' ',0)
+*     
+      IF(IMPR.GE.1) WRITE(6,*) 'Dvar',(XOBJ(I),I=1,N0)
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(APLUS2,LAGF)
+      DEALLOCATE(CONTR2,B2,CSTWGT)
+      DEALLOCATE(INPL2)
+      RETURN
+      END
diff --git a/Donjon/src/PLQ.f b/Donjon/src/PLQ.f
new file mode 100644
index 0000000..91b1392
--- /dev/null
+++ b/Donjon/src/PLQ.f
@@ -0,0 +1,628 @@
+*DECK PLQ
+      SUBROUTINE PLQ(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Solves a linear optimization problem with a quadratic constraint.
+* PLQ = Quasi Linear Programmation (aka Optex method) 
+*
+*Copyright:
+* Copyright (C) 2002 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* R. Chambon
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The calling specifications are:
+* OPTIM := PLQ: OPTIM :: (plq\_data) ;
+* where
+*   OPTIM : name of the \emph{optimize} object (L\_OPTIMIZE signature) 
+*     containing the optimization informations. Object OPTIM must appear on 
+*     both LHS and RHS to be able to update the previous values.
+*   (plq\_data) : structure containing the data to the module PLQ:.
+*                          
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT  NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER   NSTATE
+      PARAMETER (NSTATE=40)
+      INTEGER   NITMA,ITYP,ITYP1,ICONV,ICST,IEDSTP,LENGT1,LENGT2,ITYLCM,
+     1          ISTEP,IVAR
+      REAL      FLOTT,ECOSTR
+      CHARACTER TEXT12*12,HSIGN*12,TEXT16*16
+      INTEGER   OPTPRI(NSTATE)
+      DOUBLE PRECISION OPTPRR(NSTATE)
+      TYPE(C_PTR) IPOPT
+      INTEGER   I,NVAR,NCST,LENGT,IPRINT,NSTPEX,IMTHD,M0,MINMAX,CNVTST,
+     1          IERR
+      DOUBLE PRECISION DFLOTT,XDROIT,XS,XXS,EPS1,EPS4,EPSIM,ECOST,
+     1                 DELTA,SR,NORM,EPSEXT,COST,CQUAD,OBJNEW,OBJOLD,
+     2                 DERR,NORX,ERRX,DDX
+      LOGICAL   LSAVE,LNORM2,LWAR,LBACK
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: INEGAL
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: VARVAL,VARWGT,
+     > FCSTV,GRAD,ODX,ODF,DX,CONTR,VALMAX,VALMIN,DINF,DSUP,VARVL2,
+     > GRAD0,VARV0,WEIGH,DERIV0,CSTV0
+*----
+*  CHECK THE VALIDITY OF OBJECTS
+*----
+      IF(NENTRY.NE.1) CALL XABORT('PLQ:ONE OBJECT EXPECTED.')
+      IF(JENTRY(1).NE.1) CALL XABORT('PLQ: OBJECT IN MODIFICATION '
+     1  //'MODE ONLY')
+      IPOPT=KENTRY(1)
+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2))CALL XABORT('PLQ:'
+     1      //' LCM OBJECT EXPECTED')
+      CALL LCMGTC(KENTRY(1),'SIGNATURE',12,HSIGN)
+      IF(HSIGN.NE.'L_OPTIMIZE') THEN
+         TEXT12=HENTRY(1)
+         CALL XABORT('PLQ: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     1   '. L_OPTIMIZE EXPECTED.')
+      ENDIF
+*----
+*  RECOVER STATE VECTOR INFORMATION	
+*----
+      CALL LCMGET(IPOPT,'STATE-VECTOR',OPTPRI)
+      NVAR  =OPTPRI(1)
+      NCST  =OPTPRI(2)
+      MINMAX=OPTPRI(3)
+      ICONV =OPTPRI(4)
+      IF((MINMAX.NE.1).AND.(MINMAX.NE.-1)) CALL XABORT('PLQ: '
+     1  //'MINMAX not equal to 1 or -1')
+      NSTPEX=OPTPRI(5)+1
+      IEDSTP=OPTPRI(6)
+      IMTHD =OPTPRI(9)
+      ISTEP= OPTPRI(10)
+      CALL LCMGET(IPOPT,'OPT-PARAM-R',OPTPRR)
+      SR    =OPTPRR(1)
+      EPS1  =OPTPRR(2)
+      EPSEXT=OPTPRR(3)
+      EPSIM =OPTPRR(4)
+      EPS4  =OPTPRR(5)
+      ECOST =OPTPRR(6)
+*----
+*  SET CONTROL-VARIABLE VALUES
+*----
+      ALLOCATE(VARVAL(NVAR))
+      CALL LCMLEN(IPOPT,'VAR-VALUE',LENGT,ITYP)
+      IF(LENGT.NE.NVAR) CALL XABORT('PLQ: WRONG NUMBER OF VARIABLE')
+*----
+*  SET CONTROL-VARIABLE WEIGHTS
+*----
+      ALLOCATE(VARWGT(NVAR))
+      CALL LCMLEN(IPOPT,'VAR-WEIGHT',LENGT,ITYP)
+      IF(LENGT.EQ.0) THEN
+         VARWGT(:NVAR)=1.0D0
+      ELSE IF(LENGT.EQ.NVAR) THEN
+         CALL LCMGET(IPOPT,'VAR-WEIGHT',VARWGT)
+      ELSE
+         CALL XABORT('PQL: NVAR - LENGT ARE NOT THE SAME')
+      ENDIF
+*----
+*  MEMORY ALLOCATION
+*----
+      ALLOCATE(FCSTV(NCST+1),GRAD(NVAR*(NCST+1)),ODX(NVAR),ODF(NVAR))
+*----
+*  SET SYSTEM CHARACTERISTICS (THE OBJECTIVE FUNCTION IS THE FIRST ONE)
+*----
+      CALL LCMLEN(IPOPT,'FOBJ-CST-VAL',LENGT,ITYP)
+      IF(LENGT.EQ.0) CALL XABORT('PLQ: OBJECTIVE FUNCTION AND CONSTRA'
+     1  //'INTS NOT YET EVALUATED')
+      CALL LCMGET(IPOPT,'FOBJ-CST-VAL',FCSTV)
+      COST=FCSTV(1)
+*----
+*  READ USER INPUT:
+*----
+      IPRINT=0
+      LWAR=.FALSE.
+   20 CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
+*     Edition level
+   30 IF(ITYP.NE.3) CALL XABORT('PLQ: CHARACTER DATA EXPECTED(1)')
+      IF(TEXT12.EQ.'EDIT') THEN
+         CALL REDGET(ITYP,IPRINT,FLOTT,TEXT12,DFLOTT)
+         IF(ITYP.NE.1) CALL XABORT('PLQ: *IPRINT* MUST BE INTEGER')
+      ELSE IF(TEXT12.EQ.'MINIMIZE') THEN
+         MINMAX=1
+      ELSE IF(TEXT12.EQ.'MAXIMIZE') THEN
+         MINMAX=-1
+      ELSE IF(TEXT12.EQ.'METHOD') THEN
+         CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
+         IF(ITYP.NE.3) CALL XABORT('PLQ: CHARACTER DATA EXPECTED(2)')
+         IF(TEXT12.EQ.'SIMPLEX') THEN
+            IMTHD=1
+         ELSE IF(TEXT12.EQ.'LEMKE') THEN
+            IMTHD=2
+         ELSE IF(TEXT12.EQ.'MAP') THEN
+            IMTHD=3
+         ELSE IF(TEXT12.EQ.'AUG-LAGRANG') THEN
+            IMTHD=4
+         ELSE IF(TEXT12.EQ.'PENAL-METH') THEN
+            IMTHD=5
+         ELSE
+            CALL XABORT('PLQ: WRONG METHOD KEYWORD')
+         ENDIF
+      ELSE IF(TEXT12.EQ.'OUT-STEP-LIM') THEN
+         CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
+         IF(ITYP.EQ.2) THEN
+            SR=FLOTT
+         ELSE IF(ITYP.EQ.4) THEN
+            SR=DFLOTT
+         ELSE
+            CALL XABORT('PLQ: REAL OR DOUBLE PRECISION VALUE EXPECTED.')
+         ENDIF
+      ELSE IF(TEXT12.EQ.'INN-STEP-EPS') THEN
+*        Set the tolerence used for inner linear LEMKE or SIMPLEX
+*        calculation.
+         CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
+         IF(ITYP.EQ.2) THEN
+            EPSIM=FLOTT
+         ELSE IF(ITYP.EQ.4) THEN
+            EPSIM=DFLOTT
+         ELSE
+            CALL XABORT('PLQ: REAL OR DOUBLE PRECISION VALUE EXPECTED.')
+         ENDIF
+      ELSE IF(TEXT12.EQ.'OUT-STEP-EPS') THEN
+*        Set the tolerence used for external iterations.
+         CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
+         IF(ITYP.EQ.2) THEN
+            EPSEXT=FLOTT
+         ELSE IF(ITYP.EQ.4) THEN
+            EPSEXT=DFLOTT
+         ELSE
+            CALL XABORT('PLQ: REAL OR DOUBLE PRECISION VALUE EXPECTED.')
+         ENDIF
+      ELSE IF(TEXT12.EQ.'CST-QUAD-EPS') THEN
+         CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
+         IF(ITYP.NE.2) CALL XABORT('PLQ: REAL DATA EXPECTED.')
+         EPS4=FLOTT
+      ELSE IF(TEXT12.EQ.'STEP-REDUCT') THEN
+         CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
+         IF(ITYP.NE.3) CALL XABORT('PLQ: CHARACTER DATA EXPECTED(3).')
+         IF(TEXT12.EQ.'HALF') THEN
+            IEDSTP=1
+         ELSE IF(TEXT12.EQ.'PARABOLIC') THEN
+            IEDSTP=2
+         ELSE
+            CALL XABORT('PLQ: WRONG STEP REDUCTION KEYWORD.')
+         ENDIF
+      ELSE IF(TEXT12.EQ.'WARNING-ONLY')THEN
+*        Warning Only for failure of recovery of a valid point
+         LWAR=.TRUE.
+      ELSE IF(TEXT12.EQ.'CALCUL-DX')THEN
+*        Calculation of next point
+         GO TO 100
+      ELSE IF(TEXT12.EQ.'COST-EXTRAP')THEN
+*        Cost extrapolation
+         GO TO 200
+      ELSE IF(TEXT12.EQ.'OUT-CONV-TST') THEN
+*        Convergence test
+         GO TO 300
+      ELSE IF( TEXT12.EQ.';' )THEN
+*        End of this subroutine
+         GO TO 1000
+      ELSE
+         CALL XABORT('PLQ: '//TEXT12//' IS AN INVALID KEYWORD.')
+      ENDIF
+      GO TO 20
+*----
+*  TEST FOR IMPROVEMENT FOR THE OBJECTIVE FUNCTION
+*----
+  100 LBACK=.FALSE.
+      CALL LCMLEN(IPOPT,'OLD-VALUE',LENGT,ITYP)
+      IF((JENTRY(1).EQ.1).AND.(LENGT.NE.0)) THEN
+        ALLOCATE(CSTV0(NCST+1))
+        OBJNEW=FCSTV(1)
+        CALL LCMSIX(IPOPT,'OLD-VALUE',1)
+        CALL LCMLEN(IPOPT,'FOBJ-CST-VAL',LENGT1,ITYP)
+        CALL LCMLEN(IPOPT,'VAR-VALUE',LENGT2,ITYP)
+        IF(LENGT1.EQ.0) THEN
+          CALL XABORT('PLQ: MISSING OLD OBJECTIVE FUNCTION VALUE')
+        ELSE IF(LENGT1.NE.NCST+1) THEN
+          CALL XABORT('PLQ: WRONG NUMBER OF CONSTRAINTS')
+        ELSE IF(LENGT2.EQ.0) THEN
+          CALL XABORT('PLQ: MISSING CONTROL VARIABLES RECORD')
+        ELSE IF(LENGT2.NE.NVAR) THEN
+          CALL XABORT('PLQ: WRONG NUMBER OF CONTROL VARIABLES')
+        ENDIF
+        CALL LCMGET(IPOPT,'FOBJ-CST-VAL',CSTV0)
+        OBJOLD=CSTV0(1)
+        IF(OBJNEW.GE.OBJOLD) THEN
+          LBACK=.TRUE.
+          IF(IPRINT.GT.1) WRITE(6,4005) OBJOLD,OBJNEW
+        ENDIF
+        DEALLOCATE(CSTV0)
+        CALL LCMSIX(IPOPT,' ',2)
+      ENDIF
+*----
+*  RECOVER OBJECTIVE FUNCTION AND GRADIENTS FROM PRECEDING ITERATION
+*----
+      IF(LBACK) THEN
+        ISTEP=0
+        CALL LCMGET(IPOPT,'VAR-VALUE',VARVAL)
+        IF(IPRINT.GT.1) THEN 
+           WRITE(6,4001) 'REJECTED CONTROL VARIABLES:',
+     1     (VARVAL(IVAR),IVAR=1,NVAR)
+        ENDIF
+        CALL LCMSIX(IPOPT,'OLD-VALUE',1)
+        ALLOCATE(CSTV0(NCST+1),VARV0(NVAR),DERIV0(NVAR*(NCST+1)),
+     1  WEIGH(NVAR))
+        CALL LCMGET(IPOPT,'FOBJ-CST-VAL',CSTV0)
+        CALL LCMGET(IPOPT,'VAR-VALUE',VARV0)
+        CALL LCMGET(IPOPT,'GRADIENT',DERIV0)
+        CALL LCMSIX(IPOPT,' ',2)
+        CALL LCMPUT(IPOPT,'FOBJ-CST-VAL',NCST+1,4,CSTV0)
+        CALL LCMPUT(IPOPT,'VAR-VALUE',NVAR,4,VARV0)
+        CALL LCMPUT(IPOPT,'GRADIENT',NVAR*(NCST+1),4,DERIV0)
+        IF(IEDSTP.LE.1) THEN
+          SR=SR*0.5
+        ELSE IF(IEDSTP.EQ.2) THEN
+          CALL LCMLEN(IPOPT,'VAR-WEIGHT',LENGT,ITYLCM)
+          IF(LENGT.EQ.NVAR) THEN
+            CALL LCMGET(IPOPT,'VAR-WEIGHT',WEIGH)
+          ELSE
+            WEIGH(:NVAR)=1.0D0
+          ENDIF
+          NORX=0.0D0
+          DERR=0.0D0
+          DO 110 I=1,NVAR
+          DDX=VARVAL(I)-VARV0(I)
+          NORX=NORX+WEIGH(I)*DDX**2
+          DERR=DERR+SQRT(WEIGH(I))*DDX*DERIV0(I)
+  110     CONTINUE
+          NORX=NORX**0.5
+          DERR=DERR/NORX
+          ERRX=ABS(0.5*DERR*NORX*NORX/(DERR*NORX-(OBJNEW-OBJOLD)))
+          SR=MAX(MIN(SR,ERRX),SR/20.0)
+          DEALLOCATE(WEIGH)
+        ENDIF
+        IF(IPRINT.GT.1) WRITE(6,'(/31H PLQ: REDUCES QUADRATIC CONSTRA,
+     1  13HINT RADIUS TO,1P,E11.4,8H IEDSTP=,I4)') SR,IEDSTP
+        IF(SR.LE.EPS4) THEN
+          WRITE(6,4006)
+          ICONV=1
+        ENDIF
+        DEALLOCATE(DERIV0,VARV0,CSTV0)
+*----
+*  USES NEW GRADIENTS FROM MODULE GRAD:
+*----
+      ELSE
+*       count the number of iterations without step back
+        ISTEP=ISTEP+1
+        IF(ISTEP.GT.10) THEN
+          SR=2.0*SR
+          ISTEP=5
+          IF(IPRINT.GT.1) WRITE(6,'(/29H PLQ: INCREASES QUADRATIC CON,
+     1    17HSTRAINT RADIUS TO,1P,E11.4)') SR
+        ENDIF
+        CALL LCMGET(IPOPT,'VAR-VALUE',VARVAL)
+        CALL LCMSIX(IPOPT,'OLD-VALUE',1)
+        CALL LCMPUT(IPOPT,'VAR-VALUE2',NVAR,4,VARVAL)
+        CALL LCMSIX(IPOPT,' ',2)
+      ENDIF
+*----
+*  SET GRADIENTS
+*----
+      CALL LCMGET(IPOPT,'GRADIENT',GRAD)
+*----
+*  PRINT INFORMATION
+*----
+      IF(IPRINT.GT.0) THEN
+        WRITE(6,'(/47H PLQ: INFORMATION AT QUADRATIC CONSTRAINT ITERA,
+     1  4HTION,I5)') NSTPEX
+        WRITE(6,3999) NSTPEX,FCSTV(1)
+        WRITE(6,4000) 'QUADRATIC CONSTRAINT RADIUS:',SR
+        IF(NCST.GT.0) WRITE(6,4001) 'CONSTRAINTS:',(FCSTV(ICST),
+     1  ICST=2,NCST+1)
+        CALL LCMLEN(IPOPT,'VAR-VALUE',LENGT1,ITYLCM)
+        IF(LENGT1.GT.0) THEN
+          CALL LCMGET(IPOPT,'VAR-VALUE',VARVAL)
+          WRITE(6,4001) 'CONTROL VARIABLES:',(VARVAL(IVAR),IVAR=1,NVAR)
+        ENDIF
+        IF(IPRINT.GT.1) THEN
+          ALLOCATE(DERIV0(NVAR*(NCST+1)))
+          CALL LCMGET(IPOPT,'GRADIENT',DERIV0)
+          WRITE(6,'(/29H GRADIENTS-------------------)')
+          WRITE(6,4001) 'OBJECTIVE FUNCTION:',(DERIV0(IVAR),IVAR=1,NVAR)
+          IF(IPRINT.GT.2) THEN
+            DO 120 ICST=1,NCST
+            WRITE(TEXT16,'(10HCONSTRAINT,I4,1H:)') ICST
+            WRITE(6,4001) TEXT16,(DERIV0(ICST*NVAR+IVAR),IVAR=1,NVAR)
+  120       CONTINUE
+          ENDIF
+          DEALLOCATE(DERIV0)
+        ENDIF
+        IF(LBACK) WRITE(6,'(28H *** STEP BACK ITERATION ***)')
+      ENDIF
+*----
+*  NEXT STEP CALCULATION
+*----
+      CALL LCMGET(IPOPT,'VAR-VALUE',VARVAL)
+      CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
+      IF(TEXT12.EQ.'NO-STORE-OLD') THEN
+         LSAVE=.TRUE.
+         CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
+      ELSE
+         LSAVE=.FALSE.
+      ENDIF
+      ITYP1=ITYP
+      ALLOCATE(DX(NVAR))
+      IF(NCST.GT.0) THEN
+*        INEQUAL
+         ALLOCATE(INEGAL(NCST))
+         CALL LCMLEN(IPOPT,'CST-TYPE',LENGT,ITYP)
+         IF(LENGT.NE.NCST) CALL XABORT('PLQ: NCST - LENGT NOT EQUAL')
+         CALL LCMGET(IPOPT,'CST-TYPE',INEGAL)
+*
+*        CONTR
+         ALLOCATE(CONTR(NCST))
+         CALL LCMLEN(IPOPT,'CST-OBJ',LENGT,ITYP)
+         IF(LENGT.NE.NCST) CALL XABORT('PLQ: NCST - LENGT NOT EQUAL')
+         CALL LCMGET(IPOPT,'CST-OBJ',CONTR)
+         DO 130 I=1,NCST
+         CONTR(I) = CONTR(I)-FCSTV(I+1)
+  130    CONTINUE
+      ENDIF
+*
+*   DINF AND DSUP
+      CALL LCMLEN(IPOPT,'VAR-VAL-MAX',LENGT,ITYP)
+      IF(LENGT.EQ.0) CALL XABORT('PLQ: NO MAXIMUM VALUE DEFINED')
+      ALLOCATE(VALMAX(NVAR),VALMIN(NVAR))
+      CALL LCMGET(IPOPT,'VAR-VAL-MAX',VALMAX)
+      CALL LCMLEN(IPOPT,'VAR-VAL-MIN',LENGT,ITYP)
+      IF(LENGT.EQ.0) CALL XABORT('PLQ: NO MAXIMUM VALUE DEFINED')
+      CALL LCMGET(IPOPT,'VAR-VAL-MIN',VALMIN)
+      ALLOCATE(DINF(NVAR),DSUP(NVAR))
+      DO 140 I=1,NVAR
+         DINF(I) = VALMIN(I) - VARVAL(I)
+         DSUP(I) = VALMAX(I) - VARVAL(I)
+  140    CONTINUE
+      DEALLOCATE(VALMAX,VALMIN)
+*
+      M0     = NCST
+      XDROIT = SR**2
+      IF(IPRINT.GE.1) WRITE(6,4002) XDROIT,(VARWGT(I),I=1,NVAR)
+*----
+*  FIND ACTIVE CONSTRAINTS FOR XK(I) LIMITS
+*----
+      DO 150 I=1,NVAR
+         XS = SQRT(XDROIT/VARWGT(I))
+         XXS=-XS
+         IF(DINF(I).GT.XXS) THEN
+            M0 = M0 + 1
+         ENDIF
+         IF(DSUP(I).LT.XS) THEN
+            M0 = M0 + 1
+         ENDIF
+  150    CONTINUE
+*----
+*  SOLUTION OF A LINEAR OPTIMIZATION PROBLEM WITH A QUADRATIC CONSTRAINT
+*----
+      IERR=0
+      CALL PLDRV(IPOPT,NVAR,NCST,M0,MINMAX,IMTHD,COST,DX,VARWGT,GRAD,
+     > INEGAL,CONTR,DINF,DSUP,XDROIT,EPSIM,IPRINT,IERR)
+*----
+*  STEP-BACK IN CASE OF FAILURE
+*----
+      IF(IERR.GE.1) THEN
+         OPTPRI(14)=OPTPRI(14)+1
+         CALL LCMSIX(IPOPT,'OLD-VALUE',1)
+         CALL LCMLEN(IPOPT,'VAR-VALUE2',LENGT,ITYP)
+         IF(LENGT.EQ.0) THEN
+            IF(LWAR) THEN
+               WRITE(6,*) 'WARNING: UNABLE TO RECOVER A VALID POINT'
+     1         //' WITH SUCCESSFUL "PLQ" RESOLUTION'
+            ELSE
+               CALL LCMLIB(IPOPT)
+               CALL XABORT('PLQ: UNABLE TO RECOVER A VALID POINT WITH '
+     1         //'SUCCESSFUL "PLQ" RESOLUTION')
+            ENDIF
+         ELSE
+            ALLOCATE(VARVL2(NVAR))
+            CALL LCMGET(IPOPT,'VAR-VALUE2',VARVL2)
+            DO 160 I=1,NVAR
+            DX(I)=(VARVL2(I)-VARVAL(I))/2.0
+  160       CONTINUE
+            DEALLOCATE(VARVL2)
+         ENDIF
+         CALL LCMSIX(IPOPT,' ',2)
+         IF(IPRINT.GE.1) WRITE(6,*) 'IERR>0'
+         IF(IPRINT.GE.1) WRITE(6,*) 'DX=',(DX(I),I=1,NVAR)
+      ELSE
+         OPTPRI(14)=0
+      ENDIF
+*
+      DO 170 I=1,NVAR
+         ODX(I)=DX(I)
+         ODF(I)=GRAD(I)
+  170    CONTINUE
+      DEALLOCATE(DX)
+      IF(NCST.GT.0) DEALLOCATE(INEGAL)
+      DEALLOCATE(DINF,DSUP)
+      IF(NCST.GT.0) DEALLOCATE(CONTR)
+*----
+*  BACKUP VALUES OF THE PRECEDING ITERATION
+*----
+      IF(.NOT.LSAVE) THEN
+         CALL LCMSIX(IPOPT,'OLD-VALUE',1)
+         CALL LCMPUT(IPOPT,'VAR-VALUE',NVAR,4,VARVAL)
+         CALL LCMPUT(IPOPT,'FOBJ-CST-VAL',NCST+1,4,FCSTV)
+         CALL LCMPUT(IPOPT,'GRADIENT',NVAR*(NCST+1),4,GRAD)
+         CALL LCMSIX(IPOPT,' ',2)
+      ENDIF
+*----
+*  BACKUP VALUES OF THE NEW ITERATION
+*----
+      DO 180 I=1,NVAR
+      VARVAL(I)=VARVAL(I)+ODX(I)
+  180 CONTINUE
+      CALL LCMPUT(IPOPT,'VAR-VALUE',NVAR,4,VARVAL)
+      ITYP=ITYP1
+*----
+*  EXTRAPOLATE OBJECTIVE FUNCTION
+*----
+      ECOST=COST
+      DO 190 I=1,NVAR
+      ECOST=ECOST+ODX(I)*ODF(I)
+  190 CONTINUE
+*----
+*  REINITIALIZE GRADIENTS FOR THE NEXT ITERATION
+*----
+      ALLOCATE(GRAD0(NVAR*(NCST+1)))
+      GRAD0(:NVAR*(NCST+1))=0.0D0
+      CALL LCMPUT(IPOPT,'GRADIENT',NVAR*(NCST+1),4,GRAD0)
+      DEALLOCATE(GRAD0)
+      GO TO 30
+*----
+* OUTPUT THE EXTRAPOLATED OBJECTIVE FUNCTION
+*----
+  200 ECOSTR=REAL(ECOST)
+      CALL REDGET(ITYP,NITMA,ECOSTR,TEXT12,DFLOTT)
+      IF(ITYP.NE.-2) CALL XABORT('PLQ: OUTPUT REAL EXPECTED')
+      ITYP=2
+      CALL REDPUT(ITYP,NITMA,ECOSTR,TEXT12,DFLOTT)
+      GO TO 20
+*----
+*  TEST CONVERGENCE
+*----
+  300 LNORM2=.TRUE.
+      CALL REDGET(ITYP,CNVTST,FLOTT,TEXT12,DFLOTT)
+      IF((ITYP.EQ.3).AND.(TEXT12.EQ.'NORM-INF')) THEN
+         LNORM2=.FALSE.
+         CALL REDGET(ITYP,CNVTST,FLOTT,TEXT12,DFLOTT)
+      ENDIF
+      IF(ITYP.NE.-5) CALL XABORT('PLQ: OUTPUT LOGICAL EXPECTED')
+      DELTA=ABS((ECOST-COST)/COST)
+      NORM=0.0
+      CQUAD=0.0
+      IF(LNORM2) THEN
+         DO 350 I=1,NVAR
+            NORM=NORM+VARWGT(I)*VARVAL(I)*VARVAL(I)
+            CQUAD=CQUAD+VARWGT(I)*ODX(I)*ODX(I)
+  350       CONTINUE
+         IF(NORM.NE.0.0) THEN
+            CQUAD=SQRT(CQUAD/NORM)
+         ELSE
+            CQUAD=0.0
+         ENDIF
+      ELSE
+         DO 360 I=1,NVAR
+            NORM=MAX(NORM,ABS(VARWGT(I)**0.5*VARVAL(I)))
+            CQUAD=MAX(CQUAD,ABS(VARWGT(I)**0.5*ODX(I)))
+  360       CONTINUE
+         IF(NORM.NE.0.0) THEN
+            CQUAD=CQUAD/NORM
+         ELSE
+            CQUAD=0.0
+         ENDIF
+      ENDIF
+      IF(EPSEXT.EQ.0.0) EPSEXT = 0.001D0
+      IF(((DELTA.LT.EPSEXT).AND.(CQUAD.LE.EPSEXT)) .OR.
+     1    (CQUAD.LE.(EPSEXT/10.0))) THEN
+         CNVTST=1
+         ICONV =1
+      ELSE
+         CNVTST=-1
+         ICONV =0
+      ENDIF
+      IF(IPRINT.GE.1) THEN
+         WRITE(6,*) 'It= convergence?', DELTA,CQUAD,EPSEXT
+         IF(IPRINT.GT.2) THEN
+            WRITE(6,*) 'DX',(ODX(I),I=1,NVAR)
+            WRITE(6,*) 'X',(VARVAL(I),I=1,NVAR)
+         ENDIF
+      ENDIF
+      ITYP=5
+      CALL REDPUT(ITYP,CNVTST,FLOTT,TEXT12,DFLOTT)
+      GO TO 20
+*----
+*  END
+*----
+ 1000 DEALLOCATE(VARWGT,FCSTV,GRAD,ODX,ODF,VARVAL)
+*----
+*  SAVE THE STATE VECTORS
+*----
+      OPTPRI(:NSTATE)=0
+      OPTPRI(1)=NVAR
+      OPTPRI(2)=NCST
+      OPTPRI(3)=MINMAX
+      OPTPRI(4)=ICONV
+      OPTPRI(5)=NSTPEX
+      OPTPRI(6)=IEDSTP
+      OPTPRI(7)=0
+      OPTPRI(8)=1
+      OPTPRI(9)=IMTHD
+      OPTPRI(10)=ISTEP
+      IF(IPRINT.GT.0) WRITE(6,4003) (OPTPRI(I),I=1,10)
+      CALL LCMPUT(IPOPT,'STATE-VECTOR',NSTATE,1,OPTPRI)
+      OPTPRR(:NSTATE)=0.0D0
+      OPTPRR(1)=SR
+      OPTPRR(2)=EPS1
+      OPTPRR(3)=EPSEXT
+      OPTPRR(4)=EPSIM
+      OPTPRR(5)=EPS4
+      OPTPRR(6)=ECOST
+      IF(IPRINT.GT.0) WRITE(6,4004) (OPTPRR(I),I=1,6)
+      CALL LCMPUT(IPOPT,'OPT-PARAM-R',NSTATE,4,OPTPRR)
+      IF(IPRINT.GT.1) CALL LCMLIB(IPOPT)
+      RETURN
+*
+ 3999 FORMAT(/13H PLQ: ##ITER=,I8,20H OBJECTIVE FUNCTION=,1P,E14.6)
+ 4000 FORMAT(1X,A28,1P,E14.6)
+ 4001 FORMAT(1X,A28,1P,8E12.4/(29X,8E12.4))
+ 4002 FORMAT(//,5X,'SR**2 (XDROIT) = ',1P,D13.5,
+     >        /,5X,'FPOIDS  = ',/,(11X,1P,8D13.5))
+ 4003 FORMAT(/8H OPTIONS/8H -------/
+     1 7H NVAR  ,I8,32H   (NUMBER OF CONTROL VARIABLES)/
+     2 7H NCST  ,I8,26H   (NUMBER OF CONSTRAINTS)/
+     3 7H MINMAX,I8,37H   (=1/-1: MINIMIZATION/MAXIMIZATION)/
+     4 7H ICONV ,I8,43H   (=0/1: EXTERNAL NOT CONVERGED/CONVERGED)/
+     5 7H NSTPEX,I8,44H   (ITERATION INDEX OF QUADRATIC CONSTRAINT)/
+     6 7H IEDSTP,I8,43H   (=1/2: HALF REDUCTION/PARABOLIC FORMULA)/
+     7 7H IHESS ,I8,29H   (=0/1/2: STEEPEST/CG/BFGS)/
+     8 7H ISEARC,I8,35H   (=0/1/2: NO SEARCH/OPTEX/NEWTON)/
+     9 7H IMTHD ,I8,42H   (=1/2/3: SIMPLEX-LEMKE/LEMKE-LEMKE/MAP)/
+     1 7H ISTEP ,I8,43H   (NUMBER OF ITERATIONS WITHOUT STEP-BACK))
+ 4004 FORMAT(/
+     1 12H REAL PARAM:,1P/12H -----------/
+     2 7H SR    ,D12.4,39H   (RADIUS OF THE QUADRATIC CONSTRAINT)/
+     3 7H EPS1  ,D12.4,13H   (NOT USED)/
+     4 7H EPSEXT,D12.4,31H   (EXTERNAL CONVERGENCE LIMIT)/
+     5 7H EPSIM ,D12.4,31H   (INTERNAL CONVERGENCE LIMIT)/
+     6 7H EPS4  ,D12.4,43H   (QUADRATIC CONSTRAINT CONVERGENCE LIMIT)/
+     7 7H ECOST ,D12.4,17H   (UPDATED COST))
+ 4005 FORMAT(/38H PLQ: OBJECTIVE FUNCTION INCREASE FROM,1P,E12.4,
+     1 3H TO,E12.4/35H RETURN BACK TO PREVIOUS ITERATION.)
+ 4006 FORMAT(/1X,'PLQ: THE QUADRATIC CONSTRAINT RADIUS CANNOT BE FUR',
+     1 'THER REDUCED')
+      END
diff --git a/Donjon/src/PLQUAD.f b/Donjon/src/PLQUAD.f
new file mode 100644
index 0000000..230325a
--- /dev/null
+++ b/Donjon/src/PLQUAD.f
@@ -0,0 +1,391 @@
+*DECK PLQUAD
+      SUBROUTINE PLQUAD(N0,M1,MAXM,APLUS,BPLUS,PDG,XDROIT,COUT,XOBJ,
+     > EPS,IMPR,IERR)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Minimize a linear problem with a quadratic constraint using a
+* parametric complementarity principle.
+* PLQUAD = Linear Programmation with QUADratic constraint
+*
+*Copyright:
+* Copyright (C) 2002 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert and T. Falcon
+*
+*Parameters: input
+* N0      number of control variables.
+* M1      number of constraints.
+* MAXM    first dimension of matrix APLUS.
+* APLUS   coefficient matrix for the linear constraints.
+* BPLUS   right hand sides corresponding to the coefficient matrix.
+* PDG     weights assigned to control variables in the quadratic
+*         constraint.
+* XDROIT  quadratic constraint radius squared.
+* COUT    costs of control variables.
+* EPS     tolerence used for pivoting.
+* IMPR    print flag.
+*
+*Parameters: ouput
+* XOBJ    control variables.
+* IERR    return code (=0: normal completion).
+*
+*-----------------------------------------------------------------------
+*
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER     N0,M1,MAXM,IERR,IMPR
+      DOUBLE PRECISION BPLUS(M1+1),PDG(N0),XOBJ(N0),EPS,XDROIT,
+     > APLUS(MAXM,N0),COUT(N0)
+*----
+*  LOCAL VARIABLES
+*----
+      CHARACTER*4 ROW(7)
+      DOUBLE PRECISION  PVAL,POLY0,POLY1,POLY2,XVALIR,X,OBJ,DISCRI,
+     >            XROOT1,XROOT2,XVAL,XTAUU,XVALL,XVALC,OBJLIN
+      INTEGER     N,NP1,NP2,NP3,I,J,K,IS,JS,IROWIS,IR,IROWR,JR,IKIT,II
+      DOUBLE PRECISION  XTAU,XTAUL,UI,XMIN,XVALU
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IROW,ICOL
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: U,V,WRK
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: P
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(IROW(M1+1),ICOL(M1+2))
+      ALLOCATE(U(M1+1),V(M1+1))
+      ALLOCATE(P(M1+1,M1+4),WRK(N0))
+*
+      N     = M1 + 1
+      NP1   = N + 1
+      NP2   = N + 2
+      NP3   = N + 3
+*----
+*  STEP 2: SET-UP AND SOLVE THE PARAMETRIC COMPLEMENTARITY PROBLEM.
+*----
+      DO I=1,N
+         DO J=1,N0
+           WRK(J) = APLUS(I,J)/PDG(J)
+         ENDDO
+         DO K=1,N
+            PVAL = 0.0D0
+            DO J=1,N0
+               PVAL = PVAL + WRK(J)*APLUS(K,J)
+            ENDDO
+            P(I,K) = PVAL
+        ENDDO
+      ENDDO
+*
+      DO I=1,N
+         IROW(I) =  I
+         ICOL(I) = -I
+         P(I,NP1) = 1.0D0
+         P(I,NP2) = 0.0D0
+         P(I,NP3) = BPLUS(I)
+      ENDDO
+*
+      ICOL(NP1) = -NP1
+      P(N,NP2)  = 1.0D0
+*
+      CALL PLLEMK(N,NP3,EPS,IMPR,P,IROW,ICOL,IERR)
+*
+      IF (IERR.GE.1) THEN
+         WRITE(6,1000) IERR
+         GO TO 500
+      ENDIF
+*
+      XTAU  = 0.0
+      XTAUL = 0.0
+      OBJLIN = BPLUS(N)
+*----
+*  COMPUTE VECTOR T=(NU,PI)=U+XTAU*V
+*----
+  110 POLY0 = 0.0D0
+      POLY1 = 0.0D0
+      POLY2 = 0.0D0
+*
+      DO 120 I=1,N
+         IR = -IROW(I)
+         IF (IR.GT.0) THEN
+            U(IR) = P(I,NP3)
+            V(IR) = P(I,NP2)
+            POLY0 = POLY0 - P(I,NP3)*BPLUS(IR)
+            POLY1 = POLY1 - P(I,NP2)*BPLUS(IR)
+         ELSE
+            U(-IR) = 0.0
+            V(-IR) = 0.0
+         ENDIF
+         IF (IR.EQ.N) THEN
+            POLY1 = POLY1 - P(I,NP3)
+            POLY2 = (-P(I,NP2))
+         ENDIF
+  120 CONTINUE
+*
+      IF (IMPR.GE.3) THEN
+         DO 121 I=1,N0
+            XOBJ(I) = 0.0
+  121    CONTINUE
+*
+         DO 123 I=1,N
+            UI = U(I) + XTAUL*V(I)
+            IF (UI.EQ.0.0) GO TO 123
+            DO 122 J=1,N0
+               XOBJ(J) = XOBJ(J) - UI*APLUS(I,J)/PDG(J)
+  122       CONTINUE
+  123    CONTINUE
+*
+         X = 0.0D0
+         OBJ = 0.0D0
+         DO 126 J=1,N0
+            X = X + PDG(J)*XOBJ(J)*XOBJ(J)
+            OBJ = OBJ + XOBJ(J)*COUT(J)
+  126    CONTINUE
+         WRITE(6,2000) OBJ,POLY0,X,POLY1,XTAUL,POLY2,(XOBJ(J),J=1,N0)
+      ENDIF
+      IF ((XTAU.EQ.0.0).AND.(POLY0.LE.XDROIT)) GO TO 230
+*----
+*  STEP 3
+*----
+      DO 130 I=1,N
+         IF(P(I,NP2).LT.-EPS) GO TO 140
+  130 CONTINUE
+      GO TO 215
+*----
+*  STEP 4
+*----
+  140 XTAUU = 1.0E+25
+*
+      IR = 0
+      DO 150 K=I,N
+         IF(P(K,NP2).GE.-EPS) GO TO 150
+         XVAL = -P(K,NP3)/P(K,NP2)
+         IF(XVAL.GT.XTAUU) GO TO 150
+         XTAUU = XVAL
+         IR = K
+  150 CONTINUE
+*
+      XVALU = (POLY2*XTAUU + POLY1)*XTAUU + POLY0
+*----
+*  STEP 5
+*----
+      IF(XVALU.LE.XDROIT) GO TO 215
+      IROWR = IABS(IROW(IR))
+      JR=0
+      DO 160 K=1,NP1
+         IF(IABS(ICOL(K)).EQ.IROWR) THEN
+            JR=K
+            GO TO 170
+         ENDIF
+  160 CONTINUE
+      IERR = 5
+      GO TO 500
+*
+  170 XTAUL = XTAUU
+      XVALL = XVALU
+      IF(P(IR,JR).LE.EPS) GO TO 180
+      CALL PLPIVT(N,NP3,IR,JR,P,IROW,ICOL)
+      GO TO 110
+*
+  180 XMIN=1.0E+25
+*
+      XVALIR = P(IR,NP3)/P(IR,NP2)
+*
+      DO 190 I=1,N
+         IF(P(I,JR).GE.-EPS) GO TO 190
+         XVAL = -1.0D0/P(I,JR)*(P(I,NP3) - P(I,NP2)*XVALIR)
+         IF(XVAL.GE.XMIN) GO TO 190
+         XMIN = XVAL
+         IS = I
+  190 CONTINUE
+*
+      IF (XMIN.EQ.1.0E+25) THEN
+         IERR = 6
+         GO TO 500
+      ENDIF
+*
+      IROWIS=IABS(IROW(IS))
+      DO 200 JS=1,N
+         IF(IABS(ICOL(JS)).EQ.IROWIS) GO TO 210
+  200 CONTINUE
+*
+  210 CALL PLPIVT(N,NP3,IR,JS,P,IROW,ICOL)
+      CALL PLPIVT(N,NP3,IS,JR,P,IROW,ICOL)
+      GO TO 110
+*----
+*  STEP 6
+*----
+  215 IKIT = 0
+*
+  216 XTAU  = (XTAUL + XTAUU)/2.0
+      IKIT = IKIT + 1
+      IF (IKIT.GT.50) GOTO 217
+      XVALC = ((POLY2*XTAU + POLY1)*XTAU + POLY0)/XDROIT
+      IF (IMPR.GE.3) THEN
+         WRITE(6,5000) XTAUL,XTAUU,XTAU,POLY0,POLY1,POLY2,XDROIT,XVALC
+      ENDIF
+      IF (XVALC.GT.1.0) GO TO 220
+      IF (XVALC.GE.0.99999) GO TO 230
+      XTAUU = XTAU
+      GO TO 216
+  220 XTAUL = XTAU
+      GO TO 216
+*----
+*  STEP 6
+*----
+  217 XTAU  = (XTAUL + XTAUU)/2.0
+      XVALC = ((POLY2*XTAU + POLY1)*XTAU + POLY0)/XDROIT
+      IF (IMPR.GE.3) THEN
+         WRITE(6,5000) XTAUL,XTAUU,XTAU,POLY0,POLY1,POLY2,XDROIT,XVALC
+      ENDIF
+*
+      IF (POLY0.EQ.0.0) THEN
+         IF (POLY1.EQ.0.0) THEN
+            IF (POLY2.EQ.0.0) THEN
+               WRITE(6,6000) POLY0,POLY1,POLY2,XDROIT
+               IERR = 7
+               GO TO 500
+            ELSE
+               IF (POLY2.LT.0.0) THEN
+                  WRITE(6,6000) POLY0,POLY1,POLY2,XDROIT
+                  IERR = 7
+                  GO TO 500
+               ENDIF
+               XTAU = SQRT(XDROIT/POLY2)
+            ENDIF
+         ELSE IF (POLY2.EQ.0.0) THEN
+            XTAU = XDROIT/POLY1
+         ELSE
+            DISCRI = POLY1*POLY1 + 4.*POLY2*XDROIT
+            IF (DISCRI.LT.0.0) THEN
+               WRITE(6,6000) POLY0,POLY1,POLY2,XDROIT
+               IERR = 7
+               GO TO 500
+            ENDIF
+            XROOT1 = -POLY1 + SQRT(DISCRI)
+            XROOT2 = -POLY1 - SQRT(DISCRI)
+            XTAU = MAX(XROOT1,XROOT2)
+            IF (XTAU.LE.0.0) THEN
+               WRITE(6,6000) POLY0,POLY1,POLY2,XDROIT
+               IERR = 7
+               GO TO 500
+            ENDIF
+            XTAU = XTAU/(2.*POLY2)
+         ENDIF
+      ELSE IF (POLY1.EQ.0.0) THEN
+         IF (POLY2.EQ.0.0) THEN
+            IF ((POLY0.LT.(XDROIT-EPS)).OR.(POLY0.GT.XDROIT+EPS)) THEN
+               WRITE(6,6000) POLY0,POLY1,POLY2,XDROIT
+               IERR = 7
+               GO TO 500
+            ENDIF
+         ELSE
+            DISCRI = XDROIT-POLY0
+            IF (DISCRI.LT.0.0) THEN
+               WRITE(6,6000) POLY0,POLY1,POLY2,XDROIT
+               IERR = 7
+               GO TO 500
+            ENDIF
+            XTAU = SQRT(DISCRI/POLY2)
+         ENDIF
+      ELSE IF (POLY2.EQ.0.0) THEN
+         XTAU = (XDROIT-POLY0)/POLY1
+      ELSE
+         DISCRI = POLY1*POLY1 - 4.*POLY2*(POLY0-XDROIT)
+         IF (DISCRI.LT.0.0) THEN
+            WRITE(6,6000) POLY0,POLY1,POLY2,XDROIT
+            IERR = 7
+            GO TO 500
+         ENDIF
+         XROOT1 = -POLY1 + SQRT(DISCRI)
+         XROOT2 = -POLY1 - SQRT(DISCRI)
+         XTAU = MAX(XROOT1,XROOT2)
+         IF (XTAU.LE.0.0) THEN
+            WRITE(6,6000) POLY0,POLY1,POLY2,XDROIT
+            IERR = 7
+            GO TO 500
+         ENDIF
+         XTAU = XTAU/(2.*POLY2)
+      ENDIF
+*
+      IF (IMPR.GE.3) THEN
+         WRITE(6,5000) XTAUL,XTAUU,XTAU,POLY0,POLY1,POLY2,XDROIT,XVALC
+      ENDIF
+*
+      IF (ABS(XTAU).GT.XTAUU) THEN
+         XTAU = XTAUU
+      ENDIF
+*----
+*  END OF THE ALGORITHM. COMPUTE THE CONTROL VARIABLES.
+*----
+  230 XVALC=(POLY2*XTAU+POLY1)*XTAU+POLY0
+*
+      IF ((IMPR.GE.3).AND.(XVALC.NE.1.0)) THEN
+         WRITE(6,5000) XTAUL,XTAUU,XTAU,POLY0,POLY1,POLY2,XDROIT,XVALC
+      ENDIF
+*
+      IF (IMPR.GE.2) THEN
+         WRITE(6,3000) XTAU,XVALC
+         DO 255 I=1,N,7
+            II = MIN0(I+6,N)
+            DO 250 J=I,II
+               IF (IROW(J).LT.0) THEN
+                  WRITE (ROW(J-I+1),'(1HX,I3.3)') (-IROW(J))
+               ELSE
+                  WRITE (ROW(J-I+1),'(1HY,I3.3)') IROW(J)
+               ENDIF
+*
+  250       CONTINUE
+            WRITE(6,4000) (ROW(J-I+1),P(J,NP3)+XTAU*P(J,NP2),J=I,II)
+  255    CONTINUE
+      ENDIF
+      IERR = 0
+*
+      XOBJ(:N0)=0.0D0
+      DO 280 I=1,N
+         UI = U(I) + XTAU*V(I)
+         IF (UI.EQ.0.0) GO TO 280
+         DO 270 J=1,N0
+            XOBJ(J) = XOBJ(J) - UI*APLUS(I,J)/PDG(J)
+  270    CONTINUE
+  280 CONTINUE
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+  500 DEALLOCATE(WRK,P)
+      DEALLOCATE(V,U)
+      DEALLOCATE(ICOL,IROW)
+      RETURN
+*
+ 1000 FORMAT(//,5X,'PLQUAD: FAILURE OF THE PARAMETRIC LINEAR COMPLEME',
+     > 'NTARITY SOLUTION (IERR=',I5,').')
+ 2000 FORMAT(//,5X,'SOLUTION AFTER PIVOTING : ',
+     >        /,5X,'OBJECTIVE FUNCTION     = ',1P,E12.5,
+     >        /,5X,'POLY0                  = ',1P,E12.5,
+     >        /,5X,'QUADRATIC CONSTRAINT   = ',1P,E12.5,
+     >        /,5X,'POLY1                  = ',1P,E12.5,
+     >        /,5X,'XTAU PARAMETER         = ',1P,E12.5,
+     >        /,5X,'POLY2                  = ',1P,E12.5,
+     >        /,5X,'CONTROL VARIABLES      = ',/,(5X,1P,10E12.4))
+ 3000 FORMAT(//,5X,'SOLUTION OF THE PARAMETRIC LINEAR COMPLEMENTARITY',
+     >        ' PROBLEM :','*** X: KUHN-TUCKER MULTIPLIERS ;',
+     >          5X,'*** Y: SLACK VARIABLES ',/,
+     >        /,5X,'TAU                    = ',1P,E12.5,
+     >        /,5X,'QUADRATIC CONSTRAINT   = ',1P,E12.5,/)
+ 4000 FORMAT(7(1X,A4,'=',E12.5),/)
+ 5000 FORMAT(   8X,'XTAUL',7X,'XTAUU',7X,'XTAU ',7X,
+     >             'POLY0',7X,'POLY1',7X,'POLY2',7X,
+     >             'XDROIT',6X,'XVALC',/,
+     >          5X,1P,8E12.5)
+ 6000 FORMAT(   8X,'POLY0',7X,'POLY1',7X,'POLY2',7X,
+     >             'XDROIT'/5X,1P,4E12.5)
+      END
diff --git a/Donjon/src/RESBRN.f b/Donjon/src/RESBRN.f
new file mode 100644
index 0000000..aaedbe1
--- /dev/null
+++ b/Donjon/src/RESBRN.f
@@ -0,0 +1,201 @@
+*DECK RESBRN
+      SUBROUTINE RESBRN(IPMAP,NCH,NB,NCOMB,NX,NY,NZ,LRSCH,IMPX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Initialize the axial shape and compute the first burnup limits per
+* bundle for every channel (used for the time-average model).
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+*  D. Sekki, I. Trancart
+*
+*Parameters: input
+* IPMAP   pointer to fuel-map information.
+* NCH     number of reactor channels.
+* NB      number of fuel bundles per channel.
+* NCOMB   number of combustion zones.
+* NX      number of elements along x-axis in fuel map.
+* NY      number of elements along y-axis in fuel map.
+* NZ      number of elements along z-axis in fuel map.
+* LRSCH   flag for the refuelling scheme of channels:
+*          =.true. it was read from the input file;
+*          =.false. otherwise.
+* IMPX    printing index (=0 for no print).
+*
+*----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAP
+      INTEGER NCH,NB,NCOMB,NX,NY,NZ,IMPX
+      LOGICAL LRSCH
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(IOUT=6)
+      INTEGER IVECT(NCOMB,NB),NSCH(NCH),IZONE(NCH),MIX(NX*NY*NZ),
+     1 NAMX(NX),NAMY(NY),RSCH(NX,NY),AGLIM,CHR(NB)
+      REAL BVAL(NCOMB),DELT(NB),B0(NB),B1(NB),SHAP(NCH,NB),
+     1 BURN0(NCH,NB),BURN1(NCH,NB)
+      CHARACTER TEXT*12,CHANY*2,FORM1*14,FORM2*14,SHU*3
+      LOGICAL LAXSH
+*----
+*  RECOVER INFORMATION
+*----
+      CALL LCMLEN(IPMAP,'REF-SCHEME',LENG1,ITYP)
+      CALL LCMLEN(IPMAP,'BURN-AVG',LENG2,ITYP)
+      IF((LENG1.EQ.0).OR.(LENG2.EQ.0))GOTO 100
+      CALL LCMLEN(IPMAP,'AX-SHAPE',LENG3,ITYP)
+      IF(LENG3.EQ.0) THEN
+*       INITIAL FLAT AXIAL-SHAPE
+        IF(IMPX.GT.0)WRITE(IOUT,1000)
+        SHAP(:NCH,:NB)=1.0/NB
+        CALL LCMPUT(IPMAP,'AX-SHAPE',NCH*NB,2,SHAP)
+      ELSE
+        CALL LCMGET(IPMAP,'AX-SHAPE',SHAP)
+      ENDIF
+      CALL LCMGET(IPMAP,'REF-VECTOR',IVECT)
+      CALL LCMGET(IPMAP,'REF-SCHEME',NSCH)
+      CALL LCMGET(IPMAP,'BURN-AVG',BVAL)
+      CALL LCMGET(IPMAP,'B-ZONE',IZONE)
+      CALL LCMGET(IPMAP,'BMIX',MIX)
+      BURN0(:NCH,:NB)=0.0
+      BURN1(:NCH,:NB)=0.0
+      LAXSH=.FALSE.
+      IF(IMPX.GT.2)WRITE(IOUT,1004)
+*----
+*  COMPUTE FIRST BURNUP LIMITS
+*----
+      ICH=0
+      DO 70 IEL=1,NX*NY
+      IF(MIX(IEL).EQ.0) GOTO 70
+      ICH=ICH+1
+      IBSH=ABS(NSCH(ICH))
+      SHU=' NO'
+      DO IB=1,NB
+      DELT(IB)=IBSH*BVAL(IZONE(ICH))*SHAP(ICH,IB)
+      B0(IB)=0.
+      B1(IB)=0.
+*     Axial Shuffling detection
+      IF(IVECT(IZONE(ICH),IB).GT.IB)THEN
+        LAXSH=.TRUE.
+        SHU='YES'
+      ENDIF
+      ENDDO
+*     Burnup attribution with axial Shuffling
+      IF(LAXSH)THEN 
+        AGLIM=INT(NB/IBSH)+1
+        CHR(:NB)=AGLIM
+*       Two loops on bundle cycles (IA) and number of bundles (IB)
+        DO 45 IA=0,AGLIM-1
+        DO 40 IB=1,NB
+*       Index ordering
+        IF (NSCH(ICH).LT.0) THEN
+          KK=NB-IB+1
+          KV=NB-IVECT(IZONE(ICH),IB)+1
+        ELSE
+          KK=IB
+          KV=IVECT(IZONE(ICH),IB)
+        ENDIF
+*       New fuel
+        IF(IVECT(IZONE(ICH),IB).EQ.0)THEN
+            CHR(IB)=0
+            B0(KK)=0.
+            B1(KK)=DELT(KK)
+        ELSE 
+*         Compute new burnup if previous bundle cycle done
+          IF(CHR(IVECT(IZONE(ICH),IB)).EQ.(IA-1))THEN
+            CHR(IB)=IA
+            B0(KK)=B1(KV)
+            B1(KK)=DELT(KK)+B1(KV)
+          ENDIF
+        ENDIF
+   40   CONTINUE
+   45   CONTINUE
+*     Burnup attribution without axial Shuffling 
+*     One loop on number of bundles (IB)
+      ELSE
+*       NEGATIVE DIRECTION
+        IF(NSCH(ICH).LT.0)THEN
+          DO 50 IB=1,NB
+          KK=NB-IB+1
+          KA=NB-IVECT(IZONE(ICH),IB)+1
+          IF(IVECT(IZONE(ICH),IB).LE.0)THEN
+            B0(KK)=0.
+          ELSE
+            B0(KK)=B1(KA)
+          ENDIF
+          B1(KK)=B0(KK)+DELT(KK)
+   50     CONTINUE
+*       POSITIVE DIRECTION
+        ELSE
+          DO 60 IB=1,NB
+          IF(IVECT(IZONE(ICH),IB).LE.0)THEN
+            B0(IB)=0.
+          ELSE
+            B0(IB)=B1(IVECT(IZONE(ICH),IB))
+          ENDIF
+          B1(IB)=B0(IB)+DELT(IB)
+   60     CONTINUE
+        ENDIF
+      ENDIF
+      DO IB=1,NB
+        BURN0(ICH,IB)=B0(IB)
+        BURN1(ICH,IB)=B1(IB)
+      ENDDO
+      IF(IMPX.GE.3) THEN
+*       CHECK BURNUP LIMITS
+        WRITE(TEXT,'(A9,I3.3)')'CHANNEL #',ICH
+        WRITE(IOUT,1001)TEXT,NSCH(ICH),IZONE(ICH),SHU
+        WRITE(IOUT,1002)'B0',(B0(IB),IB=1,NB)
+        WRITE(IOUT,1002)'B1',(B1(IB),IB=1,NB)
+      ENDIF
+*     Reset shuffling for next channel
+      LAXSH=.FALSE.
+   70 CONTINUE
+      CALL LCMPUT(IPMAP,'BURN-BEG',NB*NCH,2,BURN0)
+      CALL LCMPUT(IPMAP,'BURN-END',NB*NCH,2,BURN1)
+      IF((.NOT.LRSCH).OR.(IMPX.LT.2))GOTO 100
+*----
+*  PRINT CHANNELS REFUELLING SCHEMES
+*----
+      WRITE(FORM1,'(A4,I2,A8)')'(A4,',NX,'(A3,1X))'
+      WRITE(FORM2,'(A4,I2,A8)')'(A2,',NX,'(I3,1X))'
+      CALL LCMGET(IPMAP,'XNAME',NAMX)
+      CALL LCMGET(IPMAP,'YNAME',NAMY)
+      RSCH(:NX,:NY)=0
+      WRITE(IOUT,1003)
+      IEL=0
+      ICH=0
+      DO 85 J=1,NY
+      DO 80 I=1,NX
+      IEL=IEL+1
+      IF(MIX(IEL).EQ.0) GOTO 80
+      ICH=ICH+1
+      RSCH(I,J)=NSCH(ICH)
+   80 CONTINUE
+   85 CONTINUE
+      WRITE(IOUT,FORM1)' ',(NAMX(I),I=1,NX)
+      WRITE(IOUT,*)' '
+      DO 90 J=1,NY
+      WRITE(CHANY,'(A2)') (NAMY(J))
+      IF(INDEX(CHANY,'-').EQ.1) GOTO 90
+      WRITE(IOUT,FORM2)CHANY,(RSCH(I,J),I=1,NX)
+   90 CONTINUE
+  100 RETURN
+*
+ 1000 FORMAT(/1X,'INITIALIZING THE FLAT AXIAL POWER-SHAPE'/
+     1 1X,'COMPUTING THE FIRST BURNUP LIMITS PER EACH CHANNEL'/)
+ 1001 FORMAT(/10X,
+     1 A12,10X,'REFUELLING SCHEME:',I3,10X,'ZONE-INDEX:',I3,10X,
+     2 'SHUFFLING: ',A3)
+ 1002 FORMAT(A3,12(F8.1,1X))
+ 1003 FORMAT(//20X,'** CHANNELS REFUELLING SCHEMES **'/)
+ 1004 FORMAT(/20X,'** FIRST BURNUP LIMITS PER EACH CHANNEL **'/)
+      END
diff --git a/Donjon/src/RESCEL.f b/Donjon/src/RESCEL.f
new file mode 100644
index 0000000..90f14c1
--- /dev/null
+++ b/Donjon/src/RESCEL.f
@@ -0,0 +1,82 @@
+*DECK RESCEL
+      SUBROUTINE RESCEL(IPMAP,NCH,NK,ALCH)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute fuel bundle burnups from the age pattern ALCH between 
+* begin-of-cyle burnups BINI and end-of-cycle burnups BFIN
+*
+*Copyright:
+* Copyright (C) 2002 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* routine partly recovered from OPTEX-4 (coef3e)
+*
+*Parameters: input
+* IPMAP  address of the MAP linked list or xsm file
+* NCH    number of channels
+* NK     number of bundles per channel
+* ALCH   integer representing channel age. 
+*
+*Parameters: output
+* IPMAP  address of the MAP linked list or xsm file
+*
+*Reference:
+* J. Tajmouati, "Optimisation de la gestion du combustible enrichi d'un
+* reacteur CANDU avec prise en compte des parametres locaux", These
+* Ph. D., Ecole Polytechnique de Montreal (1993). Voir Eq. (4.7).
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAP
+      INTEGER     NCH,NK,ALCH(NCH)
+      REAL, ALLOCATABLE, DIMENSION(:) :: F
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: WINT,BINI,BFIN
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER     I,J,ILONG,ITYP
+*----
+*  SCRATCH STORAGE ALLOCATION
+*   BINI   initial burnup map
+*   BFIN   final burnup map
+*   WINT   instantaneous burnup
+*   F      age values in real
+*----
+      ALLOCATE(WINT(NCH,NK),BINI(NCH,NK),BFIN(NCH,NK),F(NCH))
+*
+* RECOVER FUEL BURNUPS
+      CALL LCMLEN(IPMAP,'BURN-BEG',ILONG,ITYP)
+      IF(ILONG.EQ.0) THEN
+         CALL XABORT('SHIFTB: INITIAL BURNUP REQUIRED')
+      ENDIF
+      CALL LCMGET(IPMAP,'BURN-BEG',BINI)
+      CALL LCMLEN(IPMAP,'BURN-END',ILONG,ITYP)
+      IF(ILONG.EQ.0) THEN
+         CALL XABORT('SHIFTB: FINAL BURNUP REQUIRED')
+      ENDIF
+      CALL LCMGET(IPMAP,'BURN-END',BFIN)
+*
+      DO 10 I=1,NCH
+        F(I) = (FLOAT(ALCH(I)) - 0.5) / FLOAT(NCH)
+        IF( ALCH(I).EQ.0 ) F(I) = 0.0
+        DO 11 J=1,NK
+          WINT(I,J) = BINI(I,J) + F(I) * (BFIN(I,J) - BINI(I,J))
+ 11     CONTINUE
+ 10   CONTINUE
+      CALL LCMPUT(IPMAP,'BURN-INST',NCH*NK,2,WINT)
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(F,BFIN,BINI,WINT)
+      RETURN
+      END
diff --git a/Donjon/src/RESDRV.f b/Donjon/src/RESDRV.f
new file mode 100644
index 0000000..38b12a5
--- /dev/null
+++ b/Donjon/src/RESDRV.f
@@ -0,0 +1,374 @@
+*DECK RESDRV
+      SUBROUTINE RESDRV(IPMAP,IPMTX,NFUEL,LX,LY,LZ,IMPX,IGEO,NCH,NB,
+     1 NTOT,NCOMB,NSIMS,NASB,NAX,NAY,NIS,IPCPO)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Read and validate the fuel-map specification from the input file.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki and V. Descotes
+*
+*Update(s):
+* R. Chambon (may 2014)
+*
+*Parameters: input
+* IPMAP  pointer to fuel-map information.
+* IPMTX  pointer to matex information.
+* NFUEL  number of fuel types.
+* LX     number of elements along x-axis in geometry.
+* LY     number of elements along y-axis in geometry.
+* LZ     number of elements along z-axis in geometry.
+* IMPX   printing index (=0 for no print).
+* IGEO   type of geometry (CAR3D=7 or HEXZ=9)
+*
+*Parameters: output
+* NCH    number of reactor channels.
+* NB     number of fuel bundles per channel.
+* NTOT   total number of fuel bundles.
+* NCOMB  number of combustion zones.
+* NSIMS  assembly layout in SIM: module
+* NASB   total number of assembly
+* NAX    number of assembly along x-direction
+* NAY    number of assembly along y-direction
+* NIS    number of particularized isotopes
+* IPCPO  pointer to multicompo information
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAP,IPMTX,IPCPO
+      INTEGER NFUEL,LX,LY,LZ,IMPX,IGEO,NCH,NB,NTOT,NCOMB,NSIMS,NASB,NAX,
+     1 NAY,NIS
+*----
+*  LOCAL VARIABLES
+*----
+      CHARACTER TEXT*12,TEXT4*4,TEXT8*8
+      LOGICAL LGEOM,LXNAME,LYNAME,LASBL,LCPO,LNAP
+      DOUBLE PRECISION DFLOT
+      REAL WEIGHT
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: INX,INY,IZONE,IFMIX,
+     1 IASBL,IANX,IANY,NBAX,IBAX
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: INH
+      CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: HFOLLO
+*
+      IMPX=0
+      LGEOM=.TRUE.
+      LASBL=.FALSE.
+      LCPO=.FALSE.
+      IF(C_ASSOCIATED(IPCPO)) LCPO=.TRUE.
+      NCH=0
+      NB=0
+      NCOMB=0
+      NSIMS=0
+      NASB=0
+      NAX=0
+      NAY=0
+      NIS=0
+*----
+*  TYPE OF GEOMETRY
+*----
+      LXNAME=.TRUE.
+      LYNAME=.TRUE.
+      IF (IGEO.EQ.7) THEN
+        LXNAME=.TRUE.
+        LYNAME=.TRUE.
+      ELSEIF (IGEO.EQ.9) THEN
+        LXNAME=.FALSE.
+        LYNAME=.FALSE.
+      ELSE
+        CALL XABORT('@RESDRV: ONLY 3D-CARTESIAN OR 3D HEXAGONAL' 
+     1 //' GEOMETRY EXPECTED')
+      ENDIF
+   10 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('@RESDRV: CHARACTER DATA EXPECTED.')
+      IF(IMPX.GE.100) WRITE(6,*)'@RESDRV: Reading Keyword=',TEXT
+      IF(TEXT.EQ.'EDIT')THEN
+*----
+*  PRINTING INDEX
+*----
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@RESDRV: INTEGER DATA EXPECTED(1).')
+        IMPX=MAX(0,NITMA)
+        IF(IMPX.GT.4)CALL LCMLIB(IPMTX)
+      ELSE IF(TEXT.EQ.'WEIGHT') THEN
+*----
+*  FUEL WEIGHT
+*----
+        CALL REDGET(ITYP,NB,WEIGHT,TEXT,DFLOT)
+        IF(ITYP.NE.2) CALL XABORT('@RESDRV : REAL DATA EXPECTED(1).')
+        IF(WEIGHT.EQ.0.0 ) CALL XABORT('@RESDRV: INVALID'
+     +       //'VALUE FOR FUEL WEIGHT')
+        CALL LCMPUT(IPMAP,'FUEL-WEIGHT',1,2,WEIGHT)
+      ELSE IF(TEXT.EQ.':::') THEN
+*----
+*  FUEL-MAP GEOMETRY
+*----
+        LGEOM=.FALSE.
+        LNAP=.FALSE.
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@RESDRV: CHARACTER DATA EXPECTED(5).')
+        IF(TEXT.EQ.'SPLIT-NAP:') THEN
+          LNAP=.TRUE.
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+          IF(ITYP.NE.3)CALL XABORT('@RESDRV: CHARACTER DATA '
+     1    //'EXPECTED(6).')
+        ENDIF   
+        IF(TEXT.NE.'GEO:') CALL XABORT('@RESDRV: EMBEDDED GEO: MODULE '
+     1    //'EXPECTED.')
+*----
+*  CHECK GEOMETRY
+*----
+        CALL RESGEO(IPMAP,IPMTX,LX,LY,LZ,NFUEL,IMPX,IGEO,NX,NY,NZ,NCH,
+     1  NB,NTOT,LNAP,IPCPO)
+      ELSEIF(TEXT.EQ.'NXNAME') THEN
+*----
+*  CHANNEL X-NAMES
+*----
+        IF(IGEO.NE.7) CALL XABORT('RESDRV: CARTESIAN GEOM EXPECTED.')
+        LXNAME=.FALSE.
+        ALLOCATE(INX(NX))
+        DO I=1,NX
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT4,DFLOT)
+          IF(ITYP.NE.3)CALL XABORT('@RESDRV: CHARACTER DATA FOR NXNAME'
+     1    //' EXPECTED.')
+          READ(TEXT4,'(A4)') INX(I)
+        ENDDO
+        CALL LCMPUT(IPMAP,'XNAME',NX,3,INX)
+        DEALLOCATE(INX)
+      ELSE IF(TEXT.EQ.'NYNAME') THEN
+*----
+*  CHANNEL Y-NAMES
+*----
+        IF(IGEO.NE.7) CALL XABORT('RESDRV: CARTESIAN GEOM EXPECTED.')
+        LYNAME=.FALSE.
+        ALLOCATE(INY(NY))
+        DO I=1,NY
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT4,DFLOT)
+          IF(ITYP.NE.3)CALL XABORT('@RESDRV: CHARACTER DATA FOR NYNAME'
+     1    //' EXPECTED.')
+          READ(TEXT4,'(A4)') INY(I)
+        ENDDO
+        CALL LCMPUT(IPMAP,'YNAME',NY,3,INY)
+        DEALLOCATE(INY)
+      ELSE IF(TEXT.EQ.'NHNAME') THEN
+*----
+*  CHANNEL H-NAMES
+*----
+        IF(IGEO.NE.9) CALL XABORT('RESDRV: HEXAGONAL GEOM EXPECTED.')
+        ALLOCATE(INH(2,NX))
+        DO I=1,NX
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT8,DFLOT)
+          IF(ITYP.NE.3)CALL XABORT('@RESDRV: CHARACTER DATA FOR NHNAME'
+     1    //' EXPECTED.')
+          READ(TEXT8,'(2A4)') INH(1,I),INH(2,I)
+        ENDDO
+        CALL LCMPUT(IPMAP,'HNAME',2*NX,3,INH)
+        DEALLOCATE(INH)
+      ELSE IF(TEXT.EQ.'SIM') THEN
+*----
+*  DATA FOR SIM: MODULE
+*----
+        IF(NCH.EQ.0)CALL XABORT('@RESDRV: NO FUEL CHANNELS DEFINED')
+        ALLOCATE(IZONE(NCH))
+        IZONE(:NCH)=0
+        CALL REDGET(ITYP,LX,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@RESDRV: INTEGER EXPECTED')
+        IF((LX.LE.0).OR.(LX.GE.31))CALL XABORT('@RESDRV: 0<LX<31')
+        CALL REDGET(ITYP,LY,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@RESDRV: INTEGER EXPECTED')
+        IF((LY.LE.0).OR.(LY.GE.31))CALL XABORT('@RESDRV: 0<LY<31')
+        NSIMS=100*LX+LY
+        DO 20 ICH=1,NCH
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT4,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@RESDRV: CHARACTER EXPECTED')
+        READ(TEXT4,'(A3)') IZONE(ICH)
+        READ(TEXT4,'(1X,I2,1X)') IND
+        IF((IND.LE.0).OR.(IND.GT.LY))CALL XABORT('@RESDRV: 0<IND<=LY')
+   20   CONTINUE
+        CALL LCMPUT(IPMAP,'S-ZONE',NCH,3,IZONE)
+        DEALLOCATE(IZONE)
+        CALL LCMLEN(IPMAP,'FLMIX',ILONG,ITYLCM)
+        IF(ILONG.EQ.0)CALL XABORT('@RESDRV: MUST DEFINE ::: GEO: BEFOR'
+     >  //'E SIM.')
+        ALLOCATE(IFMIX(NCH*NB))
+        CALL LCMGET(IPMAP,'FLMIX',IFMIX)
+        CALL LCMPUT(IPMAP,'FLMIX-INI',NCH*NB,1,IFMIX)
+        DEALLOCATE(IFMIX)
+      ELSE IF(TEXT.EQ.'ASSEMBLY') THEN
+*----
+*  DATA FOR NAP: MODULE
+*----
+        LASBL=.TRUE.
+        IF(NCH.EQ.0)CALL XABORT('@RESDRV: NO FUEL CHANNELS DEFINED')
+        CALL REDGET(ITYP,NASB,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@RESDRV: INTEGER EXPECTED')
+        CALL REDGET(ITYP,NAX,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@RESDRV: INTEGER EXPECTED')
+        CALL REDGET(ITYP,NAY,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@RESDRV: INTEGER EXPECTED')
+* A-ZONE
+        ALLOCATE(IASBL(NCH))
+        IASBL(:NCH)=0
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(TEXT.NE.'A-ZONE')CALL XABORT('@RESDRV: KEYWORD A-ZONE'
+     1    //' EXPECTED.')
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+*       automatic definition
+        IF((ITYP.EQ.3).AND.(TEXT.EQ.'ASBLY')) THEN
+          CALL LCMSIX(IPMAP,'GEOMAP',1)
+          CALL LCMLEN(IPMAP,'A-ZONE',LENGTH,ITYP)
+          IF(NCH.NE.LENGTH) THEN
+            WRITE(6,'(22H @RESDRV: len(A-ZONE)=,I6,5H NCH=,I6)') LENGTH,
+     1      NCH
+            CALL XABORT('@RESDRV: number of ASSEMBLY automaticaly gene'
+     1      //'rated is not equal to NCH')
+          ENDIF
+          CALL LCMGET(IPMAP,'A-ZONE',IASBL)
+          CALL LCMSIX(IPMAP,'GEOMAP',0)
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+*       manual definition
+        ELSEIF(ITYP.EQ.1) THEN
+          DO 30 ICH=1,NCH
+            IF(NITMA.LT.1)CALL XABORT('@RESDRV: INVALID ASSEMBLY'
+     1      //'-ZONE INDEX < 1')
+            IF(NITMA.GT.NASB)CALL XABORT('@RESDRV: INVALID ASSEMBLY'
+     1      //'-ZONE INDEX > NASB')
+            IASBL(ICH)=NITMA
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+   30       CONTINUE
+          IF((ITYP.NE.3).AND.(TEXT.NE.'A-NX')) CALL XABORT('@RESDRV:'
+     1      //'number of ASSEMBLY per row required: A-NX keyword')
+          ALLOCATE(NBAX(NAY))
+          ALLOCATE(IBAX(NAY))
+          DO I=1,NAY
+            CALL REDGET(ITYP,NBAX(I),FLOT,TEXT,DFLOT)
+            IF(ITYP.NE.1) CALL XABORT('@RESDRV: NAY '
+     1      //'integers required after A-NX CARD')
+          ENDDO
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+          IF((ITYP.NE.3).AND.(TEXT.NE.'A-IBX')) CALL XABORT('@RESDRV:'
+     1      //'first column of ASSEMBLY per row required: A-IBX '
+     2      //'keyword')
+          DO I=1,NAY
+            CALL REDGET(ITYP,IBAX(I),FLOT,TEXT,DFLOT)
+            IF(ITYP.NE.1) CALL XABORT('@RESDRV: NAY '
+     1      //'integers required after A-IBX CARD')
+          ENDDO
+          CALL LCMSIX(IPMAP,'GEOMAP',1)
+          CALL LCMPUT(IPMAP,'A-NX',NAY,1,NBAX)
+          CALL LCMPUT(IPMAP,'A-IBX',NAY,1,IBAX)
+          CALL LCMSIX(IPMAP,'GEOMAP',0)
+          DEALLOCATE(NBAX,IBAX)
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        ELSE
+          CALL XABORT('@RESDRV: INTEGER ASSEMBLY-ZONE INDEX or '
+     1      //'ASBLY keyword EXPECTED.')
+        ENDIF
+        CALL LCMPUT(IPMAP,'A-ZONE',NCH,1,IASBL)
+        DEALLOCATE(IASBL)
+* AXNAME
+        IF(TEXT.NE.'AXNAME')CALL XABORT('@RESDRV: KEYWORD AXNAME'
+     1    //' EXPECTED.')
+        ALLOCATE(IANX(NAX))
+        DO I=1,NAX
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT4,DFLOT)
+          IF(ITYP.NE.3)CALL XABORT('@RESDRV: CHARACTER DATA FOR AXNAME'
+     1    //' EXPECTED.')
+          READ(TEXT4,'(A4)') IANX(I)
+        ENDDO
+        CALL LCMPUT(IPMAP,'AXNAME',NAY,3,IANX)
+        DEALLOCATE(IANX)
+* AYNAME
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(TEXT.NE.'AYNAME')CALL XABORT('@RESDRV: KEYWORD AYNAME'
+     1    //' EXPECTED.')
+        ALLOCATE(IANY(NAY))
+        DO I=1,NAY
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT4,DFLOT)
+          IF(ITYP.NE.3)CALL XABORT('@RESDRV: CHARACTER DATA FOR AYNAME'
+     1    //' EXPECTED.')
+          READ(TEXT4,'(A4)') IANY(I)
+        ENDDO
+        CALL LCMPUT(IPMAP,'AYNAME',NAY,3,IANY)
+        DEALLOCATE(IANY)
+      ELSE IF(TEXT.EQ.'FOLLOW') THEN
+        CALL REDGET(ITYP,NIS,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1) CALL XABORT('@RESDRV: INTEGER EXPECTED')
+        ALLOCATE(HFOLLO(NIS))
+        DO 40 ICH=1,NIS
+        CALL REDGET(ITYP,NITMA,FLOT,HFOLLO(ICH),DFLOT)
+        IF(ITYP.NE.3) CALL XABORT('@RESDRV: CHARACTER EXPECTED')
+   40   CONTINUE
+        CALL LCMPTC(IPMAP,'HFOLLOW',8,NIS,HFOLLO)
+        DEALLOCATE(HFOLLO)
+      ELSE IF(TEXT.EQ.'NCOMB') THEN
+*----
+*  NUMBER OF COMBUSTION ZONES
+*----
+        IF(NCH.EQ.0) CALL XABORT('@RESDRV: NO FUEL CHANNELS DEFINED')
+        ALLOCATE(IZONE(NCH))
+        IZONE(:NCH)=0
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF((ITYP.EQ.3).AND.(TEXT.EQ.'ALL'))THEN
+          NCOMB=NCH
+          DO 50 ICH=1,NCH
+          IZONE(ICH)=ICH
+   50     CONTINUE
+        ELSEIF((ITYP.EQ.3).AND.(TEXT.EQ.'ASBLY'))THEN
+          IF(.NOT.LASBL) CALL XABORT('@RESDRV: NO ASSEMBLY DEFINED')
+          NCOMB=NASB
+          ALLOCATE(IASBL(NCH))
+          CALL LCMGET(IPMAP,'A-ZONE',IASBL)
+          DO 60 ICH=1,NCH
+          IZONE(ICH)=IASBL(ICH)
+   60     CONTINUE
+          DEALLOCATE(IASBL)
+        ELSEIF(ITYP.EQ.1)THEN
+          IF(NITMA.LT.1)CALL XABORT('@RESDRV: INVALID NCOMB < 1')
+          IF(NITMA.GT.NCH)CALL XABORT('@RESDRV: INVALID NCOMB > NCH')
+          NCOMB=NITMA
+*----
+*  COMBUSTION-ZONE INDICES
+*----
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+          IF(TEXT.NE.'B-ZONE')CALL XABORT('@RESDRV: KEYWORD B-ZONE'
+     1    //' EXPECTED.')
+          DO 70 ICH=1,NCH
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+          IF(ITYP.NE.1)CALL XABORT('@RESDRV: INTEGER COMBUSTION'
+     1    //'-ZONE INDEX EXPECTED.')
+          IF(NITMA.LT.1)CALL XABORT('@RESDRV: INVALID COMBUSTION'
+     1    //'-ZONE INDEX < 1')
+          IF(NITMA.GT.NCOMB)CALL XABORT('@RESDRV: INVALID COMBUSTION'
+     1    //'-ZONE INDEX > NCOMB')
+          IZONE(ICH)=NITMA
+   70     CONTINUE
+        ELSE
+          CALL XABORT('@RESDRV: INVALID INPUT FOR NCOMB.')
+        ENDIF
+        CALL LCMPUT(IPMAP,'B-ZONE',NCH,1,IZONE)
+        DEALLOCATE(IZONE)
+        GO TO 80
+      ELSE
+        CALL XABORT('@RESDRV: INVALID KEYWORD ('//TEXT//').')
+      ENDIF
+      GO TO 10
+*
+   80 IF(NCH.EQ.0) CALL XABORT('@RESDRV: NO FUEL CHANNELS DEFINED.')
+      IF(NB.EQ.0) CALL XABORT('@RESDRV: NO FUEL BUNDLES DEFINED.')
+      IF(LGEOM) CALL XABORT('@RESDRV: OPERATOR ::: EXPECTED.')
+      IF(LXNAME) CALL XABORT('@RESDRV: KEYWORD NXNAME EXPECTED.')
+      IF(LYNAME) CALL XABORT('@RESDRV: KEYWORD NYNAME EXPECTED.')
+      RETURN
+      END
diff --git a/Donjon/src/RESGEO.f b/Donjon/src/RESGEO.f
new file mode 100644
index 0000000..0c168f7
--- /dev/null
+++ b/Donjon/src/RESGEO.f
@@ -0,0 +1,304 @@
+*DECK RESGEO
+      SUBROUTINE RESGEO(IPMAP,IPMTX,LX,LY,LZ,NFUEL,IMPX,IGEO,NX,NY,NZ,
+     1 NCH,NB,NTOT,LNAP,IPCPO)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Create and check the fuel-map geometry.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* E. Varin, D. Sekki and V. Descotes
+*
+*Update(s):
+* R. Chambon 2014
+*
+*Parameters: input
+* IPMAP  pointer to fuel-map information.
+* IPMTX  pointer to matex information.
+* LX     number of elements along x-axis in geometry.
+* LY     number of elements along y-axis in geometry.
+* LZ     number of elements along z-axis in geometry.
+* NFUEL  number of fuel types.
+* IMPX   printing index (=0 for no print).
+* IGEO   type of geometry (=7 or =9)
+*
+*Parameters: output
+* NX     number of elements along x-axis in fuel map.
+* NY     number of elements along y-axis in fuel map.
+* NZ     number of elements along z-axis in fuel map.
+* NCH    number of reactor channels.
+* NB     number of fuel bundles per channel.
+* NTOT   total number of fuel bundles.
+* LNAP   Flag to call NAP: module to unfold geometry at assembly level
+* IPCPO  pointer to multicompo information
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAP,IPMTX,IPCPO,IPGNW
+      INTEGER LX,LY,LZ,NFUEL,IGEO,NX,NY,NZ,NCH,NB,NTOT
+      LOGICAL LNAP
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(NSTATE=40,IOUT=6,EPSI=1.0E-4)
+      INTEGER ISTATE(NSTATE),JENT(1),IENT(1),JENT2(3),IENT2(3),NCODE(6),
+     1 ICODE(6)
+      TYPE(C_PTR) KENT(1),KENT2(3)
+      REAL    GEOXX(LX+1),GEOYY(LY+1),GEOZZ(LZ+1),GEOSI,GMAPSI,ZCODE(6)
+      CHARACTER HENT(1)*12,HENT2(3)*12,TEXT*12
+      DOUBLE PRECISION DFLOT
+*----
+*  ALLOCATABLE STATEMENTS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: ISPLX,ISPLY,ISPLZ,MAT
+      REAL, ALLOCATABLE, DIMENSION(:) :: GMAPX,GMAPY,GMAPZ
+*----
+*  FUEL-MAP GEOMETRY
+*----
+      IF(IMPX.GT.1)WRITE(IOUT,*)'** CREATING FUEL-MAP GEOMETRY **'
+      CALL LCMSIX(IPMAP,'GEOMAP',1)
+      NENT=1
+      JENT(1)=0
+      HENT(1)='GEOMAP'
+      IENT(1)=1
+      KENT(1)=IPMAP
+      CALL GEOD(NENT,HENT,IENT,JENT,KENT)
+      IF(IMPX.GT.3)CALL LCMLIB(IPMAP)
+*
+      IF(LNAP) THEN
+*----
+*  FUEL-MAP GEOMETRY UNFOLDING WITH NAP:
+*----
+        IF(.NOT.C_ASSOCIATED(IPCPO)) THEN
+          CALL XABORT('RESGEO: COMPO LCM OBJECT MISSING AT RHS.')
+        ENDIF
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@RESGEO: CHARACTER DATA EXPECTED.')
+        IF(TEXT.NE.':::') CALL XABORT('@RESGEO: ::: keyword EXPECTED.')
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@RESGEO: CHARACTER DATA EXPECTED.')
+        IF(TEXT.NE.'NAP:') CALL XABORT('@RESGEO: NAP: keyword '
+     1   //'EXPECTED.')
+        CALL LCMOP(IPGNW,'GEONEW',0,1,0)
+        CALL LCMSIX(IPMAP,' ',0)
+        CALL LCMSIX(IPMAP,'GEOMAP',1)
+        NENT2=3
+        JENT2(1)=0
+        JENT2(2)=2
+        JENT2(3)=2
+        HENT2(1)='GEONEW'
+        HENT2(1)='GEOOLD'
+        HENT2(1)='COMPO'
+        IENT2(1)=1
+        IENT2(2)=1
+        IENT2(3)=1
+        KENT2(1)=IPGNW
+        KENT2(2)=IPMAP
+        KENT2(3)=IPCPO
+        CALL NAP(NENT2,HENT2,IENT2,JENT2,KENT2)
+        CALL LCMSIX(IPMAP,' ',0)
+        IF(IMPX.GT.3)CALL LCMLIB(IPMAP)
+        CALL LCMDEL(IPMAP,'GEOMAP')
+        IF(IMPX.GT.3)CALL LCMLIB(IPMAP)
+        CALL LCMSIX(IPMAP,'GEOMAP',1)
+        IF(IMPX.GT.3)CALL LCMLIB(IPMAP)
+        CALL LCMEQU(IPGNW,IPMAP)
+        IF(IMPX.GT.3)CALL LCMLIB(IPMAP)
+        CALL LCMCL(IPGNW,1)
+      ENDIF
+****
+      CALL LCMSIX(IPMAP,' ',0)
+      IF(IMPX.GT.3)CALL LCMLIB(IPMAP)
+      CALL LCMSIX(IPMAP,'GEOMAP',1)
+      IF(IMPX.GT.3)CALL LCMLIB(IPMAP)
+****
+      ISTATE(:NSTATE)=0
+      CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+      IF(ISTATE(1).NE.IGEO) CALL XABORT('@RESGEO: THE GEOMETRY '
+     1 // 'IN FUEL-MAP MUST HAVE THE SAME TYPE AS IN THE MATEX-OBJECT')
+      IGEO=ISTATE(1)
+      NX=ISTATE(3)
+      NY=ISTATE(4)
+      NZ=ISTATE(5)
+*----
+*  READ FUEL-MAP GEOMETRY AND PERFORM MESH-SPLITTING
+*----
+      IMPX0=MAX(0,IMPX-1)
+      NX2=NX
+      NY2=NY
+      IF(IGEO.GE.8) NY2=1
+      NZ2=NZ
+      ALLOCATE(ISPLX(NX2),ISPLY(NY2),ISPLZ(NZ2))
+      ISPLTL=0
+      ISPLTH=0
+      IHEX=0
+      CALL LCMLEN(IPMAP,'SPLITL',ILEN,ITYLCM)
+      IF(ILEN.GT.0) CALL LCMGET(IPMAP,'SPLITL',ISPLTL)
+      CALL LCMLEN(IPMAP,'SPLITH',ILEN,ITYLCM)
+      IF(ILEN.GT.0) CALL LCMGET(IPMAP,'SPLITH',ISPLTH)
+      IF(IGEO.LT.8) THEN
+        CALL LCMLEN(IPMAP,'SPLITX',ILONG,ITYLCM)
+        IF(ILONG.GT.0) THEN
+          CALL LCMGET(IPMAP,'SPLITX',ISPLX)
+          NX2=0
+          DO IOLD=1,NX
+            NX2=NX2+ISPLX(IOLD)
+          ENDDO
+        ENDIF
+        CALL LCMLEN(IPMAP,'SPLITY',ILONG,ITYLCM)
+        IF(ILONG.GT.0) THEN
+          CALL LCMGET(IPMAP,'SPLITY',ISPLY)
+          NY2=0
+          DO IOLD=1,NY
+            NY2=NY2+ISPLY(IOLD)
+          ENDDO
+        ENDIF
+      ELSEIF((ISPLTH.NE.0).AND.((IGEO.EQ.8).OR.(IGEO.EQ.9))) THEN
+        NX2=NX*6*(ISPLTH**2)
+        CALL LCMGET(IPMAP,'IHEX',IHEX)
+      ELSEIF((ISPLTL.NE.0).AND.((IGEO.EQ.8).OR.(IGEO.EQ.9))) THEN
+        NX2=NX*3*(ISPLTL**2)
+        CALL LCMGET(IPMAP,'IHEX',IHEX)
+      ENDIF
+      CALL LCMLEN(IPMAP,'SPLITZ',ILONG,ITYLCM)
+      IF(ILONG.GT.0) THEN
+        CALL LCMGET(IPMAP,'SPLITZ',ISPLZ)
+        NZ2=0
+        DO IOLD=1,NZ
+          NZ2=NZ2+ISPLZ(IOLD)
+        ENDDO
+      ENDIF
+      MAXPTS=NX2*NY2*NZ2
+      MAXX=NX2
+      IF(IHEX.EQ.1) THEN
+        MAXPTS=12*MAXPTS
+        MAXX=12*MAXX
+      ELSE IF((IHEX.EQ.2).OR.(IHEX.EQ.3)) THEN
+        MAXPTS=6*MAXPTS
+        MAXX=6*MAXX
+      ELSE IF(IHEX.EQ.4) THEN
+        MAXPTS=4*MAXPTS
+        MAXX=4*MAXX
+      ELSE IF(IHEX.EQ.5) THEN
+        MAXPTS=3*MAXPTS
+        MAXX=3*MAXX
+      ELSE IF((IHEX.GE.6).AND.(IHEX.LE.8)) THEN
+        MAXPTS=2*MAXPTS
+        MAXX=2*MAXX
+      ENDIF
+      ALLOCATE(MAT(MAXPTS),GMAPX(MAXX+1),GMAPY(NY2+1),GMAPZ(NZ2+1))
+      CALL READ3D(MAXX,NY2,NZ2,MAXPTS,IPMAP,IHEX,IR,ILK,SIDE,GMAPX,
+     1 GMAPY,GMAPZ,IMPX0,NX2,NY2,NZ2,MAT,NEL,NCODE,ICODE,ZCODE,ISPLX,
+     2 ISPLY,ISPLZ,ISPLH,ISPLL)
+      IF((NEL.NE.NX2*NY2*NZ2).AND.(IHEX.EQ.0))CALL XABORT('@RESGEO: WR'
+     1 // 'ONG GEOMETRY.')
+      IF((NEL.NE.NX2*NZ2).AND.(IHEX.NE.0))CALL XABORT('@RESGEO: WRONG ' 
+     1 // 'HEXAGONAL GEOMETRY, WRONG NUMBER OF ELEMENTS.')
+      DEALLOCATE(MAT,ISPLZ,ISPLY,ISPLX)
+      IF(IMPX.GT.2)WRITE(IOUT,*)'CHECKING FUEL-MAP GEOMETRY'
+      IF((IGEO.NE.7).AND.(IGEO.NE.9))CALL XABORT('@RESGEO: ONLY '
+     1 //'3D-CARTESIAN OR 3D-HEXAGONAL GEOMETRY ALLOWED.')
+      IF(IHEX.EQ.0) THEN
+        IF((LX.LT.NX).OR.(LY.LT.NY).OR.(LZ.LT.NZ)) THEN
+        WRITE(IOUT,*) 'Geometry LX=',LX,', LY=',LY,' and LZ=',LZ, 
+     1   ' must be greater or equal to map ',
+     2   'NX=',NX,' NY=',NY,' and NZ=',NZ
+          CALL XABORT('@RESGEO: WRONG GEOMETRY DEFINITION.')
+        ENDIF  
+      ELSE
+        IF((LX.LT.NX).OR.(LZ.LT.NZ)) THEN
+        WRITE(IOUT,*) 'Geometry LX=',LX,' and LZ=',LZ, 
+     1   ' must be greater or equal to map ',
+     2   'NX=',NX,' and NZ=',NZ
+          CALL XABORT('@RESGEO: WRONG GEOMETRY DEFINITION.')
+        ENDIF  
+      ENDIF 
+      IF(NZ.LT.NB)THEN
+        WRITE(IOUT,*)'@RESGEO: FOUND NZ=',NZ,' LESS THAN NB=',NB
+        CALL XABORT('@RESGEO: WRONG FUEL-MAP GEOMETRY DEFINITION.')
+      ENDIF
+*----
+*  CHECK MESHX OR SIDE
+*----
+      IF(IGEO.EQ.7) THEN
+        GEOXX(:LX+1)=0.0
+        CALL LCMGET(IPMTX,'MESHX',GEOXX)
+        DO 10 IMP=1,NX+1
+        DO IGM=1,LX+1
+          IF(ABS(GMAPX(IMP)-GEOXX(IGM)).LT.EPSI)THEN
+            GEOXX(IGM)=GMAPX(IMP)
+            GOTO 10
+          ENDIF
+        ENDDO
+        WRITE(IOUT,*)'@RESGEO: MESHX IN L_MAP ',GMAPX(IMP)
+        CALL XABORT('@RESGEO: UNABLE TO FIND THIS MESHX IN L_GEOM.')
+   10   CONTINUE
+        CALL LCMPUT(IPMTX,'MESHX',LX+1,2,GEOXX)
+      ELSE IF(IGEO.EQ.9) THEN
+        ISPLTL=0
+        NY=1
+        CALL LCMGET(IPMAP,'SIDE',GMAPSI)
+        CALL LCMLEN(IPMAP,'SPLITL',ILONG,ITYLCM)
+        IF(ILONG.GT.0) CALL LCMGET(IPMAP,'SPLITL',ISPLTL)
+        IF(ISPLTL.EQ.0) ISPLTL=1
+        GMAPSI=GMAPSI/REAL(ISPLTL)
+        CALL LCMGET(IPMTX,'SIDE',GEOSI)
+        IF(ABS(GMAPSI-GEOSI).LT.EPSI)THEN
+          GEOSI=GMAPSI
+          GOTO 20
+        ENDIF
+        WRITE(IOUT,*)'@RESGEO: SIDE IN L_MAP ',GMAPSI, GEOSI
+        CALL XABORT('@RESGEO: UNABLE TO FIND THIS SIDE IN L_GEOM.')
+   20   CONTINUE
+        CALL LCMPUT(IPMTX,'SIDE',1,2,GEOSI)
+      ENDIF
+*----
+*  CHECK MESHY (ONLY IF 3D-CARTESIAN GEOMETRY)
+*----
+      IF(IGEO.EQ.7) THEN
+        GEOYY(:LY+1)=0.0
+        CALL LCMGET(IPMTX,'MESHY',GEOYY)
+        DO 30 IMP=1,NY+1
+        DO IGM=1,LY+1
+          IF(ABS(GMAPY(IMP)-GEOYY(IGM)).LT.EPSI)THEN
+            GEOYY(IGM)=GMAPY(IMP)
+            GOTO 30
+          ENDIF
+        ENDDO
+        WRITE(IOUT,*)'@RESGEO: MESHY IN FUEL MAP ',GMAPY(IMP)
+        CALL XABORT('@RESGEO: UNABLE TO FIND THIS MESHY IN L_GEOM.')
+   30   CONTINUE
+        CALL LCMPUT(IPMTX,'MESHY',LY+1,2,GEOYY)
+      ENDIF
+*----
+*  CHECK MESHZ
+*----
+      GEOZZ(:LZ+1)=0.0
+      CALL LCMGET(IPMTX,'MESHZ',GEOZZ)
+      DO 50 IMP=1,NZ+1
+      DO IGM=1,LZ+1
+        IF(ABS(GMAPZ(IMP)-GEOZZ(IGM)).LT.EPSI)THEN
+          GEOZZ(IGM)=GMAPZ(IMP)
+          GOTO 50
+        ENDIF
+      ENDDO
+      WRITE(IOUT,*)'@RESGEO: MESHZ IN FUEL MAP ',GMAPZ(IMP)
+      CALL XABORT('@RESGEO: UNABLE TO FIND THIS MESHZ IN L_GEOM.')
+   50 CONTINUE
+      CALL LCMPUT(IPMTX,'MESHZ',LZ+1,2,GEOZZ)
+      DEALLOCATE(GMAPZ,GMAPY,GMAPX)
+*----
+*  CHECK FUEL MIXTURES
+*----
+      CALL RESPFM(IPMAP,IPMTX,NX,NY,NZ,LX,LY,LZ,NFUEL,IMPX,IGEO,NCH,NB,
+     1 NTOT)
+      RETURN
+      END
diff --git a/Donjon/src/RESHID.f b/Donjon/src/RESHID.f
new file mode 100644
index 0000000..81ed496
--- /dev/null
+++ b/Donjon/src/RESHID.f
@@ -0,0 +1,144 @@
+*DECK RESHID
+      SUBROUTINE RESHID(IPMAP,IPMTX,NX,NZ,LX,LZ,MIX,NFUEL,IMPX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Update material index, it will store the negative fuel mixtures.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* V. Descotes
+*
+*Parameters: input/output
+* IPMAP  pointer to fuel-map information.
+* IPMTX  pointer to matex information.
+* NX     number of elements along x-axis in fuel map.
+* NZ     number of elements along z-axis in fuel map.
+* LX     number of elements along x-axis in geometry.
+* LZ     number of elements along z-axis in geometry.
+* MIX    renumbered index over the fuel-map geometry.
+* NFUEL  number of fuel types.
+* IMPX   printing index (=0 for no print).
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAP,IPMTX
+      INTEGER NX,NZ,LX,LZ,MIX(NX*NZ),NFUEL,IMPX
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(IOUT=6)
+      INTEGER ISPLTY(1),NCODE(6)
+      REAL    MTXSIDE,MAPSIDE
+      TYPE(C_PTR) JPMAP
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IMAT,ISPLTX,ISPLTZ,INDX,
+     1 FTOT,DPP,MX
+      REAL, ALLOCATABLE, DIMENSION(:) :: MAPZZ,GEOZZ
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(ISPLTX(LX),ISPLTZ(LZ),INDX(LX*LZ),FTOT(NFUEL))
+      ALLOCATE(MAPZZ(NZ+1),GEOZZ(LZ+1))
+*----
+*  RECOVER GEOMETRY AND FUELMAP INFORMATION
+*----
+      CALL LCMGET(IPMTX,'SIDE',MTXSIDE)
+      CALL LCMGET(IPMTX,'MESHZ',GEOZZ)
+      JPMAP=LCMGID(IPMAP,'GEOMAP')
+      CALL LCMGET(JPMAP,'IHEX',IHEX)
+      CALL LCMGET(JPMAP,'SIDE',MAPSIDE)
+      CALL LCMGET(JPMAP,'MESHZ',MAPZZ)
+      ISPLTL=0
+      CALL LCMLEN(JPMAP,'SPLITL',ILONG,ITYLCM)
+      IF(ILONG.NE.0) CALL LCMGET(JPMAP,'SPLITL',ISPLTL)
+*----
+*  UNFOLD GEOMETRY IF HEXAGONAL IN LOZENGES
+*----
+      IF((ISPLTL.GT.0).AND.(IHEX.NE.9)) THEN
+         MAXPTS=LX*LZ
+         ALLOCATE(DPP(MAXPTS),MX(NX*NZ))
+         DO 10 I=1,NX*NZ
+         MX(I)=MIX(I)
+   10    CONTINUE
+         NXOLD=NX
+         CALL BIVALL(MAXPTS,IHEX,NXOLD,NX,DPP)
+         DO 30 KZ=1,NZ
+         DO 20 KX=1,NX
+         KEL=DPP(KX)+(KZ-1)*NXOLD
+         INDX(KX+(KZ-1)*NX)=MX(KEL)
+   20    CONTINUE
+   30    CONTINUE
+         DEALLOCATE(DPP,MX)
+         IHEX=9
+      ELSE
+         INDX(:NX*NZ)=MIX(:NX*NZ)
+      ENDIF
+*----
+*  FUELMAP INFORMATION SPLITTING
+*----
+      NY=1
+      ITYPE=9
+      ISPLTX(:NX)=1
+      ISPLTY(:NY)=1
+      IZ=1
+      DO KM=1,NZ
+        ISPLTZ(KM)=0
+        DO JZ=IZ,LZ
+          IF(GEOZZ(JZ+1).LE.MAPZZ(KM+1)) THEN
+            ISPLTZ(KM)=ISPLTZ(KM)+1
+          ELSE
+            IZ=JZ
+            EXIT
+          ENDIF
+        ENDDO
+      ENDDO
+      MAXPTS=LX*LZ
+      LX1=LX
+      LY1=1
+      LZ1=LZ
+      CALL SPLIT0 (MAXPTS,ITYPE,NCODE,NX,NY,NZ,ISPLTX,ISPLTY,ISPLTZ,
+     1 0,ISPLTL,NMBLK,LX1,LY1,LZ1,MAPSIDE,XXX,YYY,ZZZ,INDX,.FALSE.,
+     2 IMPX)
+      IF(ISPLTL.GT.0) MAPSIDE=MAPSIDE/REAL(ISPLTL)
+      IF(ABS(MAPSIDE-MTXSIDE).GT.1.0E-6) CALL XABORT('RESHID: INVALID '
+     1 //'SIDE.')
+*     CHECK TOTAL NUMBER
+      ITOT=0
+      DO 40 IEL=1,LX*LZ
+      IF(INDX(IEL).NE.0)ITOT=ITOT+1
+   40 CONTINUE
+      NTOT=0
+      CALL LCMGET(IPMTX,'FTOT',FTOT)
+      DO 50 IFUEL=1,NFUEL
+      NTOT=NTOT+FTOT(IFUEL)
+   50 CONTINUE
+      IF(ITOT.NE.NTOT) THEN
+         WRITE(IOUT,'(/15H @RESHID: ITOT=,I8,6H NTOT=,I8)') ITOT,NTOT
+         CALL XABORT('@RESHID: FOUND DIFFERENT TOTAL NUMBER OF FUEL MI'
+     1   //'XTURES IN FUEL-MAP AND MATEX.')
+      ENDIF
+*     STORE NEGATIVE FUEL MIXTURES
+      CALL LCMLEN(IPMTX,'MAT',LENGT,ITYP)
+      ALLOCATE(IMAT(LENGT))
+      IMAT(:LENGT)=0
+      CALL LCMGET(IPMTX,'MAT',IMAT)
+      DO 60 IEL=1,LX*LZ
+      IF(INDX(IEL).NE.0)IMAT(IEL)=-INDX(IEL)
+   60 CONTINUE
+      CALL LCMPUT(IPMTX,'MAT',LENGT,1,IMAT)
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(IMAT,GEOZZ,MAPZZ,FTOT,INDX,ISPLTZ,ISPLTX)
+      RETURN
+      END
diff --git a/Donjon/src/RESIND.f b/Donjon/src/RESIND.f
new file mode 100644
index 0000000..d869637
--- /dev/null
+++ b/Donjon/src/RESIND.f
@@ -0,0 +1,128 @@
+*DECK RESIND
+      SUBROUTINE RESIND(IPMAP,IPMTX,NX,NY,NZ,LX,LY,LZ,MIX,NFUEL,IMPX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Update material index, it will store the negative fuel mixtures.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* E. Varin, D. Sekki
+*
+*Parameters: input/output
+* IPMAP  pointer to fuel-map information.
+* IPMTX  pointer to matex information.
+* NX     number of elements along x-axis in fuel map.
+* NY     number of elements along y-axis in fuel map.
+* NZ     number of elements along z-axis in fuel map.
+* LX     number of elements along x-axis in geometry.
+* LY     number of elements along y-axis in geometry.
+* LZ     number of elements along z-axis in geometry.
+* MIX    renumbered index over the fuel-map geometry.
+* NFUEL  number of fuel types.
+* IMPX   printing index (=0 for no print).
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAP,IPMTX
+      INTEGER NX,NY,NZ,LX,LY,LZ,MIX(NX*NY*NZ),NFUEL,IMPX
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(IOUT=6)
+      INTEGER INDX(LX*LY*LZ),FTOT(NFUEL)
+      REAL    MAPXX(NX+1),MAPYY(NY+1),MAPZZ(NZ+1),
+     1        GEOXX(LX+1),GEOYY(LY+1),GEOZZ(LZ+1)
+      TYPE(C_PTR) JPMAP
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IMAT
+*----
+*  UPDATE MATERIAL INDEX
+*----
+      CALL LCMGET(IPMTX,'MESHX',GEOXX)
+      CALL LCMGET(IPMTX,'MESHY',GEOYY)
+      CALL LCMGET(IPMTX,'MESHZ',GEOZZ)
+      JPMAP=LCMGID(IPMAP,'GEOMAP')
+      CALL LCMGET(JPMAP,'MESHX',MAPXX)
+      CALL LCMGET(JPMAP,'MESHY',MAPYY)
+      CALL LCMGET(JPMAP,'MESHZ',MAPZZ)
+      INDX(:LX*LY*LZ)=0
+      IF(IMPX.GT.2)WRITE(IOUT,*)'UPDATING MATERIAL INDEX'
+      I1=0
+      I2=0
+      J1=0
+      J2=0
+      K1=0
+      K2=0
+      DO 52 KM=1,NZ
+      DO 51 JM=1,NY
+      DO 50 IM=1,NX
+      DO IG=1,LX
+      IF(MAPXX(IM).EQ.GEOXX(IG)) I1=IG
+      IF(MAPXX(IM+1).EQ.GEOXX(IG+1))THEN
+        I2=IG
+        GOTO 10
+      ENDIF
+      ENDDO
+   10 DO JG=1,LY
+      IF(MAPYY(JM).EQ.GEOYY(JG)) J1=JG
+      IF(MAPYY(JM+1).EQ.GEOYY(JG+1))THEN
+        J2=JG
+        GOTO 20
+      ENDIF
+      ENDDO
+   20 DO KG=1,LZ
+      IF(MAPZZ(KM).EQ.GEOZZ(KG)) K1=KG
+      IF(MAPZZ(KM+1).EQ.GEOZZ(KG+1))THEN
+        K2=KG
+        GOTO 30
+      ENDIF
+      ENDDO
+   30 IELM=(KM-1)*NX*NY+(JM-1)*NX +IM
+      DO 42 KG=K1,K2
+      DO 41 JG=J1,J2
+      DO 40 IG=I1,I2
+      IELG=(KG-1)*LX*LY+(JG-1)*LX+IG
+      INDX(IELG)=MIX(IELM)
+   40 CONTINUE
+   41 CONTINUE
+   42 CONTINUE
+   50 CONTINUE
+   51 CONTINUE
+   52 CONTINUE
+*     CHECK TOTAL NUMBER
+      ITOT=0
+      DO 60 IEL=1,LX*LY*LZ
+      IF(INDX(IEL).NE.0)ITOT=ITOT+1
+   60 CONTINUE
+      NTOT=0
+      CALL LCMGET(IPMTX,'FTOT',FTOT)
+      DO 70 IFUEL=1,NFUEL
+      NTOT=NTOT+FTOT(IFUEL)
+   70 CONTINUE
+      IF(ITOT.NE.NTOT) THEN
+         WRITE(IOUT,'(/15H @RESIND: ITOT=,I8,6H NTOT=,I8)') ITOT,NTOT
+         CALL XABORT('@RESIND: FOUND DIFFERENT TOTAL NUMBER OF FUEL MI'
+     1   //'XTURES IN FUEL-MAP AND MATEX.')
+      ENDIF
+*     STORE NEGATIVE FUEL MIXTURES
+      CALL LCMLEN(IPMTX,'MAT',LENGT,ITYP)
+      ALLOCATE(IMAT(LENGT))
+      IMAT(:LENGT)=0
+      CALL LCMGET(IPMTX,'MAT',IMAT)
+      DO 100 IEL=1,LX*LY*LZ
+      IF(INDX(IEL).NE.0)IMAT(IEL)=-INDX(IEL)
+  100 CONTINUE
+      CALL LCMPUT(IPMTX,'MAT',LENGT,1,IMAT)
+      DEALLOCATE(IMAT)
+      RETURN
+      END
diff --git a/Donjon/src/RESINI.f b/Donjon/src/RESINI.f
new file mode 100644
index 0000000..9c76f3c
--- /dev/null
+++ b/Donjon/src/RESINI.f
@@ -0,0 +1,200 @@
+*DECK RESINI
+      SUBROUTINE RESINI(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Construct or modify a fuel-map object.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki and V. Descotes
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The RESINI: module specifications are:
+* Option 1
+* FLMAP MATEX := RESINI: MATEX [COMPO] :: (descresini1) ;
+* Option 2
+* FLMAP := RESINI: FLMAP [FLMAP2] :: (descresini2) ;
+* where
+*   FLMAP : name of the \emph{resini} object that will contain the fuel-lattice 
+*     information. If FLMAP appears on both LHS and RHS, it will be updated; 
+*     otherwise, it is created.
+* 
+*   MATEX : name of the \emph{matex} object specified in the modification mode. 
+*     MATEX is required only when FLMAP is created.
+*   COMPO : name of the \emph{multicompo} data structure (L\_COMPO signature) 
+*     where the detailed subregion geometry at assembly level is stored.
+*   FLMAP2 : name of the \emph{resini} object that contains the fuel-lattice 
+*     information to recover from.
+*   (descresini1) : structure describing the main input data to
+*     the RESINI: module. Note that this input data is mandatory and
+*     must be specified only when FLMAP is created.
+*   (descresini2) : structure describing the input data for global and local 
+*     parameters. This data is permitted to be modified in the subsequent calls 
+*     to the RESINI: module.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(NSTATE=40,IOUT=6)
+      CHARACTER TEXT*12,HSIGN*12,HSIGN2*12
+      INTEGER ISTATE(NSTATE),IGST(NSTATE)
+      LOGICAL LNEW,LCPO,LMAP2
+      TYPE(C_PTR) IPMTX,IPMAP,JPMAP,IPCPO,IPMP2
+*----
+*  PARAMETER VALIDATION
+*----
+      IF(NENTRY.GT.3)CALL XABORT('@RESINI: 2 or 3 PARAMETERS ALLOWED.')
+      LCPO=.FALSE.
+      IPCPO=C_NULL_PTR
+      IPMP2=C_NULL_PTR
+      IF(IENTRY(1).GT.2) CALL XABORT('@RESINI: INVALID FIRST PARAMETER'
+     1 //' TYPE.')
+      LNEW=.TRUE.
+      LMAP2=.FALSE.
+      HSIGN2=' '
+      IF(NENTRY.GE.2) CALL LCMGTC(KENTRY(2),'SIGNATURE',12,HSIGN2)
+      IF((NENTRY.EQ.1).OR.(HSIGN2.EQ.'L_MAP'))THEN
+        IF(JENTRY(1).NE.1) CALL XABORT('@RESINI: OBJECT IN MODIFICATIO'
+     1  //'N MODE EXPECTED.')
+        CALL LCMGTC(KENTRY(1),'SIGNATURE',12,HSIGN)
+        IF(HSIGN.NE.'L_MAP')THEN
+          TEXT=HENTRY(1)
+          CALL XABORT('@RESINI: SIGNATURE OF '//TEXT//' IS '//HSIGN//
+     1    '. L_MAP EXPECTED.')
+        ENDIF
+        IF(JENTRY(1).NE.1)CALL XABORT('@RESINI: MODIFICATION MODE EX'
+     1   //'PECTED FOR THE FUEL-MAP OBJECT.')
+        LNEW=.FALSE.
+        IF(HSIGN2.EQ.'L_MAP') THEN
+          LMAP2=.TRUE.
+          IPMP2=KENTRY(2)
+        ENDIF
+      ELSE
+        IF(HSIGN2.NE.'L_MATEX')THEN
+          TEXT=HENTRY(2)
+          CALL XABORT('@RESINI: SIGNATURE OF '//TEXT//' IS '//HSIGN2//
+     1    '. L_MATEX EXPECTED.')
+        ENDIF
+        IF(JENTRY(2).NE.1)CALL XABORT('@RESINI: MODIFICATION MODE EX'
+     1   //'PECTED FOR THE MATEX OBJECT.')
+        HSIGN='L_MAP'
+        CALL LCMPTC(KENTRY(1),'SIGNATURE',12,HSIGN)
+        IPMTX=KENTRY(2)
+        IF(NENTRY.EQ.3) THEN
+          LCPO=.TRUE.
+          CALL LCMGTC(KENTRY(3),'SIGNATURE',12,HSIGN)
+          IF(HSIGN.NE.'L_MULTICOMPO')THEN
+            TEXT=HENTRY(3)
+            CALL XABORT('@RESINI: SIGNATURE OF '//TEXT//' IS '//HSIGN//
+     1      '. L_MULTICOMPO EXPECTED.')
+          ENDIF
+          IPCPO=KENTRY(3)
+        ENDIF
+      ENDIF
+      IPMAP=KENTRY(1)
+*----
+*  RECOVER INFORMATION
+*----
+      IMPX=1
+      ISTATE(:NSTATE)=0
+      IF(LNEW)THEN
+        NPARM=0
+        CALL LCMGET(IPMTX,'STATE-VECTOR',ISTATE)
+        IGEO=ISTATE(6)
+        IF((IGEO.NE.7).AND.(IGEO.NE.9))CALL XABORT('@RESINI: ONLY'
+     1  //' 3D-CARTESIAN OR 3D-HEXAGONAL GEOMETRY ALLOWED.')
+        NGRP=ISTATE(1)
+        NFUEL=ISTATE(4)
+        LX=ISTATE(8)
+        LY=ISTATE(9)
+        LZ=ISTATE(10)
+*       MAIN INPUT
+        CALL RESDRV(IPMAP,IPMTX,NFUEL,LX,LY,LZ,IMPX,IGEO,NCH,NB,NTOT,
+     1  NCOMB,NSIMS,NASB,NAX,NAY,NIS,IPCPO)
+        ISTATE(:NSTATE)=0
+        ISTATE(1)=NB
+        ISTATE(2)=NCH
+        ISTATE(3)=NCOMB
+        ISTATE(4)=NGRP
+        ISTATE(12)=IGEO
+        ISTATE(7)=NFUEL
+        ISTATE(8)=NPARM
+        ISTATE(9)=NTOT
+        ISTATE(13)=NSIMS
+        ISTATE(14)=NASB
+        ISTATE(15)=NAX
+        ISTATE(16)=NAY
+        ISTATE(18)=NIS
+      ELSE
+        CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+        NB=ISTATE(1)
+        NCH=ISTATE(2)
+        NCOMB=ISTATE(3)
+        IGEO=ISTATE(12)
+        NFUEL=ISTATE(7)
+        NPARM=ISTATE(8)
+        NTOT=ISTATE(9)
+        NSIMS=ISTATE(13)
+        NASB=ISTATE(14)
+        NAX=ISTATE(15)
+        NAY=ISTATE(16)
+        NIS=ISTATE(18)
+      ENDIF
+      IGST(:NSTATE)=0
+      JPMAP=LCMGID(IPMAP,'GEOMAP')
+      CALL LCMGET(JPMAP,'STATE-VECTOR',IGST)
+      NX=IGST(3)
+      NY=IGST(4)
+      NZ=IGST(5)
+      IF(IGEO.EQ.9) NY=1
+*     INPUT OF PARAMETERS
+      CALL RESPAR(IPMAP,NCH,NB,NFUEL,NCOMB,NPARM,NX,NY,NZ,NSTATE,
+     1 ISTATE,IMPX,NASB,LMAP2,IPMP2)
+      CALL LCMPUT(IPMAP,'STATE-VECTOR',NSTATE,1,ISTATE)
+      IF(IMPX.GT.0)WRITE(IOUT,100) IMPX,(ISTATE(I),I=1,9),ISTATE(12),
+     1 ISTATE(13),ISTATE(18)
+      IF(IMPX.GT.5)CALL LCMLIB(IPMAP)
+      RETURN
+*
+  100 FORMAT(/8H OPTIONS/8H -------/
+     1 7H IMPX  ,I6,30H   (0=NO PRINT/1=SHORT/2=MORE)/
+     2 7H NB    ,I6,39H   (NUMBER OF FUEL BUNDLES PER CHANNEL)/
+     3 7H NCH   ,I6,28H   (NUMBER OF FUEL CHANNELS)/
+     4 7H NCOMB ,I6,31H   (NUMBER OF COMBUSTION ZONES)/
+     5 7H NGRP  ,I6,28H   (NUMBER OF ENERGY GROUPS)/
+     6 7H INTER ,I6,26H   (TYPE OF INTERPOLATION)/
+     7 7H ISHIFT,I6,28H   (NUMBER OF BUNDLE SHIFTS)/
+     8 7H NFUEL ,I6,25H   (NUMBER OF FUEL TYPES)/
+     9 7H NPARM ,I6,25H   (NUMBER OF PARAMETERS)/
+     1 7H NTOT  ,I6,33H   (TOTAL NUMBER OF FUEL BUNDLES)/
+     2 7H IGEO  ,I6,28H   (7=CARTESIAN/9=HEXAGONAL)/
+     3 7H NSIMS ,I6,35H   (ASSEMBLY LAYOUT IN SIM: MODULE)/
+     4 7H NIS   ,I6,38H   (NUMBER OF PARTICULARIZED ISOTOPES))
+      END
diff --git a/Donjon/src/RESPAR.f b/Donjon/src/RESPAR.f
new file mode 100644
index 0000000..e2abcdb
--- /dev/null
+++ b/Donjon/src/RESPAR.f
@@ -0,0 +1,772 @@
+*DECK RESPAR
+      SUBROUTINE RESPAR(IPMAP,NCH,NB,NFUEL,NCOMB,NPARM,NX,NY,NZ,NSTATE,
+     1 ISTATE,IMPX,NASB,LMAP2,IPMP2)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Read and store the data related to global and local parameters.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki, R. Chambon, M. Guyot, V. Descotes, B. Toueg
+*
+*Parameters: input/output
+* IPMAP   pointer to fuel-map information.
+* NCH     number of reactor channels.
+* NB      number of fuel bundles per channel.
+* NFUEL   number of fuel types.
+* NCOMB   number of combustion zones.
+* NX      number of elements along x-axis in fuel map.
+* NY      number of elements along y-axis in fuel map.
+* NZ      number of elements along z-axis in fuel map.
+* NSTATE  maximum number of state-vector records.
+* IMPX    printing index (=0 for no print).
+* NASB    total number of assembly
+* LMAP2   flag to set if second fuel-map information is used to
+*         recover burnup information
+* IPMP2   pointer to the second fuel-map information.
+*
+*Parameters: output
+* ISTATE  updated state-vector.
+* NPARM   total number of recorded parameters.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAP,IPMP2
+      INTEGER NCH,NB,NFUEL,NCOMB,NPARM,NX,NY,NZ,NSTATE,ISTATE(NSTATE),
+     1 IMPX
+      LOGICAL LMAP2
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(IOUT=6)
+      INTEGER INAME(3),IZONE(NCH),IVECT(NCOMB,NB),NSCH(NCH),
+     1 IBSH(NCOMB),IPAT(NCOMB),SHPAT(NCOMB),SHDIR(NCOMB),MIX(NX*NY*NZ),
+     2 FMIX(NCH,NB),IAZ(NCH),ISTAT2(NSTATE),SHREF,DIRREF(NCOMB)
+      REAL VALUE(NCH,NB),POWER(NCH,NB),FPOWER(NB)
+      CHARACTER CVALUE(NCH,NB)*12
+      DOUBLE PRECISION DFLOT
+      CHARACTER TEXT*12,TEXT12*12,PNAME*12,KEYN*12,PNAME2*12
+      LOGICAL LRSCH,LBURN
+      TYPE(C_PTR) JPMAP,KPMAP,ZPMAP,JPMP2,KPMP2
+*----
+*  ALLOCATABLE STATEMENTS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: ALCH,NUM,IND,VPAT
+      REAL, ALLOCATABLE, DIMENSION(:) :: DENSMOD,BRN,BASS,VAL2,ZZ,VB
+*----
+*  READ INPUT DATA
+*----
+      LRSCH=.FALSE.
+      LBURN=.FALSE.
+      PTOT=0.0
+      CALL LCMGET(IPMAP,'FLMIX',FMIX)
+   10 CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('@RESPAR: CHARACT'
+     1 //'ER DATA EXPECTED ('//TEXT12//').')
+      IF(TEXT12.EQ.';')THEN
+        GOTO 500
+*     PRINTING INDEX
+      ELSEIF(TEXT12.EQ.'EDIT')THEN
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@RESPAR: INTEGER DA'
+     1   //'TA FOR EDIT EXPECTED.')
+        IMPX=MAX(0,NITMA)
+*----
+*  ADD NEW PARAMETER
+*----
+      ELSEIF(TEXT12.EQ.'ADD-PARAM')THEN
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(TEXT.NE.'PNAME')CALL XABORT('@RESPAR: KEY'
+     1   //'WORD PNAME EXPECTED.')
+*       READ PARAMETER NAME
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@RESPAR: CHARACTER'
+     1   //' DATA FOR PARAMETER NAME EXPECTED.')
+        IF(IMPX.GT.0)WRITE(IOUT,1000)TEXT
+        IF(NPARM.GT.0)THEN
+          JPMAP=LCMGID(IPMAP,'PARAM')
+          DO IPAR=1,NPARM
+            KPMAP=LCMGIL(JPMAP,IPAR)
+            CALL LCMGET(KPMAP,'P-NAME',INAME)
+            WRITE(PNAME,'(3A4)') (INAME(I),I=1,3)
+            IF(PNAME.EQ.TEXT)CALL XABORT('@RESPAR: THE '
+     1       //'PARAMETER '//TEXT//' ALREADY EXISTS.')
+          ENDDO
+        ENDIF
+        NPARM=NPARM+1
+        JPMAP=LCMLID(IPMAP,'PARAM',NPARM)
+        KPMAP=LCMDIL(JPMAP,NPARM)
+        READ(TEXT,'(3A4)') (INAME(I),I=1,3)
+        CALL LCMPUT(KPMAP,'P-NAME',3,3,INAME)
+*       READ PARKEY NAME
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(TEXT.NE.'PARKEY')CALL XABORT('@RESPAR: KEY'
+     1   //'WORD PARKEY EXPECTED.')
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@RESPAR: CHARACTER'
+     1   //' DATA FOR PARKEY NAME EXPECTED.')
+        READ(TEXT,'(3A4)') (INAME(I),I=1,3)
+        CALL LCMPUT(KPMAP,'PARKEY',3,3,INAME)
+*       READ PARAMETER TYPE
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(TEXT.EQ.'GLOBAL')THEN
+          IPTYP=1
+        ELSEIF(TEXT.EQ.'LOCAL')THEN
+          IPTYP=2
+        ELSE
+          CALL XABORT('@RESPAR: INVALID KEYWORD '//TEXT)
+        ENDIF
+        CALL LCMPUT(KPMAP,'P-TYPE',1,1,IPTYP)
+        ISTATE(8)=NPARM
+*----
+*  SET PARAMETER VALUES
+*----
+      ELSEIF(TEXT12.EQ.'SET-PARAM')THEN
+        IF(NPARM.EQ.0)CALL XABORT('@RESPAR: PARAM'
+     1   //'ETER NOT YET DEFINED NPARM=0')
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@RESPAR: CHARACT'
+     1   //'ER DATA FOR PARAMETER NAME EXPECTED.')
+*       RECOVER PARAMETER
+        JPMAP=LCMGID(IPMAP,'PARAM')
+        DO IPAR=1,NPARM
+          KPMAP=LCMGIL(JPMAP,IPAR)
+          CALL LCMGET(KPMAP,'P-NAME',INAME)
+          WRITE(PNAME,'(3A4)') (INAME(I),I=1,3)
+          IF(PNAME.EQ.TEXT)THEN
+            CALL LCMGET(KPMAP,'P-TYPE',IPTYP)
+            GOTO 30
+          ENDIF
+        ENDDO
+        CALL XABORT('@RESPAR: UNABLE TO FIND PARAME'
+     1   //'TER WITH PNAME '//TEXT)
+   20   IF(IMPX.GT.0)WRITE(IOUT,1001)TEXT
+   30   IF(IPTYP.EQ.1)THEN
+*         GLOBAL PARAMETER
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+          IF((ITYP.EQ.3).AND.(TEXT.EQ.'OLDMAP')) THEN
+            IPTYP=11
+            GOTO 20
+          ENDIF
+          IF(ITYP.NE.2)CALL XABORT('@RESPAR: REAL'
+     1     //' DATA or OLDMAP keyword FOR VALUE EXPECTED.')
+          CALL LCMPUT(KPMAP,'P-VALUE',1,2,FLOT)
+        ELSE
+*         LOCAL PARAMETER
+          VALUE(:NCH,:NB)=0.0
+          IF(IPTYP.NE.11) CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+          IF(TEXT.EQ.'SAME')THEN
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+            DO ICH=1,NCH
+              DO IB=1,NB
+                IF(FMIX(ICH,IB).NE.0) THEN
+                  IF(ITYP.EQ.2)VALUE(ICH,IB)=FLOT
+                  IF(ITYP.EQ.3)CVALUE(ICH,IB)=TEXT
+                ENDIF
+              ENDDO
+            ENDDO
+*
+          ELSEIF(TEXT.EQ.'CHAN')THEN
+            DO ICH=1,NCH
+              CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+              IF(ITYP.NE.2)CALL XABORT('@RESPAR: REAL'
+     1         //' DATA FOR VALUE EXPECTED.')
+              DO 40 IB=1,NB
+              IF(FMIX(ICH,IB).NE.0) VALUE(ICH,IB)=FLOT
+   40         CONTINUE
+            ENDDO
+*
+          ELSEIF(TEXT.EQ.'BUND')THEN
+            DO 55 IB=1,NB
+            DO 50 ICH=1,NCH
+              IF(FMIX(ICH,IB).EQ.0) GO TO 50
+              CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+              IF(ITYP.EQ.2)VALUE(ICH,IB)=FLOT
+              IF(ITYP.EQ.3)CVALUE(ICH,IB)=TEXT
+   50       CONTINUE
+   55       CONTINUE
+          ELSEIF(TEXT.EQ.'TIMES')THEN
+! try to find the parameters called DMOD
+            CALL REDGET(ITYP,NITMA,FLOT,KEYN,DFLOT)
+            IF(ITYP.NE.3)CALL XABORT('@RESPAR: CHARACTER'
+     1       //' DATA FOR VALUE EXPECTED.')
+            JPMAP=LCMGID(IPMAP,'PARAM')
+            DO IPAR=1,NPARM
+              ZPMAP=LCMGIL(JPMAP,IPAR)
+              CALL LCMGET(ZPMAP,'P-NAME',INAME)
+              WRITE(PNAME,'(3A4)') (INAME(I),I=1,3)
+              IF(PNAME.EQ.KEYN)THEN
+                CALL LCMGET(ZPMAP,'P-TYPE',IPTYP)
+                GOTO 60
+              ENDIF
+            ENDDO
+            CALL XABORT('@RESPAR: UNABLE TO FIND PARAME'
+     1        //'TER WITH PNAME '//KEYN)
+   60       CONTINUE
+            ALLOCATE(DENSMOD(NCH*NB))
+            CALL LCMGET(ZPMAP,'P-VALUE',DENSMOD)
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+            IF(ITYP.NE.3.OR.TEXT.NE.'SAME')CALL XABORT('@RESPAR:'
+     1       //' KEYWORD SAME EXPECTED.')
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+            IF(ITYP.NE.2) CALL XABORT('@RESPAR: REAL DATA EXPECTED.')
+            DO IB=1,NB
+              DO ICH=1,NCH
+                IF(FMIX(ICH,IB).NE.0) THEN
+                  VALUE(ICH,IB)=FLOT*DENSMOD(ICH+(IB-1)*NCH)
+                ENDIF
+              ENDDO
+            ENDDO
+            DEALLOCATE(DENSMOD)
+*  R. Chambon - begin
+          ELSEIF(TEXT.EQ.'OLDMAP')THEN
+            IF(.NOT.LMAP2) CALL XABORT('@RESPAR: SECOND'
+     1        //' L_MAP EXPECTED.')
+            CALL LCMGET(IPMP2,'STATE-VECTOR',ISTAT2)
+            NPARM2=ISTAT2(8)
+            JPMP2=LCMGID(IPMP2,'PARAM')
+            DO IPAR=1,NPARM2
+              KPMP2=LCMGIL(JPMP2,IPAR)
+              CALL LCMGET(KPMP2,'P-NAME',INAME)
+              WRITE(PNAME2,'(3A4)') (INAME(I),I=1,3)
+              IF(PNAME.EQ.PNAME2)THEN
+                GOTO 70
+              ENDIF
+            ENDDO
+            CALL XABORT('@RESPAR: UNABLE TO FIND PARAME'
+     1       //'TER WITH PNAME in second L_MAP '//TEXT)
+   70       CALL LCMLEN(KPMP2,'P-VALUE',NITMA,INDIC)
+            IF(NITMA.EQ.0) CALL XABORT('@RESPAR: Record BURN-INST in '
+     1        //'SECOND L_MAP EXPECTED.')
+            ALLOCATE(VAL2(NITMA))
+            CALL LCMGET(KPMP2,'P-VALUE',VAL2)
+*         global parameter
+            IF(NITMA.EQ.1) THEN
+              VALUE(1,1)=VAL2(1)
+*         recovered from previous calculation with the same geometry
+*         but not the same initialization part
+*         example: homogeneous calculation followed by a pin power
+*         reconstruction
+            ELSEIF(NITMA.EQ.NCH*NB) THEN
+              DO ICH=1,NCH
+                DO IB=1,NB
+                  I=ICH+(IB-1)*NCH
+                  VALUE(ICH,IB)=VAL2(I)
+                ENDDO
+              ENDDO
+*         recovered from previous calculation with a different geometry
+*         the second geometry must correspond to the assembly geometry
+*         of the new geometry
+*         examples: homogeneous calculation followed by a heterogeneous
+*                   calculation
+*                   homogeneous calculation followed by a pin power
+*                   calculation
+            ELSEIF(NITMA.EQ.NASB*NB) THEN
+              CALL LCMGET(IPMAP,'A-ZONE',IAZ)
+              DO ICH=1,NCH
+                DO IB=1,NB
+                  VALUE(ICH,IB)=VAL2(IAZ(ICH)+(IB-1)*NCH)
+                ENDDO
+              ENDDO
+            ENDIF
+            DEALLOCATE(VAL2)
+*  R. Chambon - End
+          ELSEIF(TEXT.EQ.'LEVEL')THEN
+*           move a control rod over each channel
+            ITOP=1
+   75       CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+            IF(ITYP.NE.3)CALL XABORT('@RESPAR: CHARACTER DATA H+, H-,'
+     1       //'SAME OR CHAN EXPECTED.')
+            IF(TEXT.EQ.'H+')THEN
+*             PWR-type moving rod
+              ITOP=1
+              GO TO 75
+            ELSEIF(TEXT.EQ.'H-')THEN
+*             BWR-type moving rod
+              ITOP=-1
+              GO TO 75
+            ELSEIF(TEXT.EQ.'SAME') THEN
+              CALL REDGET(ITYP,NITMA,ZLEVEL,TEXT,DFLOT)
+              IF(ITYP.NE.2) CALL XABORT('@RESPAR: REAL DATA EXPECTED.')
+            ENDIF
+            JPMAP=LCMGID(IPMAP,'GEOMAP')
+            CALL LCMGET(JPMAP,'STATE-VECTOR',ISTAT2)
+            NX=ISTAT2(3)
+            NY=ISTAT2(4)
+            NZ=ISTAT2(5)
+            NEL=ISTAT2(6)
+            IF((ISTAT2(1).EQ.9).AND.(NY.EQ.0)) NY=1
+            ALLOCATE(ZZ(NZ+1),NUM(NEL),IND(NZ),VB(NB))
+            CALL LCMGET(JPMAP,'MESHZ',ZZ)
+            CALL LCMGET(IPMAP,'BMIX',NUM)
+            ICH=0
+            DO 105 IY=1,NY
+            DO 100 IX=1,NX
+            IEL=(IY-1)*NX+IX
+            DO 80 IZ=1,NZ
+            IF(NUM((IZ-1)*NX*NY+IEL).NE.0) GO TO 90
+   80       CONTINUE
+            GO TO 100
+   90       ICH=ICH+1
+            IF(TEXT.EQ.'CHAN') THEN
+              CALL REDGET(ITYP,NITMA,ZLEVEL,TEXT,DFLOT)
+              IF(ITYP.NE.2) CALL XABORT('@RESPAR: REAL DATA EXPECTED.')
+            ENDIF
+            IF((ZLEVEL.LT.0.0).OR.(ZLEVEL.GT.1.0)) THEN
+              CALL XABORT('@RESPAR: 0<=LEVEL<=1 EXPECTED.')
+            ENDIF
+            IB=0
+            DO IZ=1,NZ
+              IND(IZ)=0
+              IF(NUM((IZ-1)*NX*NY+IEL).EQ.0) CYCLE
+              IB=IB+1
+              IND(IZ)=IB
+            ENDDO
+            IF(IB.NE.NB) CALL XABORT('@RESPAR: INVALID NUMBER OF BUNDL'
+     1      //'ES.')
+            CALL RESROD(NB,NZ,ZZ,IND,ZLEVEL,ITOP,VB)
+            DO IB=1,NB
+              IF(FMIX(ICH,IB).NE.0) VALUE(ICH,IB)=VB(IB)
+            ENDDO
+  100       CONTINUE
+  105       CONTINUE
+            IF(ICH.NE.NCH) CALL XABORT('@RESPAR: INVALID NUMBER OF CHA'
+     1      //'NNELS.')
+            DEALLOCATE(VB,IND,NUM,ZZ)
+          ELSE
+            CALL XABORT('@RESPAR: INVALID KEYWORD '//TEXT)
+          ENDIF
+          IF(ITYP.EQ.2)CALL LCMPUT(KPMAP,'P-VALUE',NCH*NB,2,VALUE)
+          IF(ITYP.EQ.3)CALL LCMPTC(KPMAP,'P-VALUE',12,NCH*NB,CVALUE)
+          IF(ITYP.EQ.11)CALL LCMPUT(KPMAP,'P-VALUE',1,2,VALUE(1,1))
+        ENDIF
+*----
+*  CHANNEL REFUELLING SCHEMES
+*----
+      ELSEIF(TEXT12.EQ.'REF-SHIFT')THEN
+        IF(IMPX.GT.0)WRITE(IOUT,1002)
+*       BUNDLE-SHIFT NUMBERS, BIDIRECTIONAL 
+        IBSH(:NCOMB)=0
+        DIRREF(:NCOMB)=-1
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.EQ.1)THEN
+          IF(NITMA.LE.0.OR.NITMA.GT.NB)CALL XABORT('@RESPAR:'
+     1     //' BUNDLE-SHIFT MUST BE POSITIVE AND NON-ZERO NUMBER'
+     1     //' AND MAX EQUAL TO NUMBER OF FUEL BUNDLES PER CHANNEL')
+          DO 110 ICZ=1,NCOMB
+          IBSH(ICZ)=NITMA
+  110     CONTINUE
+        ELSEIF((ITYP.EQ.3).AND.(TEXT.EQ.'COMB'))THEN
+          DO ICZ=1,NCOMB
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+            IF(ITYP.NE.1)CALL XABORT('@RESPAR: INTEGER BUNDLE'
+     1      //'-SHIFT NUMBER PER COMBUSTION-ZONE EXPECTED.')
+            IF(NITMA.LE.0.OR.NITMA.GT.NB)CALL XABORT('@RESPAR:'
+     1      //' BUNDLE-SHIFT MUST BE POSITIVE AND NON-ZERO NUMBER.'
+     1      //' AND MAX EQUAL TO NUMBER OF FUEL BUNDLES PER CHANNEL')
+            IBSH(ICZ)=NITMA
+          ENDDO
+* I. Trancart begin
+        ELSEIF((ITYP.EQ.3).AND.(TEXT.EQ.'SHUFF'))THEN
+          IPAT(:NCOMB)=0
+          MPAT=0
+          DO ICZ=1,NCOMB
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+            IF(ITYP.NE.1)CALL XABORT('@RESPAR: INTEGER SHUFFLING'
+     1      //' PATTERN INDEX PER COMBUSTION-ZONE EXPECTED.')
+            IF(NITMA.LE.0.OR.NITMA.GT.NCOMB)CALL XABORT('@RESPAR:'
+     1      //' SHUFFLING PATTERN INDEX MUST BE POSITIVE AND NON-ZERO '
+     1      //'NUMBER AND MAX EQUAL TO NUMBER OF COMBUSTION ZONES.')
+            IPAT(ICZ)=NITMA
+            IF(NITMA.GT.MPAT)THEN
+              MPAT=NITMA
+            ENDIF
+          ENDDO
+          IF(IMPX.GT.0)WRITE(IOUT,1010)MPAT
+          ALLOCATE(VPAT(MPAT*NB))
+          SHPAT(:MPAT)=0
+          SHDIR(:MPAT)=0
+          DO ICP=1,MPAT
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+            IF(ITYP.NE.3)CALL XABORT('@RESPAR: CHARACTER PATTERN'
+     1      //' EXPECTED ('//TEXT12//'). NOT ENOUGH PATTERN ADDED '
+     2      //' OR MISSING BUNDLES ON PREVIOUS PATTERN.')
+            IF(TEXT12.NE.'PATTERN')CALL XABORT('@RESPAR: KEYWORD PAT'
+     1      //'TERN EXPECTED ('//TEXT12//').')
+            SHREF=0
+            DO IREF=1,NB
+              CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+              IF(ITYP.NE.1)CALL XABORT('@RESPAR: INTEGER DATA '
+     1        //' EXPECTED FOR SHUFFLING.')
+              IF(NITMA.LT.0.OR.NITMA.GT.NB)CALL XABORT('@RESPAR: '
+     1        //' WRONG REFUELLING POSITION FOR BUNDLE SHUFFLING. ')
+              VPAT((ICP-1)*NB+IREF)=NITMA
+              IF(NITMA.EQ.0)THEN
+                SHREF=SHREF+1
+              ENDIF
+            ENDDO
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+            IF(ITYP.NE.3)CALL XABORT('@RESPAR: CHARACTER DATA '
+     1      //' EXPECTED FOR COOLANT FLOW.')
+            IF(TEXT12.EQ.'UNIDIR')THEN
+              SHDIR(ICP)=1
+              IF(IMPX.GT.1)WRITE(IOUT,1009)
+            ELSEIF(TEXT12.EQ.'BIDIR')THEN
+              SHDIR(ICP)=-1
+            ELSE
+              CALL XABORT('@RESPAR: UNIDIR OR BIDIR INFORMATION'
+     1        //' EXPECTED FOR COOLANT FLOW.')
+            ENDIF 
+            SHPAT(ICP)=SHREF
+          ENDDO
+          IVECT(:NCOMB,:NB)=0
+          IBSH(:NCOMB)=0
+          DO IB=1,NB
+          DO ICZ=1,NCOMB
+          IVECT(ICZ,IB)=VPAT((IPAT(ICZ)-1)*NB+IB)
+          IBSH(ICZ)=SHPAT(IPAT(ICZ))
+          DIRREF(ICZ)=SHDIR(IPAT(ICZ))
+          ENDDO
+          ENDDO
+          DEALLOCATE(VPAT)
+          GO TO 125
+* I. Trancart end
+        ELSE
+          CALL XABORT('@RESPAR: INVALID INPUT FOR REF-SHIFT.')
+        ENDIF
+*       REFUELLING VECTOR
+        IVECT(:NCOMB,:NB)=0
+        DO 120 ICZ=1,NCOMB
+        ISHIFT=IBSH(ICZ)
+        IF(ISHIFT.EQ.NB)GOTO 120
+        NREF=NB-ISHIFT
+        DO IREF=1,NREF
+          IPOS=ISHIFT+IREF
+          IVECT(ICZ,IPOS)=IREF
+        ENDDO
+  120   CONTINUE
+  125   CALL LCMPUT(IPMAP,'REF-SHIFT',NCOMB,1,IBSH)
+        CALL LCMPUT(IPMAP,'REF-VECTOR',NCOMB*NB,1,IVECT)
+*       CHANNEL REFUELLING SCHEMES
+        CALL LCMGET(IPMAP,'B-ZONE',IZONE)
+        CALL LCMGET(IPMAP,'BMIX',MIX)
+        NSCH(:NCH)=0
+        IEL=0
+        ICH=0
+        DO 135 IY=1,NY
+        DO 130 IX=1,NX
+        IEL=IEL+1
+        IF(MIX(IEL).EQ.0)GOTO 130
+        ICH=ICH+1
+        ISHIFT=IBSH(IZONE(ICH))
+        NSCH(ICH)=((DIRREF(IZONE(ICH)))**(IEL+IY-1))*ISHIFT
+  130   CONTINUE
+  135   CONTINUE
+        CALL LCMPUT(IPMAP,'REF-SCHEME',NCH,1,NSCH)
+        LRSCH=.TRUE.
+*----
+*  BURNUP INTERPOLATION TYPE
+*----
+      ELSEIF(TEXT12.EQ.'BTYPE')THEN
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@RESPAR: BURN'
+     1   //'UP INTERPOLATION OPTION EXPECTED.')
+        IBTYP=0
+        IF(TEXT.EQ.'TIMAV-BURN')THEN
+          IBTYP=1
+        ELSEIF(TEXT.EQ.'INST-BURN')THEN
+          IBTYP=2
+        ELSE
+          CALL XABORT('@RESPAR: INVALID INPUT FOR BTYPE.')
+        ENDIF
+        ISTATE(5)=IBTYP
+*----
+*  AVERAGE EXIT BURNUPS
+*----
+      ELSEIF(TEXT12.EQ.'TIMAV-BVAL')THEN
+        IF(IMPX.GT.0)WRITE(IOUT,1003)
+        ALLOCATE(BRN(NCOMB))
+        BRN(:NCOMB)=0.0
+        DO ICZ=1,NCOMB
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+          IF(ITYP.NE.2)CALL XABORT('@RESPAR: REAL DATA'
+     1     //' FOR BURNUP VALUE EXPECTED(1).')
+          IF(FLOT.LE.0.)CALL XABORT('@RESPAR: INVALID'
+     1     //' DATA FOR AVERAGE BURNUP VALUE =0.')
+          BRN(ICZ)=FLOT
+        ENDDO
+        CALL LCMPUT(IPMAP,'BURN-AVG',NCOMB,2,BRN)
+        DEALLOCATE(BRN)
+        LBURN=.TRUE.
+*----
+*  INSTANTANEOUS BURNUPS
+*----
+      ELSEIF(TEXT12.EQ.'INST-BVAL')THEN
+        IF(IMPX.GT.0)WRITE(IOUT,1004)
+        VALUE(:NCH,:NB)=0.0
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@RESPAR: KEYWORD'
+     1   //' SAME|CHAN|BUND EXPECTED (1).')
+        IF(TEXT.EQ.'BUND')THEN
+          DO IB=1,NB
+            DO ICH=1,NCH
+              IF(FMIX(ICH,IB).NE.0) THEN
+                CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+                IF(ITYP.NE.2)CALL XABORT('@RESPAR: REAL DATA'
+     1            //' FOR BURNUP VALUE EXPECTED(2).')
+                IF(FLOT.LT.0.)CALL XABORT('@RESPAR: INVALID DA'
+     1            //'TA FOR BURNUP VALUE <0.')
+                VALUE(ICH,IB)=FLOT
+              ENDIF
+            ENDDO
+          ENDDO
+        ELSEIF(TEXT.EQ.'CHAN')THEN
+          DO ICH=1,NCH
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+            IF(ITYP.NE.2)CALL XABORT('@RESPAR: REAL DATA'
+     1        //' FOR BURNUP VALUE EXPECTED(2).')
+            IF(FLOT.LT.0.)CALL XABORT('@RESPAR: INVALID DA'
+     1        //'TA FOR BURNUP VALUE <0.')
+            DO IB=1,NB
+              IF(FMIX(ICH,IB).NE.0) VALUE(ICH,IB)=FLOT
+            ENDDO
+          ENDDO
+        ELSEIF(TEXT.EQ.'ASBL')THEN
+          IF(NASB.EQ.0)CALL XABORT('@RESPAR: ASSEMBLY'
+     1        //' NOT DEFINED.')
+          ALLOCATE(BASS(NASB))
+          DO IASS=1,NASB
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+            IF(ITYP.NE.2)CALL XABORT('@RESPAR: REAL DATA'
+     1        //' FOR BURNUP VALUE EXPECTED(2).')
+            IF(FLOT.LT.0.)CALL XABORT('@RESPAR: INVALID DA'
+     1        //'TA FOR BURNUP VALUE <0.')
+            BASS(IASS)=FLOT
+          ENDDO
+          CALL LCMGET(IPMAP,'A-ZONE',IAZ)
+          DO ICH=1,NCH
+            DO IB=1,NB
+              VALUE(ICH,IB)=BASS(IAZ(ICH))
+            ENDDO
+          ENDDO
+          DEALLOCATE(BASS)
+        ELSEIF(TEXT.EQ.'SAME')THEN
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+          IF(ITYP.NE.2)CALL XABORT('@RESPAR: REAL DATA'
+     1      //' FOR BURNUP VALUE EXPECTED(2).')
+          IF(FLOT.LT.0.)CALL XABORT('@RESPAR: INVALID DA'
+     1      //'TA FOR BURNUP VALUE <0.')
+          DO ICH=1,NCH
+            DO IB=1,NB
+              IF(FMIX(ICH,IB).NE.0) VALUE(ICH,IB)=FLOT
+            ENDDO
+          ENDDO
+*  R. Chambon - begin
+        ELSEIF(TEXT.EQ.'OLDMAP')THEN
+          IF(.NOT.LMAP2) CALL XABORT('@RESPAR: SECOND'
+     1      //' L_MAP EXPECTED.')
+          CALL LCMLEN(IPMP2,'BURN-INST',NITMA,INDIC)
+          IF(NITMA.EQ.0) CALL XABORT('@RESPAR: Record BURN-INST in '
+     1      //'SECOND L_MAP EXPECTED.')
+          ALLOCATE(VAL2(NITMA))
+          CALL LCMGET(IPMP2,'BURN-INST',VAL2)
+*         recovered from previous calculation with the same geometry but
+*         not the same initialization part
+*         example: homogeneous calculation followed by a pin power
+*         reconstruction
+          IF(NITMA.EQ.NCH*NB) THEN
+            DO ICH=1,NCH
+              DO IB=1,NB
+                I=ICH+(IB-1)*NCH
+                VALUE(ICH,IB)=VAL2(I)
+              ENDDO
+            ENDDO
+*         recovered from previous calculation with a different geometry
+*         the second geometry must correspond to the assembly geometry
+*         of the new geometry
+*         examples: homogeneous calculation followed by a heterogeneous
+*                   calculation
+*                   homogeneous calculation followed by a pin power
+*                   calculation
+          ELSEIF(NITMA.EQ.NASB*NB) THEN
+            CALL LCMGET(IPMAP,'A-ZONE',IAZ)
+            DO ICH=1,NCH
+              DO IB=1,NB
+                VALUE(ICH,IB)=VAL2(IAZ(ICH)+(IB-1)*NCH)
+              ENDDO
+            ENDDO
+          ENDIF
+          DEALLOCATE(VAL2)
+*  R. Chambon - End
+        ELSEIF(TEXT.EQ.'SMOOTH')THEN
+* EACH 'BURN-INST' WILL HAVE THE SAME BURNUP AS THEIR FIRST INDEX IN 'FLMIX'
+          CALL LCMGET(IPMAP,'BURN-INST',VALUE)
+          DO ICH=1,NCH
+            DO IB=1,NB
+              JBKEEP=0
+              DO JCH=1,NCH
+                DO JB=1,NB
+* FIRST INDEX OF FMIX(ICH,IB) IS AT JCH,JB
+                  JBKEEP=JB
+                  IF(FMIX(ICH,IB).EQ.FMIX(JCH,JB)) GOTO 140
+                ENDDO
+              ENDDO
+              CALL XABORT('@RESPAR: ASSERTION ERROR (NO FIRST INDEX)')
+  140         VALUE(ICH,IB)=VALUE(JCH,JBKEEP)
+            ENDDO
+          ENDDO
+        ELSE
+          CALL XABORT('@RESPAR: KEYWORD'
+     1      //' SAME|CHAN|BUND|ASBL|OLDMAP|SMOOTH EXPECTED (2).')
+        ENDIF
+        CALL LCMPUT(IPMAP,'BURN-INST',NCH*NB,2,VALUE)
+*----
+*  BUNDLE POWERS IN KW
+*----
+      ELSEIF(TEXT12.EQ.'BUNDLE-POW')THEN
+        IF(IMPX.GT.0)WRITE(IOUT,1006)
+        POWER(:NCH,:NB)=0.0
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@RESPAR: KEYWORD'
+     1   //' BUND|CHAN|SAME EXPECTED (3).')
+        IF(TEXT.EQ.'BUND')THEN
+          DO IB=1,NB
+            DO ICH=1,NCH
+              IF(FMIX(ICH,IB).NE.0) THEN
+                CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+                IF(ITYP.NE.2)CALL XABORT('@RESPAR: REAL DATA'
+     1            //' FOR POWER VALUE EXPECTED(1).')
+                IF(FLOT.LT.0.)CALL XABORT('@RESPAR: INVALID DA'
+     1            //'TA FOR POWER VALUE <0.')
+                POWER(ICH,IB)=FLOT
+              ENDIF
+            ENDDO
+          ENDDO
+        ELSEIF(TEXT.EQ.'CHAN')THEN
+          DO ICH=1,NCH
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+            IF(ITYP.NE.2)CALL XABORT('@RESPAR: REAL DATA'
+     1        //' FOR POWER VALUE EXPECTED(2).')
+            IF(FLOT.LT.0.)CALL XABORT('@RESPAR: INVALID DA'
+     1        //'TA FOR POWER VALUE <0.')
+            DO IB=1,NB
+              IF(FMIX(ICH,IB).NE.0) POWER(ICH,IB)=FLOT
+            ENDDO
+          ENDDO
+        ELSEIF(TEXT.EQ.'SAME')THEN
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+          IF(ITYP.NE.2)CALL XABORT('@RESPAR: REAL DATA'
+     1      //' FOR BURNUP VALUE EXPECTED(2).')
+          IF(FLOT.LT.0.)CALL XABORT('@RESPAR: INVALID DA'
+     1      //'TA FOR POWER VALUE <0.')
+          DO ICH=1,NCH
+            DO IB=1,NB
+              IF(FMIX(ICH,IB).NE.0) POWER(ICH,IB)=FLOT
+            ENDDO
+          ENDDO
+        ELSE
+          CALL XABORT('@RESPAR: KEYWORD SAME|CHAN|BUND EXPECTED (4).')
+        ENDIF
+        CALL LCMPUT(IPMAP,'BUND-PW',NCH*NB,2,POWER)
+        PTOT=0.0
+        DO ICH=1,NCH
+          DO IB=1,NB
+            PTOT=PTOT+POWER(ICH,IB)
+          ENDDO
+        ENDDO
+        PTOT=PTOT/1.0E3
+        CALL LCMPUT(IPMAP,'REACTOR-PW',1,2,PTOT)
+*----
+*  AXIAL POWERS FORM FACTORS
+*----
+      ELSEIF(TEXT12.EQ.'AXIAL-PFORM')THEN
+        IF(IMPX.GT.0)WRITE(IOUT,1007)
+        IF(PTOT.EQ.0.0)CALL XABORT('@RESPAR: FULL REACTOR POWER NOT S'
+     1  //'ET.')
+        FPOWER(:NB)=0.0
+        DO IB=1,NB
+          CALL REDGET(ITYP,NITMA,FPOWER(IB),TEXT,DFLOT)
+          IF(ITYP.NE.2)CALL XABORT('@RESPAR: REAL DATA FOR POWERS FOR'
+     1      //'M FACTORS VALUE EXPECTED.')
+          IF(FPOWER(IB).LT.0.)CALL XABORT('@RESPAR: INVALID DATA FOR '
+     1      //'POWERS FORM FACTORS VALUE <0.')
+        ENDDO
+        CALL LCMPUT(IPMAP,'AXIAL-FPW',NB,2,FPOWER)
+        DSUM=0.0
+        DO IB=1,NB
+          DSUM=DSUM+FPOWER(IB)
+        ENDDO
+        DO ICH=1,NCH
+          DO IB=1,NB
+            POWER(ICH,IB)=FPOWER(IB)*PTOT*1.0E3/(DSUM*REAL(NCH))
+          ENDDO
+        ENDDO
+        CALL LCMPUT(IPMAP,'BUND-PW',NCH*NB,2,POWER)
+*----
+*  FULL REACTOR POWER IN MW
+*----
+      ELSEIF(TEXT12.EQ.'REACTOR-POW')THEN
+        IF(IMPX.GT.0)WRITE(IOUT,1008)
+        CALL REDGET(ITYP,NITMA,PTOT,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@RESPAR: REAL DATA'
+     1    //' FOR FULL REACTOR POWER VALUE EXPECTED.')
+        IF(PTOT.LT.0.)CALL XABORT('@RESPAR: INVALID DA'
+     1    //'TA FOR FULL REACTOR POWER VALUE <0.')
+        CALL LCMPUT(IPMAP,'REACTOR-PW',1,2,PTOT)
+*----
+*  FUEL-TYPE DATA
+*----
+      ELSEIF(TEXT12.EQ.'FUEL')THEN
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@RESPAR: KEYWO'
+     1   //'RD FOR FUEL-TYPE PARAMETER EXPECTED.')
+        IF((TEXT.NE.'WEIGHT').AND.(TEXT.NE.'ENRICH').AND.
+     1   (TEXT.NE.'POISON'))CALL XABORT('@RESPAR: INVAL'
+     2   //'ID INPUT FOR FUEL.')
+        IF(IMPX.GT.0)WRITE(IOUT,1005)TEXT
+        JPMAP=LCMLID(IPMAP,'FUEL',NFUEL)
+        DO IFUEL=1,NFUEL
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+          IF(ITYP.NE.2)CALL XABORT('@RESPAR: REAL'
+     1     //' DATA PER EACH FUEL-TYPE EXPECTED.')
+          KPMAP=LCMDIL(JPMAP,IFUEL)
+          CALL LCMPUT(KPMAP,TEXT,1,2,FLOT)
+          IF(IMPX.GT.0)CALL LCMLIB(KPMAP)
+        ENDDO
+      ELSEIF(TEXT12.EQ.'CELL')THEN
+        ALLOCATE(ALCH(NCH))
+        DO 150 I=1,NCH
+          CALL REDGET(INDIC,ALCH(I),FLOTT,TEXT12,DFLOT)
+          IF(INDIC.NE.1) CALL XABORT('@RESPAR: INTEGER DATA EXPECTED.')
+  150   CONTINUE
+        CALL RESCEL(IPMAP,NCH,NB,ALCH)
+        DEALLOCATE(ALCH)
+        ISTATE(5)=2
+      ELSE
+        CALL XABORT('@RESPAR: WRONG KEYWORD '//TEXT12)
+      ENDIF
+      GOTO 10
+  500 IF(LRSCH.OR.LBURN)CALL RESBRN(IPMAP,NCH,NB,NCOMB,
+     1 NX,NY,NZ,LRSCH,IMPX)
+      RETURN
+*
+ 1000 FORMAT(/1X,'INPUT OF NEW PARAMETER: ',A12)
+ 1001 FORMAT(/1X,'READING VALUES FOR PARAMETER: ',A12)
+ 1002 FORMAT(/1X,'READING INPUT FOR REF-SHIFT')
+ 1003 FORMAT(/1X,'READING AVERAGE EXIT BURNUPS')
+ 1004 FORMAT(/1X,'READING INSTANTANEOUS BURNUPS')
+ 1005 FORMAT(/1X,'READING DATA FOR FUEL-TYPE PARAMETER: ',A12)
+ 1006 FORMAT(/1X,'READING BUNDLE POWERS IN KW')
+ 1007 FORMAT(/1X,'READING BUNDLE POWERS FORM FACTORS')
+ 1008 FORMAT(/1X,'READING FULL REACTOR POWER IN MW')
+ 1009 FORMAT(/5X,'UNIDIRECTIONAL REFUELLING FOR PATTERN: ',I3)
+ 1010 FORMAT(/5X,'READING SHUFFLING PATTERNS: ',I3)
+      END
diff --git a/Donjon/src/RESPFM.f b/Donjon/src/RESPFM.f
new file mode 100644
index 0000000..17b48a4
--- /dev/null
+++ b/Donjon/src/RESPFM.f
@@ -0,0 +1,168 @@
+*DECK RESPFM
+      SUBROUTINE RESPFM(IPMAP,IPMTX,NX,NY,NZ,LX,LY,LZ,NFUEL,IMPX,IGEO,
+     > NCH,NB,NTOT)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* recover, check and store the fuel mixtures.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki
+*
+*Parameters: input/output
+* IPMAP  pointer to fuel-map information.
+* IPMTX  pointer to matex information.
+* NX     number of elements along x-axis in fuel map.
+* NY     number of elements along y-axis in fuel map.
+* NZ     number of elements along z-axis in fuel map.
+* LX     number of elements along x-axis in geometry.
+* LY     number of elements along y-axis in geometry.
+* LZ     number of elements along z-axis in geometry.
+* NFUEL  number of fuel types.
+* IMPX   printing index (=0 for no print).
+* IGEO   type of geometry (=7 or =9)
+*
+*Parameters: output
+* NCH    number of fuel channels.
+* NB     number of fuel bundles per channel.
+* NTOT   total number of fuel bundles.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAP,IPMTX
+      INTEGER NX,NY,NZ,LX,LY,LZ,NFUEL,IMPX,IGEO,NCH,NB,NTOT
+      TYPE(C_PTR) JPMAP,KPMAP
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(IOUT=6)
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: MIX,FMIX,FTOT,IFLMIX
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(MIX(NX*NY*NZ),FMIX(NFUEL),FTOT(NFUEL))
+*----
+*  COMPUTE NUMBER OF FUEL CHANNELS AND NUMBER OF FUEL BUNDLES
+*----
+      IF(IMPX.GT.2) WRITE(IOUT,*)'SETTING FUEL-MAP MIXTURES'
+      IF((IGEO.NE.7).AND.(IGEO.NE.9))THEN
+        CALL XABORT('@RESPFM: WRONG TYPE OF GEOMETRY, 3D-CARTESIAN OR '
+     >  //'3D-HEXAGONAL GEOMETRY EXPECTED')
+      ENDIF
+      MIX(:NX*NY*NZ)=0
+      CALL LCMGET(IPMAP,'MIX',MIX)
+      NB=0
+      DO IZ=1,NZ
+        DO I=1,NX*NY
+          IEL=(IZ-1)*NX*NY+I
+          IF(MIX(IEL).NE.0) GOTO 10
+        ENDDO
+        CYCLE
+   10   NB=NB+1
+      ENDDO
+      NCH=0
+      DO I=1,NX*NY
+        DO IZ=1,NZ
+          IEL=(IZ-1)*NX*NY+I
+          IF(MIX(IEL).NE.0) GOTO 20
+        ENDDO
+        CYCLE
+   20   NCH=NCH+1
+      ENDDO
+      IF(IMPX.GT.0) WRITE(6,100) NCH,NB
+      ALLOCATE(IFLMIX(NCH*NB))
+*----
+*  COMPUTE FLMIX AND FTOT
+*----
+      FMIX(:NFUEL)=0
+      CALL LCMGET(IPMTX,'FMIX',FMIX)
+      FTOT(:NFUEL)=0
+      IFLMIX(:NCH*NB)=0
+      NTOT=0
+      IB=0
+      DO 50 IZ=1,NZ
+      DO I=1,NX*NY
+         IEL=(IZ-1)*NX*NY+I
+         IF(MIX(IEL).NE.0) GOTO 30
+      ENDDO
+      GO TO 50
+   30 IB=IB+1
+      IF(IB.GT.NB) CALL XABORT('@RESPFM: NB OVERFLOW.')
+      ICH=0
+      DO 40 I=1,NX*NY
+      DO K=1,NZ
+        IF(MIX((K-1)*NX*NY+I).NE.0) GOTO 35
+      ENDDO
+      GO TO 40
+   35 IEL=(IZ-1)*NX*NY+I
+      ICH=ICH+1
+      IF(ICH.GT.NCH) CALL XABORT('@RESPFM: NCH OVERFLOW.')
+      IFLMIX((IB-1)*NCH+ICH)=MIX(IEL)
+      IF(MIX(IEL).EQ.0) GO TO 40
+      DO IFUEL=1,NFUEL
+        IF(MIX(IEL).EQ.FMIX(IFUEL))THEN
+          FTOT(IFUEL)=FTOT(IFUEL)+1
+          NTOT=NTOT+1
+          IF(NTOT.GT.NCH*NB)THEN
+            WRITE(IOUT,*)'@RESPFM: TOTAL NUMBER OF BUNDLES =',NCH*NB
+            WRITE(IOUT,*)'@RESPFM: READ TOTAL FUEL MIXTURES ',NTOT
+            CALL XABORT('@RESPFM: WRONG FUEL-MAP DEFINITION.')
+          ENDIF
+          GOTO 40
+        ENDIF
+      ENDDO
+      WRITE(IOUT,*)'@RESPFM: READ FUEL MIXTURE NUMBER ',MIX(IEL)
+      CALL XABORT('@RESPFM: WRONG FUEL MIXTURE NUMBER.')
+   40 CONTINUE
+   50 CONTINUE
+      IF(IMPX.GT.0) WRITE(6,110) NTOT
+*----
+*  STORE FUEL MIXTURES
+*----
+      IF(IMPX.GT.2) WRITE(IOUT,*)'STORING FUEL MIXTURES'
+*     FUEL DIRECTORIES
+      CALL LCMSIX(IPMAP,' ',0)
+      JPMAP=LCMLID(IPMAP,'FUEL',NFUEL)
+      DO IFUEL=1,NFUEL
+        KPMAP=LCMDIL(JPMAP,IFUEL)
+        CALL LCMPUT(KPMAP,'MIX',1,1,FMIX(IFUEL))
+        CALL LCMPUT(KPMAP,'TOT',1,1,FTOT(IFUEL))
+      ENDDO
+      CALL LCMPUT(IPMAP,'FLMIX',NCH*NB,1,IFLMIX)
+      DEALLOCATE(IFLMIX)
+*     RENUMBERING
+      NMIX=0
+      DO IEL=1,NX*NY*NZ
+        IF(MIX(IEL).NE.0)THEN
+          NMIX=NMIX+1
+          MIX(IEL)=NMIX
+        ENDIF
+      ENDDO
+      CALL LCMPUT(IPMAP,'BMIX',NX*NY*NZ,1,MIX)
+*     UPDATE MATERIAL INDEX
+      IF(IGEO.EQ.7)THEN
+        CALL RESIND(IPMAP,IPMTX,NX,NY,NZ,LX,LY,LZ,MIX,NFUEL,IMPX)
+      ELSE IF(IGEO.EQ.9)THEN
+        CALL RESHID(IPMAP,IPMTX,NX,NZ,LX,LZ,MIX,NFUEL,IMPX)
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(FTOT,FMIX,MIX)
+      RETURN
+*
+  100 FORMAT(/33H RESPFM: NUMBER OF FUEL CHANNELS=,I5/9X,10HNUMBER OF ,
+     > 25HFUEL BUNDLES PER CHANNEL=,I5)
+  110 FORMAT(9X,29HTOTAL NUMBER OF FUEL BUNDLES=,I8)
+      END
diff --git a/Donjon/src/RESROD.f b/Donjon/src/RESROD.f
new file mode 100644
index 0000000..aac2edb
--- /dev/null
+++ b/Donjon/src/RESROD.f
@@ -0,0 +1,80 @@
+*DECK RESROD
+      SUBROUTINE RESROD(NB,NZ,ZZ,IND,ZLEVEL,ITOP,VB)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Move a control rod over a fuel channel.
+*
+*Copyright:
+* Copyright (C) 2017 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* NB      number of fuel bundles per channel.
+* NZ      number of axial meshes.
+* ZZ      axial meshes.
+* IND     bundle index of each axial mesh.
+* ZLEVEL  insertion parameter of the control rod in the channel (set
+*         between 0.0 and 1.0).
+* ITOP    direction flag for the rod (=1: from top; =-1: from bottom).
+*
+*Parameters: output
+* VB      insertion parameter corresponding to each bundle.
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER NB,NZ,IND(NZ),ITOP
+      REAL ZZ(NZ+1),ZLEVEL,VB(NB)
+*
+      ZMIN=ZZ(NZ+1)
+      ZMAX=ZZ(1)
+      DO IZ=1,NZ
+        IF(IND(IZ).EQ.0) CYCLE
+        ZMIN=MIN(ZZ(IZ),ZMIN)
+        ZMAX=MAX(ZZ(IZ+1),ZMAX)
+      ENDDO
+      IF(ITOP.EQ.1) THEN
+        VB(:NB)=0.0
+        ZPOS=ZMAX-ZLEVEL*(ZMAX-ZMIN)
+        DO IB=1,NB
+          ZBMIN=ZZ(NZ+1)
+          ZBMAX=ZZ(1)
+          DO IZ=1,NZ
+            IF(IND(IZ).EQ.IB) THEN
+              ZBMIN=MIN(ZZ(IZ),ZBMIN)
+              ZBMAX=MAX(ZZ(IZ+1),ZBMAX)
+            ENDIF
+          ENDDO
+          IF((ZPOS.GE.ZBMIN).AND.(ZPOS.LE.ZBMAX)) THEN
+            VB(IB)=1.0-(ZPOS-ZBMIN)/(ZBMAX-ZBMIN)
+            VB(IB+1:NB)=1.0
+            EXIT
+          ENDIF
+        ENDDO
+      ELSEIF(ITOP.EQ.-1) THEN
+        VB(:NB)=1.0
+        ZPOS=ZMIN+ZLEVEL*(ZMAX-ZMIN)
+        DO IB=1,NB
+          ZBMIN=ZZ(NZ+1)
+          ZBMAX=ZZ(1)
+          DO IZ=1,NZ
+            IF(IND(IZ).EQ.IB) THEN
+              ZBMIN=MIN(ZZ(IZ),ZBMIN)
+              ZBMAX=MAX(ZZ(IZ+1),ZBMAX)
+            ENDIF
+          ENDDO
+          IF((ZPOS.GE.ZBMIN).AND.(ZPOS.LE.ZBMAX)) THEN
+            VB(IB)=(ZPOS-ZBMIN)/(ZBMAX-ZBMIN)
+            VB(IB+1:NB)=0.0
+            EXIT
+          ENDIF
+        ENDDO
+      ENDIF
+      RETURN
+      END
diff --git a/Donjon/src/ROD.f b/Donjon/src/ROD.f
new file mode 100644
index 0000000..7270f5c
--- /dev/null
+++ b/Donjon/src/ROD.f
@@ -0,0 +1,223 @@
+*DECK ROD
+      SUBROUTINE ROD(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Control rod management module based on SAPHYB or MULTICOMPO
+* interpolation.
+*
+*Copyright:
+* Copyright (C) 2017 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* G. Tixier
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The ROD: module specifications are:
+* FLMAP := ROD: FLMAP :: (descrod1) ;
+* where
+*   FLMAP  :name of the \emph{MAP} object that will contain the 3-D rod file. 
+*     The FLMAP has to be modified for the module and must appear on both LHS 
+*     and RHS.
+*   (descrod1) : structure describing the main input data to the ROD: module. 
+*     Note that this input data is mandatory and must be specified.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(NSTATE=40)
+      INTEGER ISTATE(NSTATE),NPARAM,NREB
+      INTEGER MAXMIX,NGRP,RODSIZE,NASS,RODINFO,NCALL
+      REAL INI,INSS,INSM
+      LOGICAL :: EXISTENCE=.FALSE.
+      CHARACTER HSIGN*12,TEXT*40,PAR1*12,PNAME*12
+      DOUBLE PRECISION DFLOT
+      TYPE(C_PTR) IPMAP,JPMAP,KPMAP,MPMAP
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      REAL, ALLOCATABLE, DIMENSION(:) :: INTROD,HMIX,RMIX
+      CHARACTER(LEN=3), ALLOCATABLE, DIMENSION(:) :: RNAME
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: INS,NUMMIX
+*----
+*  PARAMETER VALIDATION
+*----
+      IF(NENTRY.NE.1)CALL XABORT('@ROD: 1 OBJECT EXPECTED.')
+      IPMAP=KENTRY(1)
+      IF(IENTRY(1).NE.1)CALL XABORT('@ROD:'
+     > //' LCM OBJECT EXPECTED AT LHS.')
+      IF(JENTRY(1).NE.1)CALL XABORT('@ROD: FLMAP MUST BE IN'
+     > //' MODIFICATION MODE AND NOT IN CREATION MODE.')
+      CALL LCMGTC(IPMAP,'SIGNATURE',12,HSIGN)
+      IF(HSIGN.NE.'L_MAP')THEN
+        TEXT=HENTRY(1)
+        CALL XABORT('@ROD: SIGNATURE OF '//TEXT//' IS '//HSIGN//
+     >  '. L_MAP EXPECTED.')
+      ENDIF
+*----
+*  RECOVER L_MAP STATE-VECTOR
+*----
+      CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+      NB=ISTATE(1)
+      NCH=ISTATE(2)
+      NPARAM=ISTATE(8)
+*----
+*  READ INPUT DATA
+*----
+      NCALL=0
+   10 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('@ROD: CHARACTER DATA EXPECTED.')
+* Read printing index
+      IF(TEXT.EQ.'EDIT') THEN
+        CALL REDGET(ITYP,IMPX,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@ROD: INTEGER FOR EDIT EXPECTED.')
+* Name of the parameter record that is to be created
+      ELSE IF(TEXT.EQ.'PARA') THEN
+        NCALL=1
+        CALL REDGET(ITYP,NITMA,FLOT,PAR1,DFLOT)
+        IF(ITYP.NE.3) CALL XABORT('@ROD: CHARACTER'
+     1   //' DATA FOR PARAMETER NAME EXPECTED.')
+* Checking of the record existence
+        IF(NPARAM.GT.0) JPMAP=LCMGID(IPMAP,'PARAM')
+        EXISTENCE=.FALSE.
+        DO IPAR=1,NPARAM,1
+          KPMAP=LCMGIL(JPMAP,IPAR)
+          CALL LCMGTC(KPMAP,'P-NAME',12,PNAME)
+          IF(PNAME.EQ.PAR1) THEN
+            EXISTENCE=.TRUE.
+            EXIT  
+          ENDIF
+        ENDDO
+        IF(.NOT.EXISTENCE) THEN
+* If PARAM doesn't exist, it is created
+          NPARAM=NPARAM+1
+          JPMAP=LCMLID(IPMAP,'PARAM',NPARAM)
+          KPMAP=LCMDIL(JPMAP,NPARAM)
+          CALL LCMPTC(KPMAP,'P-NAME',12,PAR1)
+          CALL LCMPTC(KPMAP,'PARKEY',12,PAR1)
+          IPTYP=2 
+          CALL LCMPUT(KPMAP,'P-TYPE',1,1,IPTYP)
+          RODINFO=4
+          MPMAP=LCMDID(IPMAP,'ROD-INFO')
+          CALL REDGET(ITYP,NITMA,INI,TEXT,DFLOT)
+          IF(ITYP.NE.2)CALL XABORT('@ROD: REAL DATA FOR'
+     1     //' STEP EXPECTED.')
+          CALL LCMPUT(MPMAP,'ROD-INIT',1,2,INI)
+        ENDIF
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+* Check if LINS is defined
+        IF(TEXT.NE.'LINS')CALL XABORT('@ROD: KEYWORD'
+     1   //' LINS EXPECTED.')
+        CALL REDGET(ITYP,NITMA,INSM,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@ROD: REAL DATA FOR'
+     1   //' LINS EXPECTED.')
+        IF(INSM.LT.0)CALL XABORT('@ROD: LINS MUST BE POSITIVE.')
+        CALL LCMPUT(MPMAP,'INS-MAX',1,2,INSM)
+* Check if STEP is defined
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(TEXT.NE.'STEP')CALL XABORT('@ROD: KEYWORD'
+     1   //' STEP EXPECTED.')
+        CALL REDGET(ITYP,NITMA,INSS,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@ROD: REAL DATA FOR'
+     1   //' STEP EXPECTED.')
+        IF(INSS.LT.0.0)CALL XABORT('@ROD: STEP MUST BE POSITIVE.')
+        CALL LCMPUT(MPMAP,'STEP-CM',1,2,INSS)
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+* Check if NRFB is defined
+        IF(TEXT.NE.'NRFB')CALL XABORT('@ROD: KEYWORD '
+     1   //'NRFB EXPECTED.')
+        CALL REDGET(ITYP,NREB,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@ROD: INTEGER DATA FOR'
+     1   //' NRFB EXPECTED.')
+        IF(NREB.LT.0)CALL XABORT('@ROD: NRFB MUST BE POSITIVE.')
+        CALL LCMPUT(MPMAP,'REFL-BOTTOM',1,1,NREB)
+* Definition of rod groups
+      ELSE IF(TEXT.EQ.'RGRP') THEN
+        JPMAP=LCMGID(IPMAP,'PARAM')
+        KPMAP=LCMGIL(JPMAP,NPARAM)
+        IF(NCALL.EQ.1) THEN
+* Creation of records with the number of rod groups and the maximum of
+* rod zones
+        CALL REDGET(ITYP,NGRP,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@ROD: INTEGER'
+     1   //' DATA FOR GROUP NUMBER EXPECTED.')
+        CALL LCMPUT(MPMAP,'NB-GROUP',1,1,NGRP)
+        CALL REDGET(ITYP,MAXMIX,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@ROD: INTEGER'
+     1   //' DATA FOR MAXIMUM MIX NUMBER EXPECTED.')
+        CALL LCMPUT(MPMAP,'MAX-MIX',1,1,MAXMIX)
+        ALLOCATE(RNAME(NGRP),INS(NGRP),NUMMIX(NGRP))
+        ALLOCATE(HMIX(NGRP*MAXMIX),RMIX(NGRP*MAXMIX))
+        RODSIZE=NCH*NB
+        ALLOCATE(INTROD(RODSIZE))
+        HMIX(:NGRP*MAXMIX)=0.0
+        RMIX(:NGRP*MAXMIX)=-999.0
+        INS(:NGRP)=-1
+        CALL RODTYP(IPMAP,NGRP,MAXMIX,RNAME,INS,HMIX,RMIX,NUMMIX)
+        ELSE
+* Recovering rod parameters in order to modify only groups defined
+* in the second call of the module.
+        MPMAP=LCMGID(IPMAP,'ROD-INFO')
+        CALL LCMGET(MPMAP,'NB-GROUP',NGRP)
+        CALL LCMGET(MPMAP,'MAX-MIX',MAXMIX)
+        ALLOCATE(RNAME(NGRP),INS(NGRP),NUMMIX(NGRP))
+        ALLOCATE(HMIX(NGRP*MAXMIX),RMIX(NGRP*MAXMIX))
+        RODSIZE=NCH*NB
+        ALLOCATE(INTROD(RODSIZE))
+* Store rod insertion modification in the fuel map
+        CALL RODMOV(IPMAP,NGRP,RNAME,INS)
+        INTROD(:RODSIZE)=INI
+        CALL RODMOD(IPMAP,NGRP,MAXMIX,NCH,NB,RNAME,INS,INSS,HMIX,
+     >  RMIX,NREB,RODSIZE,INTROD,INI,NUMMIX,NCALL)        
+        ENDIF
+* Definition of the rod map
+      ELSE IF(TEXT.EQ.'RMAP') THEN
+        INTROD(:RODSIZE)=INI
+        CALL REDGET(ITYP,NASS,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1) CALL XABORT('@ROD: INTEGER'
+     1   //' DATA FOR ASSEMBLY NUMBER EXPECTED.')
+        IF(NASS.NE.NCH) CALL XABORT('@ROD: NUMBER OF ASSEMBLIES'
+     1   //' MUST BE EQUAL TO NCH.')
+        CALL RODMOD(IPMAP,NGRP,MAXMIX,NCH,NB,RNAME,INS,INSS,HMIX,
+     >  RMIX,NREB,RODSIZE,INTROD,INI,NUMMIX,NCALL)
+      ELSE IF(TEXT.EQ.';') THEN
+*----
+*  SAVE ROD INSERTION INFORMATION ON LCM OBJECT L_MAP
+*----
+        CALL LCMPUT(KPMAP,'P-VALUE',RODSIZE,2,INTROD)
+        ISTATE(8)=NPARAM
+        CALL LCMPUT(IPMAP,'STATE-VECTOR',NSTATE,1,ISTATE)
+        DEALLOCATE(RNAME,INS,HMIX,RMIX,INTROD)
+        GO TO 20
+      ELSE
+        CALL XABORT('@ROD: INVALID KEYWORD: '//TEXT//'.')
+      ENDIF
+      GO TO 10
+*
+   20 IF(IMPX.GT.2) CALL LCMLIB(IPMAP)
+      RETURN
+      END
diff --git a/Donjon/src/RODMOD.f b/Donjon/src/RODMOD.f
new file mode 100644
index 0000000..25cd8e9
--- /dev/null
+++ b/Donjon/src/RODMOD.f
@@ -0,0 +1,182 @@
+*DECK RODMOD
+      SUBROUTINE RODMOD(IPMAP,NGRP,MAXMIX,NCH,NB,RNAME,INS,INSS,
+     > HMIX,RMIX,NREB,RODSIZE,INTROD,INI,NUMMIX,NCALL)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Modification of the rod data stored in the PARAM folder of a fuel map
+*
+*Copyright:
+* Copyright (C) 2017 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* G. Tixier
+*
+*Parameters: input
+* IPMAP   pointer to the fuel map
+* NGRP    number of rod groups
+* MAXMIX  maximum number of rod mix
+* NCH     number of fuel channels
+* NB      number of fuel bundles per channel
+* RNAME   name of rod group
+* INS     rod insertion for each rod group
+* INSS    rod insertion step (in cm)
+* HMIX    height of rod mix (if more than 2 rod mix are defined)
+* RMIX    number associated to rod mix
+* NREB    number of bottom-reflective meshes
+* RODSIZE total number of meshes for the fuel zone (=NCH*NB)
+* INTROD  final value of data stored in the PARAM folder after 
+*         calculation
+* INI     initial value of data stored in the PARAM folder (no rod
+*         inserted)
+* NUMMIX  number of rod mix for each rod group
+* NCALL   number to distinguish first or other calls to the ROD: 
+*         module
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER NGRP,MAXMIX,NREB,NCH,NB,RODSIZE,NUMMIX(NGRP)
+      INTEGER INSM,NCALL
+      REAL HMIX(NGRP*MAXMIX),RMIX(NGRP*MAXMIX),INTROD(RODSIZE),INS(NGRP)
+      REAL INI,INSS
+      CHARACTER(LEN=3) RNAME(NGRP),RASS(NCH)
+      TYPE(C_PTR) IPMAP
+*----
+*  LOCAL VARIABLES
+*----
+      CHARACTER TEXT*3
+      INTEGER I,J,K,L,M
+      REAL FLOT,F1,F2,ICM,HMB,HMT,ZMI1,ZMI2
+      DOUBLE PRECISION DFLOT
+      TYPE(C_PTR) JPMAP,MPMAP
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      REAL, ALLOCATABLE, DIMENSION(:) :: GEOZZ
+
+* Recover axial meshing
+      JPMAP=LCMGID(IPMAP,'GEOMAP')
+      CALL LCMLEN(JPMAP,'MESHZ',ILONG,ITYLCM)
+      ALLOCATE(GEOZZ(ILONG))
+      CALL LCMGET(JPMAP,'MESHZ',GEOZZ)
+
+* Recover rod parameters
+      MPMAP=LCMGID(IPMAP,'ROD-INFO')
+      CALL LCMGET(MPMAP,'ROD-INIT',INI)
+      CALL LCMGET(MPMAP,'INS-MAX',INSM)
+      CALL LCMGET(MPMAP,'STEP-CM',INSS)
+      CALL LCMGET(MPMAP,'REFL-BOTTOM',NREB)      
+      CALL LCMGTC(MPMAP,'ROD-NAME',3,NGRP,RNAME)
+      CALL LCMGET(MPMAP,'ROD-INSERT',INS)
+      CALL LCMGET(MPMAP,'ROD-RIN',RMIX)
+      CALL LCMGET(MPMAP,'ROD-NBZONE',NUMMIX)
+      CALL LCMGET(MPMAP,'ROD-HEIGHT',HMIX)
+      IF(NB+NREB+1.GT.ILONG) CALL XABORT('RODMOD: GEOZZ OVERFLOW.')
+
+      IF(NCALL.EQ.1) THEN
+* If it is the first call to the ROD: module, the rod map is stored in
+* the fuel map
+      N=1
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('@RODMOD: CHARACTER DATA EXPECTED.')
+      DO WHILE(N.LE.NCH)
+        RASS(N)=TEXT
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        N=N+1
+      END DO
+      CALL LCMPTC(MPMAP,'ROD-MAP',3,NCH,RASS)
+      ENDIF
+* Recover rod map
+      CALL LCMGTC(MPMAP,'ROD-MAP',3,NCH,RASS)
+      I=1
+      DO WHILE(I.LE.NCH)
+        K=NB
+        DO WHILE(K.GE.1)
+        IF((RASS(I).EQ.'|').OR.(RASS(I).EQ.'-').OR.(RASS(I).EQ.'-|-'
+     >  )) THEN
+* If no control rod is defined
+          INTROD((K-1)*NCH+I)=INI
+          GO TO 10
+        ELSE
+* Recover control rod information
+          J=1
+          DO WHILE(J.LE.NGRP)
+            IF(RASS(I).EQ.RNAME(J)) THEN
+              EXIT
+            ELSE
+              J=J+1
+            ENDIF 
+          END DO
+          M=NUMMIX(J)
+          DO WHILE(M.GE.1)
+            IF(M.EQ.1) THEN
+              ICM=INS(J)*INSS
+            ELSE
+              ICM=INS(J)*INSS-HMIX(J+(M-2)*NGRP)
+            ENDIF
+* Mesh size calculations
+            HMB=GEOZZ(NB+NREB+1)-GEOZZ(K+NREB)
+            HMT=GEOZZ(NB+NREB+1)-GEOZZ(K+NREB+1)
+            IF(ICM.LT.0.0) THEN
+              M=M-1
+            ELSE
+              ZMI1=HMB-ICM
+              IF(ZMI1.LE.0.0) THEN
+                INTROD((K-1)*NCH+I)=RMIX(J+(M-1)*NGRP)
+                EXIT
+              ELSE
+                ZMI2=HMT-ICM
+                IF(ZMI2.GE.0.0) THEN
+                  IF(M.EQ.1) THEN
+                    INTROD((K-1)*NCH+I)=INI
+                    GO TO 10
+                  ELSE
+                    M=M-1
+                  ENDIF
+                ELSE
+* Calculation of the proportion of control rod for the mesh considered
+                    F1=HMB-ICM
+                    F2=GEOZZ(K+NREB+1)-GEOZZ(K+NREB)-F1
+                  IF(M.EQ.1) THEN
+                    INTROD((K-1)*NCH+I)=(F2*RMIX(J+(M-1)*NGRP)
+     >              +F1*INI)/(F1+F2)
+                    GO TO 10
+                  ELSE
+                    IF(M.GE.3) THEN
+* It is not possible to have two interfaces in one mesh
+                    IF(((INS(J)*INSS-HMIX(J+(M-3)*NGRP)).GE.HMT).AND.
+     >              ((INS(J)*INSS-HMIX(J+(M-3)*NGRP)).LE.HMB))
+     >              CALL XABORT('@RODMOD: IT IS NOT POSSIBLE TO HAVE'
+     1   //' A MESH WITH MORE THAN TWO INTERFACES. HMIX HAS TO BE'
+     1   //' BIGGER')
+                    ENDIF
+* If two mixtures fill one mesh, we have to compute a fraction of
+* insertion for each rod mixture
+                    INTROD((K-1)*NCH+I)=(F2*RMIX(J+(M-1)*NGRP)+
+     >              F1*RMIX(J+(M-2)*NGRP))/(F1+F2)
+                    EXIT
+                  ENDIF
+                ENDIF
+              ENDIF
+            ENDIF
+          END DO
+        ENDIF
+        K=K-1
+        END DO
+   10   L=K-1
+* If a control rod does not fill one mesh entirely, the meshes located
+* at the bottom of this mesh do not contain control rod
+        DO WHILE(L.GE.1)
+          INTROD((L-1)*NCH+I)=INI
+          L=L-1
+        END DO
+      I=I+1
+      END DO
+      DEALLOCATE(GEOZZ)
+      RETURN
+      END
diff --git a/Donjon/src/RODMOV.f b/Donjon/src/RODMOV.f
new file mode 100644
index 0000000..52a6df2
--- /dev/null
+++ b/Donjon/src/RODMOV.f
@@ -0,0 +1,72 @@
+*DECK RODMOV
+      SUBROUTINE RODMOV(IPMAP,NGRP,RNAME,INS)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Modify rod insertion (second call)
+*
+*Copyright:
+* Copyright (C) 2017 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* G. Tixier
+*
+*Parameters: input
+* IPMAP   pointer to the fuel map
+* NGRP    number of rod groups
+* RNAME   name of rod group
+* INS     rod insertion for each rod group
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAP
+      INTEGER NGRP
+      REAL INS(NGRP)
+      CHARACTER(LEN=3) RNAME(NGRP)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER I,J,NRMV
+      REAL FLOT
+      REAL INS2(NGRP)
+      CHARACTER(LEN=3) RNAME2(NGRP)
+      TYPE(C_PTR) MPMAP
+      CHARACTER TEXT*3
+      DOUBLE PRECISION DFLOT
+*
+      MPMAP=LCMGID(IPMAP,'ROD-INFO')
+      CALL LCMGTC(MPMAP,'ROD-NAME',3,NGRP,RNAME)
+      CALL LCMGET(MPMAP,'ROD-INSERT',INS)
+      CALL REDGET(ITYP,NRMV,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.1)CALL XABORT('@RODMOV: INTEGER'
+     1 //' DATA FOR GROUP NUMBER EXPECTED.')
+      J=1
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('@RODMOV: CHARACTER DATA EXPECTED.')
+      DO WHILE(J.LE.NGRP)
+        RNAME2(J)=TEXT
+        I=1
+        DO WHILE (I.LE.NRMV)
+          RNAME2(I)=TEXT
+          IF(RNAME2(I).EQ.RNAME(J)) THEN
+            CALL REDGET(ITYP,NITMA,INS2(J),TEXT,DFLOT)
+            IF(ITYP.NE.2)CALL XABORT('@RODMOV: REAL DA'
+     1       //'TA FOR INS EXPECTED.')
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@RODMOV: CHARACTER DATA EXPECTED.')
+            GO TO 10
+          ELSE
+            I=I+1
+          ENDIF
+        END DO
+        INS2(J)=INS(J)
+   10   J=J+1
+      END DO
+      CALL LCMPUT(MPMAP,'ROD-INSERT',NGRP,2,INS2)
+      RETURN
+      END
diff --git a/Donjon/src/RODTYP.f b/Donjon/src/RODTYP.f
new file mode 100644
index 0000000..bf49277
--- /dev/null
+++ b/Donjon/src/RODTYP.f
@@ -0,0 +1,83 @@
+*DECK RODTYP
+      SUBROUTINE RODTYP(IPMAP,NGRP,MAXMIX,RNAME,INS,HMIX,RMIX,NUMMIX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Store rod parameters in the fuelmap
+*
+*Copyright:
+* Copyright (C) 2017 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* G. Tixier
+*
+*Parameters: input
+* IPMAP   pointer to the fuel map
+* NGRP    number of rod groups
+* MAXMIX  maximum number of rod mix
+* RNAME   name of rod group
+* INS     rod insertion for each rod group
+* HMIX    height of rod mix (if more than 2 rod mix are defined)
+* RMIX    number associated to rod mix
+* NUMMIX  number of rod mix for each rod group
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAP
+      INTEGER NGRP,MAXMIX,NUMMIX(NGRP)
+      REAL HMIX(NGRP*MAXMIX),RMIX(NGRP*MAXMIX),INS(NGRP)
+      CHARACTER(LEN=3) RNAME(NGRP)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER I,J,INSM
+      REAL FLOT
+      TYPE(C_PTR) MPMAP
+      CHARACTER TEXT*3
+      DOUBLE PRECISION DFLOT
+*
+      MPMAP=LCMGID(IPMAP,'ROD-INFO')
+      CALL LCMGET(MPMAP,'INS-MAX',INSM)
+      I=1
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('@RODTYP: CHARACTER DATA EXPECTED.')
+      DO WHILE (I.LE.NGRP)
+        J=1
+        RNAME(I)=TEXT
+        CALL REDGET(ITYP,NITMA,INS(I),TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@RODTYP: REAL DA'
+     1   //'TA FOR INS EXPECTED.')
+        IF(INS(I).GT.INSM)CALL XABORT('@RODTYP: ROD INSERTION IS '
+     1   //'LARGER THAN MAXIMUM INSERTION.')
+        IF(INS(I).LT.0)CALL XABORT('@RODTYP: ROD INSERTION MUST BE '
+     1   //'POSITIVE.')
+        CALL REDGET(ITYP,NITMA,RMIX(I+(J-1)*NGRP),TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@RODTYP: REAL DA'
+     1   //'TA FOR MIX EXPECTED.')
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        DO WHILE (ITYP.NE.3)
+          HMIX(I+(J-1)*NGRP)=FLOT
+          IF((J.GE.2).AND.(HMIX(I+(J-2)*NGRP).GT.HMIX(I+(J-1)*NGRP)))
+     >    CALL XABORT('@RODTYP: THE LENGTH OF THE TOP MATERIAL MUST' 
+     1   //'BE HIGHER THAN THE BOTTOM MATERIAL.')
+          J=J+1
+          CALL REDGET(ITYP,NITMA,RMIX(I+(J-1)*NGRP),TEXT,DFLOT)
+          IF(ITYP.NE.2)CALL XABORT('@RODTYP: REAL DATA FOR MIX '
+     1   //'EXPECTED.')
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        END DO
+          NUMMIX(I)=J
+          I=I+1
+      END DO
+      CALL LCMPTC(MPMAP,'ROD-NAME',3,NGRP,RNAME)
+      CALL LCMPUT(MPMAP,'ROD-INSERT',NGRP,2,INS)
+      CALL LCMPUT(MPMAP,'ROD-RIN',MAXMIX*NGRP,2,RMIX)
+      CALL LCMPUT(MPMAP,'ROD-NBZONE',NGRP,1,NUMMIX)
+      CALL LCMPUT(MPMAP,'ROD-HEIGHT',MAXMIX*NGRP,2,HMIX)
+      RETURN
+      END
diff --git a/Donjon/src/SCR.f b/Donjon/src/SCR.f
new file mode 100644
index 0000000..c827954
--- /dev/null
+++ b/Donjon/src/SCR.f
@@ -0,0 +1,592 @@
+*DECK SCR
+      SUBROUTINE SCR(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover and interpolate Microlib or Macrolib information from one or
+* many Saphyb database objects.
+*
+*Copyright:
+* Copyright (C) 2012 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The SCR: calling specifications are:
+* MLIB := SCR: [ { MLIB | MLIB2 } ] SAPNAM1 [[ SAPNAM2 ]] [ MAPFL ] 
+*   :: (scr\_data) ; \\
+* where
+*   MLIB : name of a \emph{microlib} (type L\_LIBRARY) or \emph{macrolib} 
+*     (type L\_MACROLIB) containing the interpolated data. If this object also 
+*     appears on the RHS of structure (SCR:, it is open in modification mode 
+*     and updated.
+*   MLIB2 : name of an optional \emph{microlib} object whose content is copied 
+*     on MLIB.
+*   SAPNAM1 : name of the \emph{saphyb} data structure (L\_SAPHYB signature).
+*   SAPNAM2 : name of an additional \emph{saphyb} data structure (L\_SAPHYB 
+*     signature). This object is optional.
+*   MAPFL : name of the \emph{map} object containing fuel regions description, 
+*     global parameter information (burnup, fuel/coolant temperatures, coolant 
+*     density, etc). Keyword TABLE is expected in (scr\_data).
+*   scr\_data : input data structure containing interpolation information.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXR=12
+      INTEGER, PARAMETER::NSTATE=40
+      REAL B2, FLOTT
+      INTEGER ITYLCM, MAXISO, MAXNIS, MD1, MD2, MY1, MY2, NB, NCAL,
+     & NCH, NCOMB, NDEPL, NDFI, NDFP, NFUEL, NGRP, NHEAVY, NBISO, NISY,
+     & NITMA, NLIGHT, NMAC, NMIL, NMIX, NOTHER, NPARM, NPAR, NREAC,
+     & NSTABL, NSURFD, NVTOT, NBESP, ILUPS
+      INTEGER  IMPX, ILONG, IMPY, INDIC, ITER, ITEXT4
+      INTEGER  I, IACCS, ITH, J
+      CHARACTER TEXT4*4,TEXT12*12,HSMG*131,HSIGN*12,HEQUI*4,
+     1 HMASL*4,NMDEPL(MAXR)*8
+      LOGICAL LMACRO,LCUBIC,LRES,LPURE
+      DOUBLE PRECISION DFLOTT
+      INTEGER ISTATE(NSTATE),DIMSAP(50)
+      TYPE(C_PTR) IPMAP,IPSAP,IPLIB,IPLIB2,IPMEM
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: MIXC,NISO,LISO,HISO,IADRY,
+     1 ITNAM,ITZEA,MATNO,KPAX,INAM,IZAE,HREAC,IDR,KPAR,ITODO
+      REAL, ALLOCATABLE, DIMENSION(:) :: CONC,BPAX,RER,RRD,BPAR,YIELD
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: TERP
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: VTOT
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:) :: YLDS,DECAY
+      CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: NOMIS
+*
+      SAVE      NMDEPL
+      DATA      NMDEPL/'DECAY   ','NFTOT   ','NG      ','N2N     ',
+     >                 'N3N     ','N4N     ','NA      ','NP      ',
+     >                 'N2A     ','NNP     ','ND      ','NT      '/
+*----
+*  PARAMETER VALIDATION
+*----
+      IF(NENTRY.LE.1) CALL XABORT('SCR: MINIMUM OF 2 OBJECTS EXPECTED.')
+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('SCR: MACRO'
+     1 //'LIB LCM OBJECT EXPECTED AT LHS.')
+      IF((JENTRY(1).NE.0).AND.(JENTRY(1).NE.1)) CALL XABORT('SCR: MACRO'
+     1 //'LIB IN CREATE OR MODIFICATION MODE EXPECTED.')
+      IACCS=JENTRY(1)
+      IPLIB=KENTRY(1)
+      IPLIB2=C_NULL_PTR
+      IPMAP=C_NULL_PTR
+      NGRP=0
+      NMIX=0
+      IF(IACCS.EQ.1) THEN
+        CALL LCMGTC(IPLIB,'SIGNATURE',12,HSIGN)
+        IF(HSIGN.EQ.'L_LIBRARY') THEN
+          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+          NGRP=ISTATE(3)
+          NMIX=ISTATE(1)
+        ELSE IF(HSIGN.EQ.'L_MACROLIB') THEN
+          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+          NGRP=ISTATE(1)
+          NMIX=ISTATE(2)
+        ELSE
+          TEXT12=HENTRY(1)
+          CALL XABORT('SCR: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     1    '. L_LIBRARY OR L_MACROLIB EXPECTED.')
+        ENDIF
+      ENDIF
+      DO 10 I=2,NENTRY
+        IF((IENTRY(I).NE.1).AND.(IENTRY(I).NE.2)) CALL XABORT('SCR: '
+     1 //'LCM OBJECTS EXPECTED AT RHS.')
+        IF(JENTRY(I).NE.2) CALL XABORT('SCR: LCM OBJECTS IN READ-ONLY '
+     1 //'MODE EXPECTED AT RHS.')
+        CALL LCMGTC(KENTRY(I),'SIGNATURE',12,HSIGN)
+        IF(HSIGN.EQ.'L_LIBRARY') THEN
+          IF(C_ASSOCIATED(IPLIB2)) CALL XABORT('SCR: ONLY ONE MICROLIB'
+     1   //' EXPECTED AT RHS.')
+          IPLIB2=KENTRY(I)
+          GO TO 10
+        ELSE IF(HSIGN.EQ.'L_MACROLIB') THEN
+          CALL XABORT('SCR: ANOTHER MACROLIB NOT EXPECTED AT RHS.')
+        ELSE IF(HSIGN.EQ.'L_MAP') THEN
+          IF(I.NE.NENTRY)CALL XABORT('SCR: FUEL-MAP EXPECTED TO BE THE '
+     1    //'LAST OBJECT.')
+          IF(NENTRY.LT.3)CALL XABORT('SCR: MISSING SAPHYB OBJECT.')
+          IPMAP=KENTRY(NENTRY)
+          CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+          NMIX=ISTATE(9)
+        ELSE IF(HSIGN.NE.'L_SAPHYB') THEN
+          TEXT12=HENTRY(I)
+          CALL XABORT('SCR: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+     1   '. L_SAPHYB EXPECTED.')
+        ENDIF
+   10 CONTINUE
+*----
+*  READ THE INPUT DATA
+*----
+      NVTOT=0
+      LMACRO=.TRUE.
+      LCUBIC=.FALSE.
+      LRES=.FALSE.
+      LPURE=.FALSE.
+      B2=0.0
+      ITER=-1
+      IPSAP=C_NULL_PTR
+      HEQUI=' '
+      HMASL=' '
+      ILUPS=0
+      IMPX=1
+   20 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+      IF(INDIC.NE.3) CALL XABORT('SCR: CHARACTER DATA EXPECTED(1).')
+   30 IF(TEXT12.EQ.'EDIT') THEN
+*       READ THE PRINT INDEX.
+        CALL REDGET(INDIC,IMPX,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1) CALL XABORT('SCR: INTEGER DATA EXPECTED(1).')
+      ELSE IF(TEXT12.EQ.'NMIX') THEN
+*       READ THE MAXIMUM NUMBER OF MATERIAL MIXTURES.
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1) CALL XABORT('SCR: INTEGER DATA EXPECTED(2).')
+        IF(NITMA.LT.NMIX) THEN
+           WRITE(HSMG,'(20HSCR: NMIX MUST BE >=,I8)') NMIX
+           CALL XABORT(HSMG)
+        ENDIF
+        NMIX=NITMA
+      ELSE IF(TEXT12.EQ.'MACRO') THEN
+        LMACRO=.TRUE.
+      ELSE IF(TEXT12.EQ.'MICRO') THEN
+        LMACRO=.FALSE.
+      ELSE IF(TEXT12.EQ.'LINEAR') THEN
+        LCUBIC=.FALSE.
+      ELSE IF(TEXT12.EQ.'CUBIC') THEN
+        LCUBIC=.TRUE.
+      ELSE IF(TEXT12.EQ.'RES') THEN
+        IF((IACCS.EQ.0).AND.(.NOT.C_ASSOCIATED(IPLIB2))) THEN
+          CALL XABORT('SCR: RHS MICROLIB EXPECTED WITH RES OPTION.')
+        ENDIF
+        LRES=.TRUE.
+      ELSE IF(TEXT12.EQ.'PURE') THEN
+        LPURE=.TRUE.
+      ELSE IF(TEXT12.EQ.'UPS') THEN
+        ILUPS=1
+      ELSE IF(TEXT12.EQ.'SAPHYB') THEN
+        IF(NMIX.EQ.0) CALL XABORT('SCR: ZERO NUMBER OF MIXTURES.')
+        IF(C_ASSOCIATED(IPMAP)) THEN
+          WRITE(IOUT,'(/43H SCR: ***WARNING*** A FUEL MAP IS SET AT RH,
+     1    26HS; KEYWORD TABLE EXPECTED.)')
+        ENDIF
+        IF((IACCS.EQ.0).AND.(C_ASSOCIATED(IPLIB2))) THEN
+          CALL LCMEQU(IPLIB2,IPLIB)
+          IACCS=1
+        ENDIF
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3) CALL XABORT('SCR: CHARACTER DATA EXPECTED(2).')
+        ITH=0
+        DO 50 I=2,NENTRY
+          IF(C_ASSOCIATED(KENTRY(I),IPLIB2)) GO TO 50
+          IF(TEXT12.EQ.HENTRY(I)) THEN
+            CALL LCMGTC(KENTRY(I),'SIGNATURE',12,TEXT12)
+            IF(TEXT12.EQ.'L_SAPHYB') THEN
+              IPSAP=KENTRY(I)
+            ELSE
+              CALL XABORT('SCR: WRONG SIGNATURE ('//TEXT12//').')
+            ENDIF
+            ITH=I
+            GO TO 60
+          ENDIF
+   50   CONTINUE
+        CALL XABORT('SCR: SAPHYB '//TEXT12//' NOT FOUND.')
+   60   IF(IMPX.GT.0) THEN
+          WRITE(IOUT,320) HENTRY(ITH)
+          CALL SCRTOC(IPSAP)
+        ENDIF
+        CALL LCMGET(IPSAP,'DIMSAP',DIMSAP)
+        IF(NGRP.EQ.0) THEN
+          NGRP=DIMSAP(20)
+        ELSE IF(NGRP.NE.DIMSAP(20)) THEN
+          WRITE(HSMG,'(9H SCR: THE,I4,27H-TH SAPHYB HAS AN INVALID N,
+     1    24HUMBER OF ENERGY GROUPS (,I4,3H VS,I5,1H.)') ITH,NGRP,
+     2    DIMSAP(20)
+          CALL XABORT(HSMG)
+        ENDIF
+        NMIL=DIMSAP(7)
+        NCAL=DIMSAP(19)
+        MY1=DIMSAP(6)+DIMSAP(14)
+        MY2=DIMSAP(15)
+        MD1=DIMSAP(3)
+        MD2=DIMSAP(5)+DIMSAP(6)
+        ALLOCATE(MIXC(NMIX),NISO(NMIX),LISO(NMIX),HISO(2*NMIX*MD2),
+     1  ITODO(NMIX*MD2))
+        ALLOCATE(TERP(NCAL,NMIX),CONC(NMIX*MD2))
+*
+        CALL SCRDRV(IPSAP,LCUBIC,NMIX,IMPX,NMIL,NCAL,MD2,ITER,MAXNIS,
+     1  MIXC,TERP,NISO,LISO,HISO,CONC,ITODO)
+        GO TO 130
+      ELSE IF(TEXT12.EQ.'TABLE') THEN
+        IF(.NOT.C_ASSOCIATED(IPMAP)) CALL XABORT('SCR: MISSING FUEL-MA'
+     1  //'P OBJECT.')
+        ISTATE(:NSTATE)=0
+        CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+        NB=ISTATE(1)
+        NCH=ISTATE(2)
+        NCOMB=ISTATE(3)
+        NGRP=ISTATE(4)
+        NFUEL=ISTATE(7)
+        NPARM=ISTATE(8)
+        IF(NCOMB.EQ.0) CALL XABORT('SCR: NUMBER OF COMBUSTION ZONES NO'
+     1   //'T YET DEFINED IN THE FUEL MAP NCOMB=0.')
+        IF((IACCS.EQ.0).AND.(C_ASSOCIATED(IPLIB2))) THEN
+          CALL LCMEQU(IPLIB2,IPLIB)
+          IACCS=1
+        ENDIF
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3) CALL XABORT('SCR: CHARACTER DATA EXPECTED(2).')
+        ITH=0
+        DO 80 I=2,NENTRY
+          IF((C_ASSOCIATED(KENTRY(I),IPLIB2)).OR.
+     1       (C_ASSOCIATED(KENTRY(I),IPMAP))) GO TO 80
+          IF(TEXT12.EQ.HENTRY(I)) THEN
+            CALL LCMGTC(KENTRY(I),'SIGNATURE',12,TEXT12)
+            IF(TEXT12.EQ.'L_SAPHYB') THEN
+              IPSAP=KENTRY(I)
+            ELSE
+              CALL XABORT('SCR: WRONG SIGNATURE ('//TEXT12//').')
+            ENDIF
+            ITH=I
+            GO TO 90
+          ENDIF
+   80   CONTINUE
+        CALL XABORT('SCR: SAPHYB '//TEXT12//' NOT FOUND.')
+   90   IF(IMPX.GT.0) THEN
+          WRITE(IOUT,320) HENTRY(ITH)
+          CALL SCRTOC(IPSAP)
+        ENDIF
+        CALL LCMGET(IPSAP,'DIMSAP',DIMSAP)
+        IF(NGRP.NE.DIMSAP(20)) THEN
+          WRITE(HSMG,'(9H SCR: THE,I4,27H-TH SAPHYB HAS AN INVALID N,
+     1    24HUMBER OF ENERGY GROUPS (,I4,3H VS,I5,2H).)') ITH,NGRP,
+     2    DIMSAP(20)
+          CALL XABORT(HSMG)
+        ENDIF
+        NMIL=DIMSAP(7)
+        NCAL=DIMSAP(19)
+        MY1=DIMSAP(6)+DIMSAP(14)
+        MY2=DIMSAP(15)
+        MD1=DIMSAP(3)
+        MD2=DIMSAP(5)+DIMSAP(6)
+        ALLOCATE(MIXC(NMIX),NISO(NMIX),LISO(NMIX),HISO(2*NMIX*MD2),
+     1  ITODO(NMIX*MD2))
+        ALLOCATE(TERP(NCAL,NMIX),CONC(NMIX*MD2))
+*
+        CALL SCRRGR(IPSAP,IPMAP,LCUBIC,NMIX,IMPX,NMIL,NCAL,MD2,NCH,NB,
+     1  NFUEL,NPARM,ITER,MAXNIS,MIXC,TERP,NISO,LISO,HISO,CONC,ITODO)
+        GO TO 130
+      ELSE IF(TEXT12.EQ.'EQUI') THEN
+         CALL REDGET(INDIC,NITMA,FLOTT,HEQUI,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('SCR: CHARACTER DATA EXPECTED')
+      ELSE IF(TEXT12.EQ.'MASL') THEN
+         CALL REDGET(INDIC,NITMA,FLOTT,HMASL,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('SCR: CHARACTER DATA EXPECTED')
+      ELSE IF(TEXT12.EQ.'LEAK') THEN
+        CALL REDGET(INDIC,NITMA,B2,TEXT12,DFLOTT)
+        IF(INDIC.NE.2) CALL XABORT('SCR: REAL DATA EXPECTED.')
+      ELSE IF(TEXT12.EQ.'CHAIN') THEN
+        IF(LMACRO) CALL XABORT('SCR: MICRO KEYWORD EXPECTED.')
+        CALL LCMGET(IPSAP,'DIMSAP',DIMSAP)
+        NBISO=DIMSAP(5)  ! number of particularized isotopes
+        NMAC=DIMSAP(6)   ! number of macroscopic sets
+        IF(NBISO.EQ.0) CALL XABORT('SCR: NO PARTICULARIZED ISOTOPES.')
+        IF(NMAC.EQ.0) CALL XABORT('SCR: NO MACROSCOPIC SETS.')
+        MY1=DIMSAP(6)+DIMSAP(14)
+        MY2=DIMSAP(15)
+        MD1=DIMSAP(3)
+        MD2=DIMSAP(5)+DIMSAP(6)
+        CALL LCMLEN(IPLIB,'VTOT_',ILONG,ITYLCM)
+        IF(ILONG.NE.NVTOT) CALL XABORT('SCR: INVALID LENGTH: VTOT(1).')
+        CALL LCMLEN(IPLIB,'YLDS_',ILONG,ITYLCM)
+        IF(ILONG.NE.MY1*MY2*NVTOT) CALL XABORT('SCR: INVALID LENGTH: Y'
+     1  //'LDS(1).')
+        CALL LCMLEN(IPLIB,'DECAYC_',ILONG,ITYLCM)
+        IF(ILONG.NE.MD1*MD2*NVTOT) CALL XABORT('SCR: INVALID LENGTH: D'
+     1  //'ECAYC(1)')
+        ALLOCATE(VTOT(NVTOT),YLDS(MY1,MY2,NVTOT),DECAY(MD1,MD2,NVTOT),
+     1  NOMIS(NBISO+NMAC))
+        CALL LCMGET(IPLIB,'VTOT_',VTOT)
+        CALL LCMGET(IPLIB,'YLDS_',YLDS)
+        CALL LCMGET(IPLIB,'DECAYC_',DECAY)
+        CALL LCMSIX(IPSAP,'contenu',1)
+          CALL LCMGTC(IPSAP,'NOMISO',8,NBISO,NOMIS)
+          CALL LCMGTC(IPSAP,'NOMMAC',8,NMAC,NOMIS(NBISO+1:NBISO+NMAC))
+        CALL LCMSIX(IPSAP,' ',2)
+        WRITE(TEXT12,'(4Hcalc,I8)') 1
+        CALL LCMSIX(IPSAP,TEXT12,1) ! step up to calc
+        CALL LCMSIX(IPSAP,'info',1)
+        CALL LCMGET(IPSAP,'NISY',NISY)
+        ALLOCATE(IADRY(NISY))
+        CALL LCMGET(IPSAP,'ADRY',IADRY)
+        CALL LCMSIX(IPSAP,' ',2)
+        CALL LCMSIX(IPSAP,' ',2)
+*
+        NBESP=1
+        ALLOCATE(ITNAM(3*MD2),ITZEA(MD2),MATNO(MD2),
+     1  KPAX((MD2+MAXR)*MD2),BPAX((MD2+MAXR)*MD2*NBESP))
+        TEXT4='    '
+        READ(TEXT4,'(A4)') ITEXT4
+        ITNAM(:3*MD2)=ITEXT4
+        ITZEA(:MD2)=0
+        MATNO(:MD2)=0
+        KPAX(:(MD2+MAXR)*MD2)=0
+        BPAX(:(MD2+MAXR)*MD2*NBESP)=0.0
+        CALL SCREIR(NMDEPL,MY1,MY2,MD1,MD2,NOMIS,IADRY,NVTOT,VTOT,
+     1              YLDS,DECAY,ITNAM,ITZEA,KPAX,BPAX)
+        DEALLOCATE(IADRY,NOMIS,DECAY,YLDS,VTOT)
+        CALL LIBWET(MAXR,MD2,NBESP,NSTATE,NMDEPL,ITNAM,ISTATE,MATNO,
+     1  KPAX,BPAX)
+        NDEPL=ISTATE(1)
+        NDFI=ISTATE(2)
+        NDFP=ISTATE(3)
+        NHEAVY=ISTATE(4)
+        NLIGHT=ISTATE(5)
+        NOTHER=ISTATE(6)
+        NSTABL=ISTATE(7)
+        NREAC=ISTATE(8)
+        NPAR=ISTATE(9)
+        NBESP=MAX(1,ISTATE(10))
+*----
+*  ALLOCATE DECAY CHAIN
+*----
+        NDEPL=MAX(NDEPL,1)
+        NDFI=MAX(NDFI,1)
+        NDFP=MAX(NDFP,1)
+        ALLOCATE(INAM(3*NDEPL),IZAE(NDEPL),IDR(NREAC*NDEPL),
+     1  RER(NREAC*NDEPL),RRD(NDEPL),KPAR(NPAR*NDEPL),BPAR(NPAR*NDEPL),
+     2  YIELD(NDFI*NDFP*NBESP))
+*----
+*  SET DECAY CHAIN
+*----
+        CALL LIBWED(MAXR,MD2,NBESP,NDEPL,NDFI,NDFP,NHEAVY,NLIGHT,NOTHER,
+     >              NREAC,NPAR,ITNAM,ITZEA,MATNO,KPAX,BPAX,INAM,IZAE,
+     >              IDR,RER,RRD,KPAR,BPAR,YIELD)
+*----
+*  RELEASE WORK VECTORS FOR WIMS-AECL, WIMS-NEA, DRAGLIB
+*  AND INPUT FILE
+*----
+        DEALLOCATE(BPAX,KPAX,MATNO,ITZEA,ITNAM)
+*----
+*  SELECT USED DEPLETION REACTION NAMES
+*----
+        ALLOCATE(HREAC(2*NREAC))
+        DO 100 I=1,NREAC
+          READ(NMDEPL(I),'(2A4)') (HREAC(2*(I-1)+J),J=1,2)
+  100   CONTINUE
+*----
+*  PRINT DECAY CHAIN IF REQUIRED
+*----
+        IMPY=IMPX+2
+        CALL LIBEPR(IMPY,NBESP,NDEPL,NSTABL,NDFI,NDFP,NREAC,NPAR,INAM,
+     >              HREAC,IDR,RER,RRD,KPAR,BPAR,YIELD,IZAE)
+*----
+*  SAVE CHAIN
+*----
+        CALL LCMSIX(IPLIB,'DEPL-CHAIN',1)
+        CALL LCMPUT(IPLIB,'STATE-VECTOR',NSTATE,1,ISTATE)
+        NDEPL=ISTATE(1)
+        CALL LCMPUT(IPLIB,'ISOTOPESDEPL',3*NDEPL,3,INAM)
+        CALL LCMPUT(IPLIB,'CHARGEWEIGHT',NDEPL,1,IZAE)
+        CALL LCMPUT(IPLIB,'DEPLETE-IDEN',2*NREAC,3,HREAC)
+        CALL LCMPUT(IPLIB,'DEPLETE-REAC',NREAC*NDEPL,1,IDR)
+        CALL LCMPUT(IPLIB,'DEPLETE-ENER',NREAC*NDEPL,2,RER)
+        CALL LCMPUT(IPLIB,'DEPLETE-DECA',NDEPL,2,RRD)
+        CALL LCMPUT(IPLIB,'PRODUCE-REAC',NPAR*NDEPL,1,KPAR)
+        CALL LCMPUT(IPLIB,'PRODUCE-RATE',NPAR*NDEPL,2,BPAR)
+        IF(NDFP.GT.0) CALL LCMPUT(IPLIB,'FISSIONYIELD',NDFI*NDFP*NBESP,
+     >  2,YIELD)
+        CALL LCMSIX(IPLIB,' ',2)
+        CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+        ISTATE(11)=NDEPL
+        CALL LCMPUT(IPLIB,'STATE-VECTOR',NSTATE,1,ISTATE)
+*----
+*  DEALLOCATE DECAY CHAIN ARRAYS
+*----
+        DEALLOCATE(YIELD,BPAR,KPAR,RRD,RER,IDR,IZAE,INAM)
+      ELSE IF(TEXT12.EQ.';') THEN
+        GO TO 200
+      ELSE
+        CALL XABORT('SCR: '//TEXT12//' IS AN INVALID KEYWORD.')
+      ENDIF
+      GO TO 20
+*----
+*  COPY THE SAPHYB INTO MEMORY IN ORDER TO SAVE INTERPOLATION TIME
+*----
+  130 CALL SCRMEM(IPSAP,IPMEM,NCAL,NMIL,NMIX,TERP,MIXC)
+      CALL LCMGET(IPSAP,'DIMSAP',DIMSAP)
+      MD2=DIMSAP(5)+DIMSAP(6)
+*----
+*  FIND THE NUMBER OF DISCONTINUITY FACTORS
+*----
+      NSURFD=0
+      CALL LCMSIX(IPSAP,'geom',1)
+      CALL LCMLEN(IPSAP,'outgeom',ILONG,ITYLCM)
+      IF(ILONG.NE.0) THEN
+        CALL LCMSIX(IPSAP,'outgeom',1)
+        CALL LCMLEN(IPSAP,'SURF',NSURFD,ITYLCM)
+        CALL LCMSIX(IPSAP,' ',2)
+      ENDIF
+      CALL LCMSIX(IPSAP,' ',2)
+*----
+*  BUILD THE INTERPOLATED MACROLIB
+*----
+      IF(LMACRO.AND.(MAXNIS.EQ.0)) THEN
+*       build a macrolib
+        CALL SCRSAP(IPLIB,IPMEM,IACCS,NMIL,NMIX,NGRP,IMPX,HEQUI,HMASL,
+     1  NCAL,NSURFD,ILUPS,MIXC,TERP,LPURE,B2)
+      ELSE
+*       build a microlib
+        IF(LMACRO)THEN
+          CALL LCMOP(IPLIB,'*TEMPORARY*',0,1,0)
+          IACCS=0
+        ENDIF
+        IF(IACCS.EQ.0)THEN
+          MAXISO=MD2*NMIX
+        ELSE
+          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+          MAXISO=MAX(MD2*NMIX,ISTATE(2))
+        ENDIF
+        NVTOT=NVTOT+1
+        ALLOCATE(VTOT(NVTOT),YLDS(MY1,MY2,NVTOT),DECAY(MD1,MD2,NVTOT))
+        IF(NVTOT.GT.1) THEN
+          CALL LCMLEN(IPLIB,'VTOT_',ILONG,ITYLCM)
+          IF(ILONG.NE.NVTOT-1) CALL XABORT('SCR: INVALID LENGTH: VTOT('
+     1    //'2).')
+          CALL LCMLEN(IPLIB,'YLDS_',ILONG,ITYLCM)
+          IF(ILONG.NE.MY1*MY2*(NVTOT-1)) CALL XABORT('SCR: INVALID LEN'
+     1    //'GTH: YLDS(2).')
+          CALL LCMGET(IPLIB,'VTOT_',VTOT)
+          IF(MY1*MY2.GT.0) CALL LCMGET(IPLIB,'YLDS_',YLDS)
+          IF(MD1*MD2.GT.0) CALL LCMGET(IPLIB,'DECAYC_',DECAY)
+        ENDIF
+        CALL SCRLIB(MAXNIS,MAXISO,IPLIB,IPMEM,IACCS,NMIX,NGRP,IMPX,
+     1  HEQUI,HMASL,NCAL,ITER,MY1,MY2,MD1,MD2,TERP,NISO,LISO,HISO,
+     2  CONC,ITODO,MIXC,LRES,LPURE,ILUPS,B2,VTOT(NVTOT),YLDS(1,1,NVTOT),
+     3  DECAY(1,1,NVTOT))
+        CALL LCMPUT(IPLIB,'VTOT_',NVTOT,4,VTOT)
+        IF(MY1*MY2.GT.0) THEN
+          CALL LCMPUT(IPLIB,'YLDS_',MY1*MY2*NVTOT,4,YLDS)
+        ENDIF
+        IF(MD1*MD2.GT.0) THEN
+          CALL LCMPUT(IPLIB,'DECAYC_',MD1*MD2*NVTOT,4,DECAY)
+        ENDIF
+        DEALLOCATE(VTOT,DECAY,YLDS)
+        IF(LMACRO) THEN
+          CALL LCMVAL(IPLIB,' ')
+          CALL LCMSIX(IPLIB,'MACROLIB',1)
+          CALL LCMEQU(IPLIB,KENTRY(1))
+          CALL LCMSIX(IPLIB,' ',2)
+          CALL LCMCL(IPLIB,2)
+        ENDIF
+      ENDIF
+      CALL LCMCL(IPMEM,2)
+      DEALLOCATE(LISO,NISO,HISO,ITODO,CONC,TERP,MIXC)
+*----
+*  PRINT THE STATE VECTOR
+*----
+      IF(IMPX.GT.0) THEN
+        IF(LMACRO) THEN
+          CALL LCMGET(KENTRY(1),'STATE-VECTOR',ISTATE)
+          WRITE(IOUT,290) IMPX,(ISTATE(I),I=1,7),ISTATE(9),ISTATE(12)
+          IF(IMPX.GT.3) CALL LCMLIB(KENTRY(1))
+        ELSE
+          CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+          WRITE(IOUT,300) IMPX,(ISTATE(I),I=1,12)
+          WRITE(IOUT,310) (ISTATE(I),I=13,15),(ISTATE(I),I=17,24)
+          IF(IMPX.GT.3) CALL LCMLIB(IPLIB)
+        ENDIF
+      ENDIF
+*----
+*  CONTINUE DATA PROCESSING
+*----
+      IF(ITER.EQ.0) THEN
+        GO TO 200
+      ELSE IF(ITER.EQ.1) THEN
+        TEXT12='SAPHYB'
+        GO TO 30
+      ELSE IF(ITER.EQ.2) THEN
+        TEXT12='TABLE'
+        GO TO 30
+      ELSE IF(ITER.EQ.3) THEN
+        TEXT12='CHAIN'
+        GO TO 30
+      ENDIF
+*----
+*  LEAVE SCR:
+*----
+  200 RETURN
+*
+  290 FORMAT(/8H OPTIONS/8H -------/
+     1 7H IMPX  ,I6,30H   (0=NO PRINT/1=SHORT/2=MORE)/
+     2 7H NGROUP,I6,28H   (NUMBER OF ENERGY GROUPS)/
+     3 7H NBMIX ,I6,39H   (NUMBER OF MIXTURES IN THE MACROLIB)/
+     4 7H NANISO,I6,34H   (MAXIMUM SCATTERING ANISOTROPY)/
+     5 7H NIFISS,I6,45H   (MAXIMUM NUMBER OF FISSILE ISOTOPES IN A M,
+     6 7HIXTURE)/
+     7 7H NEDMAC,I6,34H   (NUMBER OF CROSS SECTION EDITS)/
+     8 7H ITRANC,I6,45H   (0=NO TRANSPORT CORRECTION/1=APOLLO TYPE/2,
+     9 43H=RECOVER FROM LIBRARY/4=LEAKAGE CORRECTION)/
+     1 7H NLG   ,I6,39H   (NUMBER OF DELAYED PRECURSOR GROUPS)/
+     2 7H ILEAK ,I6,40H   (1=DIFF AVAILABLE; 2=DIFFX AVAILABLE)/
+     3 7H IDF   ,I6,34H   (0=NO ADF INFO/2=FLUX GAP INFO))
+  300 FORMAT(/8H OPTIONS/8H -------/
+     1 7H IMPX  ,I6,30H   (0=NO PRINT/1=SHORT/2=MORE)/
+     2 7H MAXMIX,I6,31H   (MAXIMUM NUMBER OF MIXTURES)/
+     3 7H NBISO ,I6,36H   (NUMBER OF ISOTOPES OR MATERIALS)/
+     4 7H NGRP  ,I6,28H   (NUMBER OF ENERGY GROUPS)/
+     5 7H NL    ,I6,30H   (NUMBER OF LEGENDRE ORDERS)/
+     6 7H ITRANC,I6,45H   (0=NO TRANSPORT CORRECTION/1=APOLLO TYPE/2,
+     7 57H=RECOVER FROM LIBRARY/3=WIMS-D TYPE/4=LEAKAGE CORRECTION)/
+     8 7H IPROB ,I6,23H   (0=DIRECT/1=ADJOINT)/
+     9 7H ITIME ,I6,28H   (1=STEADY-STATE/2=PROMPT)/
+     1 7H NLIB  ,I6,32H   (NUMBER OF SETS OF LIBRARIES)/
+     2 7H NGF   ,I6,48H   (NUMBER OF FAST GROUP WITHOUT SELF-SHIELDING)/
+     3 7H IGRMAX,I6,41H   (LAST GROUP INDEX WITH SELF-SHIELDING)/
+     4 7H NDEPL ,I6,33H   (NUMBER OF DEPLETING ISOTOPES)/
+     5 7H NCOMB ,I6,33H   (NUMBER OF DEPLETING MIXTURES))
+  310 FORMAT(7H NEDMAC,I6,34H   (NUMBER OF CROSS SECTION EDITS)/
+     1 7H NBMIX ,I6,23H   (NUMBER OF MIXTURES)/
+     2 7H NRES  ,I6,40H   (NUMBER OF SETS OF RESONANT MIXTURES)/
+     3 7H IPROC ,I6,48H   (-1=SKIP LIBRARY PROCESSING/0=DILUTION INTERP,
+     4 48HOLATION/1=USE PHYSICAL TABLES/2=BUILD A DRAGLIB/,
+     5 55H3=COMPUTE CALENDF TABLES/4=COMPUTE SLOWING-DOWN TABLES)/
+     6 7H IMAC  ,I6,45H   (0=DO NOT/1=DO BUILD AN EMBEDDED MACROLIB)/
+     7 7H NDEL  ,I6,31H   (NUMBER OF PRECURSOR GROUPS)/
+     8 7H NFISS ,I6,31H   (NUMBER OF FISSILE ISOTOPES)/
+     9 7H ISOADD,I6,37H   (0=COMPLETE BURNUP CHAIN/1=DO NOT)/
+     1 7H MAXISM,I6,40H   (MAX. NUMBER OF ISOTOPES PER MIXTURE)/
+     2 7H IPRECI,I6,34H   (CALENDF ACCURACY FLAG:1/2/3/4)/
+     3 7H IDF   ,I6,47H   (0=NO INFO/1=ALBS INFO/2=FLUX GAP INFO/3=ADF,
+     4 10H GAP INFO))
+  320 FORMAT(/28H SCR: INTERPOLATING SAPHYB ',A12,2H'.)
+      END
diff --git a/Donjon/src/SCRDRV.f b/Donjon/src/SCRDRV.f
new file mode 100644
index 0000000..44c35be
--- /dev/null
+++ b/Donjon/src/SCRDRV.f
@@ -0,0 +1,377 @@
+*DECK SCRDRV
+      SUBROUTINE SCRDRV(IPSAP,LCUBIC,NMIX,IMPX,NMIL,NCAL,MD2,ITER,
+     1 MAXNIS,MIXC,TERP,NISO,LISO,HISO,CONC,ITODO)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute TERP factors for Saphyb interpolation. Use user-defined
+* global parameters.
+*
+*Copyright:
+* Copyright (C) 2012 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPSAP   address of the Saphyb object.
+* LCUBIC  =.TRUE.: cubic Ceschino interpolation; =.FALSE: linear
+*         Lagrange interpolation.
+* NMIX    maximum number of material mixtures in the microlib.
+* IMPX    print parameter (equal to zero for no print).
+* NMIL    number of material mixtures in the Saphyb.
+* NCAL    number of elementary calculations in the Saphyb.
+* MD2     number of particularized and macro isotopes in the Saphyb.
+*
+*Parameters: output
+* ITER    completion flag (=0: all over; =1: use another Saphyb;
+*         =2 use another L_MAP + Saphyb).
+* MAXNIS  maximum value of NISO(I) in user data.
+* MIXC    mixture index in the Saphyb corresponding to each microlib
+*         mixture.
+* TERP    interpolation factors.
+* NISO    number of user-selected isotopes.
+* LISO    type of treatment (=.true.: ALL; =.false.: ONLY).
+* HISO    name of the user-selected isotopes.
+* CONC    user-defined number density of the user-selected isotopes. A
+*         value of -99.99 is set to indicate that the compo value is
+*         used.
+* ITODO   non-depletion mask (=1 to force a user-selected isotope to be
+*         non-depleting)
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPSAP
+      INTEGER NMIX,IMPX,NMIL,NCAL,MD2,ITER,MAXNIS,MIXC(NMIX),
+     1 HISO(2,NMIX,MD2),NISO(NMIX),ITODO(NMIX,MD2)
+      REAL TERP(NCAL,NMIX),CONC(NMIX,MD2)
+      LOGICAL LCUBIC,LISO(NMIX)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXLIN=50
+      INTEGER, PARAMETER::MAXPAR=50
+      INTEGER, PARAMETER::MAXVAL=200
+      REAL, PARAMETER::REPS=1.0E-4
+      INTEGER I, I0, IBM, IBMOLD, ICAL, INDIC, IPAR, ITYLCM, ITYPE, J
+     &, JBM, LENGTH, NCOMLI, NITMA, NPAR, NVP
+      REAL SUM, FLOTT
+      CHARACTER TEXT12*12,PARKEY(MAXPAR)*4,PARFMT(MAXPAR)*8,HSMG*131,
+     1 COMMEN(MAXLIN)*80,VALH(MAXPAR)*12,VCHAR(MAXVAL)*12,RECNAM*12,
+     2 HCUBIC*12
+      INTEGER DIMSAP(50),VALI(MAXPAR),NVALUE(MAXPAR),VINTE(MAXVAL),
+     1 MUPLET(2*MAXPAR),MUTYPE(2*MAXPAR)
+      DOUBLE PRECISION DFLOTT
+      REAL VALR(2*MAXPAR,2),VREAL(MAXVAL)
+      LOGICAL LCUB2(MAXPAR)
+      TYPE(C_PTR) LPSAP
+      LOGICAL, ALLOCATABLE, DIMENSION(:) :: LDELTA
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(LDELTA(NMIX))
+*----
+*  RECOVER TABLE-OF-CONTENT INFORMATION FOR THE SAPHYB.
+*----
+      CALL LCMGET(IPSAP,'DIMSAP',DIMSAP)
+      NCOMLI=DIMSAP(1)
+      NPAR=DIMSAP(8)
+      NVP=DIMSAP(17)
+      IF(NCOMLI.GT.MAXLIN) CALL XABORT('SCRDRV: MAXLIN OVERFLOW.')
+      IF(NPAR.GT.MAXPAR) CALL XABORT('SCRDRV: MAXPAR OVERFLOW.')
+      CALL LCMGTC(IPSAP,'COMMEN',80,NCOMLI,COMMEN)
+      IF(NPAR.GT.0) THEN
+         CALL LCMSIX(IPSAP,'paramdescrip',1)
+         CALL LCMGTC(IPSAP,'PARKEY',4,NPAR,PARKEY)
+         CALL LCMGTC(IPSAP,'PARFMT',8,NPAR,PARFMT)
+         CALL LCMSIX(IPSAP,' ',2)
+      ENDIF
+      IF(IMPX.GT.0) WRITE(IOUT,'(1X,A)') (COMMEN(I),I=1,NCOMLI)
+      TERP(:NCAL,:NMIX)=0.0
+      MIXC(:NMIX)=0
+*----
+*  READ (INTERP_DATA) AND SET VALI, VALR AND VALH PARAMETERS
+*  CORRESPONDING TO THE INTERPOLATION POINT. FILL MUPLET FOR
+*  PARAMETERS SET WITHOUT INTERPOLATION.
+*----
+      IBM=0
+      MAXNIS=0
+      NISO(:NMIX)=0
+      LISO(:NMIX)=.TRUE.
+      LDELTA(:NMIX)=.FALSE.
+      ITODO(:NMIX,:MD2)=0
+   10 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+      IF(INDIC.NE.3) CALL XABORT('SCRDRV: CHARACTER DATA EXPECTED.')
+   20 IF(TEXT12.EQ.'MIX') THEN
+         MUPLET(:NPAR)=0
+         MUTYPE(:NPAR)=0
+         VALI(:NPAR)=0
+         VALR(:NPAR,1)=0.0
+         VALR(:NPAR,2)=0.0
+         DO 30 I=1,NPAR
+         VALH(I)=' '
+   30    CONTINUE
+         LCUB2(:NPAR)=LCUBIC
+         CALL REDGET(INDIC,IBM,FLOTT,TEXT12,DFLOTT)
+         IF(INDIC.NE.1) CALL XABORT('SCRDRV: INTEGER DATA EXPECTED.')
+         IF(IBM.GT.NMIX) THEN
+            WRITE(HSMG,'(27HSCRDRV: NMIX OVERFLOW (IBM=,I8,6H NMIX=,I8,
+     1      2H).)') IBM,NMIX
+            CALL XABORT(HSMG)
+         ENDIF
+         IBMOLD=1
+         CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('SCRDRV: CHARACTER DATA EXPECTED.')
+         IF(TEXT12.EQ.'FROM') THEN
+            CALL REDGET(INDIC,IBMOLD,FLOTT,TEXT12,DFLOTT)
+            IF(INDIC.NE.1) CALL XABORT('SCRDRV: INTEGER DATA EXPECTED.')
+            IF(IBMOLD.GT.NMIL) CALL XABORT('SCRDRV: SAPHYB MIX OVERFLOW'
+     1      //'(1).')
+            MIXC(IBM)=IBMOLD
+            GO TO 10
+         ELSE IF(TEXT12.EQ.'USE') THEN
+            IF(IBM.GT.NMIL) CALL XABORT('SCRDRV: SAPHYB MIX OVERFLOW'
+     1      //'(2).')
+            MIXC(IBM)=IBM
+            GO TO 10
+         ENDIF
+         MIXC(IBM)=IBMOLD
+         GO TO 20
+      ELSE IF(TEXT12.EQ.'MICRO') THEN
+         IF(IBM.EQ.0) CALL XABORT('SCRDRV: MIX NOT SET (1).')
+         CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('SCRDRV: CHARACTER DATA EXPECTED.')
+         IF(TEXT12.EQ.'ALL') THEN
+            LISO(IBM)=.TRUE.
+         ELSE IF(TEXT12.EQ.'ONLY') THEN
+            LISO(IBM)=.FALSE.
+         ENDIF
+         CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('SCRDRV: CHARACTER DATA EXPECTED.')
+   40    IF(TEXT12.EQ.'ENDMIX') THEN
+            GO TO 20
+         ELSE IF(TEXT12.EQ.'NOEV') THEN
+            IF(NISO(IBM).EQ.0) CALL XABORT('SCRDRV: MISPLACED NOEV.')
+            ITODO(IBM,NISO(IBM))=1
+         ELSE
+            NISO(IBM)=NISO(IBM)+1
+            IF(NISO(IBM).GT.MD2) CALL XABORT('SCRDRV: MD2 OVERFLOW.')
+            MAXNIS=MAX(MAXNIS,NISO(IBM))
+            READ(TEXT12,'(2A4)') (HISO(I0,IBM,NISO(IBM)),I0=1,2)
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+            IF(INDIC.EQ.2) THEN
+               CONC(IBM,NISO(IBM))=FLOTT
+            ELSE IF((INDIC.EQ.3).AND.(TEXT12.EQ.'*')) THEN
+               CONC(IBM,NISO(IBM))=-99.99
+            ELSE
+               CALL XABORT('SCRDRV: INVALID HISO DATA.')
+            ENDIF
+         ENDIF
+         CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('SCRDRV: CHARACTER DATA EXPECTED.')
+         GO TO 40
+      ELSE IF((TEXT12.EQ.'SET').OR.(TEXT12.EQ.'DELTA')) THEN
+         IF(IBM.EQ.0) CALL XABORT('SCRDRV: MIX NOT SET (2).')
+         ITYPE=0
+         IF(TEXT12.EQ.'SET') THEN
+            ITYPE=1
+         ELSE IF(TEXT12.EQ.'DELTA') THEN
+            ITYPE=2
+            LDELTA(IBM)=.TRUE.
+         ENDIF
+         CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+         IF(INDIC.NE.3) CALL XABORT('SCRDRV: CHARACTER DATA EXPECTED.')
+         IF((TEXT12.EQ.'LINEAR').OR.(TEXT12.EQ.'CUBIC')) THEN
+            HCUBIC=TEXT12
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+         ELSE
+            HCUBIC=' '
+         ENDIF
+         IF(INDIC.NE.3) CALL XABORT('SCRDRV: CHARACTER DATA EXPECTED.')
+         DO 50 I=1,NPAR
+         IF(TEXT12.EQ.PARKEY(I)) THEN
+            IPAR=I
+            GO TO 60
+         ENDIF
+   50    CONTINUE
+         CALL XABORT('SCRDRV: PARAMETER '//TEXT12//' NOT FOUND.')
+   60    IF(HCUBIC.EQ.'LINEAR') THEN
+            LCUB2(IPAR)=.FALSE.
+         ELSE IF(HCUBIC.EQ.'CUBIC') THEN
+            LCUB2(IPAR)=.TRUE.
+         ENDIF
+         LPSAP=LCMGID(IPSAP,'paramdescrip')
+         CALL LCMGET(LPSAP,'NVALUE',NVALUE)
+         IF(NVALUE(IPAR).GT.MAXVAL) CALL XABORT('SCRDRV: MAXVAL OVERFL'
+     1   //'OW.')
+         WRITE(RECNAM,'(''pval'',I8)') IPAR
+         LPSAP=LCMGID(IPSAP,'paramvaleurs')
+         CALL LCMLEN(LPSAP,RECNAM,LENGTH,ITYLCM)
+         IF(LENGTH.EQ.0) THEN
+            WRITE(HSMG,'(25HSCRDRV: GLOBAL PARAMETER ,A,9H NOT SET.)')
+     1      PARKEY(IPAR)
+            CALL XABORT(HSMG)
+         ENDIF
+         IF(PARFMT(IPAR).EQ.'ENTIER') THEN
+            IF(ITYPE.NE.1) CALL XABORT('SCRDRV: SET MANDATORY WITH INT'
+     1      //'EGER PARAMETERS.')
+            CALL REDGET(INDIC,VALI(IPAR),FLOTT,TEXT12,DFLOTT)
+            IF(INDIC.NE.1) CALL XABORT('SCRDRV: INTEGER DATA EXPECTED.')
+            CALL LCMGET(LPSAP,RECNAM,VINTE)
+            DO 70 J=1,NVALUE(IPAR)
+            IF(VALI(IPAR).EQ.VINTE(J)) THEN
+               MUPLET(IPAR)=J
+               MUTYPE(IPAR)=ITYPE
+               GO TO 10
+            ENDIF
+   70       CONTINUE
+            WRITE(HSMG,'(26HSCRDRV: INTEGER PARAMETER ,A,9H WITH VAL,
+     1      2HUE,I5,30H NOT FOUND IN SAPHYB DATABASE.)') PARKEY(IPAR),
+     2      VALI(IPAR)
+            CALL XABORT(HSMG)
+         ELSE IF(PARFMT(IPAR).EQ.'FLOTTANT') THEN
+            CALL REDGET(INDIC,NITMA,VALR(IPAR,1),TEXT12,DFLOTT)
+            IF(INDIC.NE.2) CALL XABORT('SCRDRV: REAL DATA EXPECTED.')
+            VALR(IPAR,2)=VALR(IPAR,1)
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+            IF(INDIC.EQ.2) THEN
+               VALR(IPAR,2)=FLOTT
+               CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+            ENDIF
+            CALL LCMGET(LPSAP,RECNAM,VREAL)
+            IF(VALR(IPAR,1).EQ.VALR(IPAR,2)) THEN
+               DO 80 J=1,NVALUE(IPAR)
+               IF(ABS(VALR(IPAR,1)-VREAL(J)).LE.REPS*ABS(VREAL(J))) THEN
+                  MUPLET(IPAR)=J
+                  IF(ITYPE.NE.1) MUPLET(IPAR)=-1
+                  MUTYPE(IPAR)=ITYPE
+                  GO TO 20
+               ENDIF
+   80          CONTINUE
+            ENDIF
+            IF(VALR(IPAR,1).LT.VREAL(1)) THEN
+               WRITE(HSMG,'(23HSCRDRV: REAL PARAMETER ,A,10H WITH VALU,
+     1         1HE,1P,E12.4,25H IS OUTSIDE THE DOMAIN (<,E12.4,1H))')
+     2         PARKEY(IPAR),VALR(IPAR,1),VREAL(1)
+               CALL XABORT(HSMG)
+            ELSE IF(VALR(IPAR,2).GT.VREAL(NVALUE(IPAR))) THEN
+               WRITE(HSMG,'(23HSCRDRV: REAL PARAMETER ,A,10H WITH VALU,
+     1         1HE,1P,E12.4,25H IS OUTSIDE THE DOMAIN (>,E12.4,1H))')
+     2         PARKEY(IPAR),VALR(IPAR,1),VREAL(NVALUE(IPAR))
+               CALL XABORT(HSMG)
+            ELSE IF(VALR(IPAR,1).GT.VALR(IPAR,2)) THEN
+               WRITE(HSMG,'(23HSCRDRV: REAL PARAMETER ,A,9H IS DEFIN,
+     1         7HED WITH,1P,E12.4,2H >,E12.4,1H.)') PARKEY(IPAR),
+     2         VALR(IPAR,1),VALR(IPAR,2)
+               CALL XABORT(HSMG)
+            ENDIF
+            MUPLET(IPAR)=-1
+            MUTYPE(IPAR)=ITYPE
+            GO TO 20
+         ELSE IF(PARFMT(IPAR).EQ.'CHAINE') THEN
+            IF(ITYPE.NE.1) CALL XABORT('SCRDRV: SET MANDATORY WITH STR'
+     1      //'ING PARAMETERS.')
+            CALL REDGET(INDIC,NITMA,FLOTT,VALH(IPAR),DFLOTT)
+            IF(INDIC.NE.3) CALL XABORT('SCRDRV: STRING DATA EXPECTED.')
+            CALL LCMGTC(LPSAP,RECNAM,12,NVALUE(IPAR),VCHAR)
+            DO 90 J=1,NVALUE(IPAR)
+            IF(VALH(IPAR).EQ.VCHAR(J)) THEN
+               MUPLET(IPAR)=J
+               MUTYPE(IPAR)=ITYPE
+               GO TO 10
+            ENDIF
+   90       CONTINUE
+            WRITE(HSMG,'(25HSCRDRV: STRING PARAMETER ,A,10H WITH VALU,
+     1      2HE ,A12,30H NOT FOUND IN SAPHYB DATABASE.)') PARKEY(IPAR),
+     2      VALH(IPAR)
+            CALL XABORT(HSMG)
+         ELSE
+            CALL XABORT('SCRDRV: INVALID FORMAT='//PARFMT(IPAR))
+         ENDIF
+      ELSE IF(TEXT12.EQ.'ENDMIX') THEN
+*----
+*  COMPUTE THE TERP FACTORS USING TABLE-OF-CONTENT INFORMATION.
+*----
+         IF(IMPX.GT.0) THEN
+           DO IPAR=1,NPAR
+             IF(PARFMT(IPAR).EQ.'FLOTTANT')THEN
+               IF(LCUB2(IPAR)) THEN
+                 WRITE(IOUT,'(26H SCRDRV: GLOBAL PARAMETER:,A12,5H ->CU,
+     1           18HBIC INTERPOLATION.)') PARKEY(IPAR)
+               ELSE
+                 WRITE(IOUT,'(26H SCRDRV: GLOBAL PARAMETER:,A12,5H ->LI,
+     1           19HNEAR INTERPOLATION.)') PARKEY(IPAR)
+               ENDIF
+             ENDIF
+           ENDDO
+         ENDIF
+         IF(IBMOLD.GT.NMIL)CALL XABORT('SCRDRV: SAPHYB MIX OVERFLOW'
+     1   //'(3).')
+         IF(IBM.GT.NMIX)CALL XABORT('SCRDRV: MIX OVERFLOW (MICROLIB).')
+         IF(NCAL.EQ.1) THEN
+           TERP(1,IBM)=1.0
+         ELSE
+           CALL SCRTRP(IPSAP,LCUB2,IMPX,NVP,NPAR,NCAL,MUPLET,MUTYPE,
+     1     VALR,0.0,TERP(1,IBM))
+         ENDIF
+         IBM=0
+      ELSE IF((TEXT12.EQ.'SAPHYB').OR.(TEXT12.EQ.'TABLE').OR.
+     1   (TEXT12.EQ.'CHAIN').OR.(TEXT12.EQ.';')) THEN
+*----
+*  CHECK TERP FACTORS AND RETURN
+*----
+         IF(TEXT12.EQ.';') ITER=0
+         IF(TEXT12.EQ.'SAPHYB') ITER=1
+         IF(TEXT12.EQ.'TABLE') ITER=2
+         IF(TEXT12.EQ.'CHAIN') ITER=3
+         DO 150 IBM=1,NMIX
+         IBMOLD=MIXC(IBM)
+         IF(IBMOLD.EQ.0) GO TO 150
+         IF(NISO(IBM).GT.MAXNIS) CALL XABORT('SCRDRV: MAXNIS OVERFLOW.')
+         IF(LDELTA(IBM)) THEN
+            SUM=0.0
+         ELSE
+            SUM=1.0
+         ENDIF
+         DO 140 ICAL=1,NCAL
+         SUM=SUM-TERP(ICAL,IBM)
+  140    CONTINUE
+         IF(ABS(SUM).GT.1.0E-4) THEN
+            WRITE(HSMG,'(43HSCRDRV: INVALID INTERPOLATION FACTORS IN MI,
+     1      5HXTURE,I4,1H.)') IBM
+            CALL XABORT(HSMG)
+         ENDIF
+  150    CONTINUE
+         GO TO 160
+      ELSE
+         CALL XABORT('SCRDRV: '//TEXT12//' IS AN INVALID KEYWORD.')
+      ENDIF
+      GO TO 10
+*----
+*  PRINT INTERPOLATION (TERP) FACTORS
+*----
+  160 IF(IMPX.GT.2) THEN
+        WRITE(IOUT,'(/30H SCRDRV: INTERPOLATION FACTORS)')
+        DO ICAL=1,NCAL
+          DO IBM=1,NMIX
+            IF(TERP(ICAL,IBM).NE.0.0) THEN
+              WRITE(IOUT,170) ICAL,(TERP(ICAL,JBM),JBM=1,NMIX)
+              EXIT
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(LDELTA)
+      RETURN
+  170 FORMAT(6H CALC=,I8,6H TERP=,1P,8E13.5/(20X,8E13.5))
+      END
diff --git a/Donjon/src/SCREIR.f b/Donjon/src/SCREIR.f
new file mode 100644
index 0000000..d70a423
--- /dev/null
+++ b/Donjon/src/SCREIR.f
@@ -0,0 +1,267 @@
+*DECK SCREIR
+      SUBROUTINE SCREIR(NMDEPL,MY1,MY2,MD1,NEL,NOMIS,ADRY,NVTOT,VTOT,
+     > YLDS,DECAY,ITNAM,ITZEA,KPAX,BPAX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Read depletion data on input file. Based on LIBEIR.f routine in
+* DRAGON.
+*
+*Copyright:
+* Copyright (C) 2014 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version.
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* NMDEPL  names of reactions:
+*           NMDEPL(1)='DECAY'; NMDEPL(2)='NFTOT';
+*           NMDEPL(3)='NG'   ; NMDEPL(4)='N2N';
+*           etc
+* MY1     first dimension of matrix YLDS
+* MY2     number of particularized fission products
+* MD1     number of types of radioactive decay reactions
+* NEL     number of particularized isotopes including macro
+* NOMIS   names of isotopes in chain
+* ADRY    indices of fissile isotopes (positive values) and fission
+*         products (negative values) in array YLDS
+* NVTOT   number of Saphyb calls
+* VTOT    volume of updated core per Saphyb call
+* YLDS    fission yields
+* DECAY   radioactive decay constants
+*
+*Parameters: output
+* ITNAM   reactive isotope names in chain
+* ITZEA   6-digit nuclide identifier
+*         atomic number z*10000 (digits) + mass number a*10 +
+*         energy state (0 = ground state, 1 = first state, etc.)
+* KPAX    complete reaction type matrix
+* BPAX    complete branching ratio matrix
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  INPUT FORMAT
+*----
+*    CHAIN
+*    [[ hnamson [ izea ]
+*      [ [[ reaction [energy] ]]  ]
+*    [ { STABLE |
+*       FROM  [[ { DECAY | reaction }
+*          [[ yield hnampar ]] ]] } ]
+*    ]]
+*    ENDCHAIN
+*
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER, PARAMETER::MAXR=12
+      INTEGER MY1,MY2,MD1,NEL,ADRY(NEL),NVTOT,ITNAM(3,NEL),
+     > ITZEA(NEL),KPAX(NEL+MAXR,NEL)
+      CHARACTER NMDEPL(MAXR)*8,NOMIS(NEL)*8
+      REAL BPAX(NEL+MAXR,NEL)
+      DOUBLE PRECISION VTOT(NVTOT),YLDS(MY1,MY2,NVTOT),
+     > DECAY(MD1,NEL,NVTOT)
+*----
+*  INPUT FILE PARAMETERS
+*----
+      CHARACTER TEXT12*12
+      INTEGER KNADPL(2)
+      DOUBLE PRECISION DBLINP
+*----
+*  INTERNAL PARAMETERS
+*   KFISSP : FISSION PRODUCT FLAG = 2 (POSITION OF NFTOT IN NMDEPL)
+*----
+      INTEGER KFISSP
+      PARAMETER (KFISSP=2)
+      CHARACTER HSMG*131
+      INTEGER INDIC,NITMA,I0,IEL,JEL,IDEPL,INTG,IREAC,ISOT,JREL,JDEPL,
+     > IY1,IY2,IV
+      REAL FLOTT,RRAT
+      DOUBLE PRECISION ZN,ZD
+*----
+*  READ LIST OF ISOTOPES AND PROPERTIES
+*----
+      DO 70 IY1=1,MY1
+        IEL=0
+        DO I0=1,NEL
+          IF(ADRY(I0).EQ.IY1) THEN
+*           IEL is a fissile isotope
+            IEL=I0
+          ENDIF
+        ENDDO
+        IF(IEL.EQ.0) GO TO 70
+        DO 60 IY2=1,MY2
+          JEL=0
+          DO I0=1,NEL
+            IF(-ADRY(I0).EQ.IY2) THEN
+*             JEL is a fission fragment
+              JEL=I0
+            ENDIF
+          ENDDO
+          IF(JEL.EQ.0) GO TO 60
+          KPAX(JEL,IEL)=KFISSP
+          ZN=0.0D0
+          ZD=0.0D0
+          DO IV=1,NVTOT
+            ZN=ZN+YLDS(IY1,IY2,IV)*VTOT(IV)
+            ZD=ZD+VTOT(IV)
+          ENDDO
+          BPAX(JEL,IEL)=REAL(ZN/ZD)
+   60   CONTINUE
+   70 CONTINUE
+      DO 100 IEL=1,NEL
+        TEXT12=' '
+        TEXT12(:8)=NOMIS(IEL)
+        READ(TEXT12,'(3A4)') (ITNAM(I0,IEL),I0=1,3)
+        KPAX(NEL+1,IEL)=1
+        BPAX(NEL+1,IEL)=0.0
+        DO 80 I0=1,MD1
+        ZN=0.0D0
+        ZD=0.0D0
+        DO IV=1,NVTOT
+          ZN=ZN+DECAY(I0,IEL,IV)*VTOT(IV)
+          ZD=ZD+VTOT(IV)
+        ENDDO
+        BPAX(NEL+1,IEL)=BPAX(NEL+1,IEL)+REAL(ZN/ZD)*1.0E8
+   80   CONTINUE
+  100 CONTINUE
+      CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP)
+  105 IF(INDIC.NE.3) CALL XABORT('SCREIR: CHARACTER DATA EXPECTED')
+*----
+*  EXIT IF ENDCHAIN READ
+*----
+      IF(TEXT12.EQ.'ENDCHAIN') GO TO 190
+*----
+*  ISOTOPE NAME READ
+*  IF NAME ALREADY EXISTS SELECT ISOTOPE NUMBER
+*  IF NAME NOT DEFINED ADD TO ISOTOPE LIST
+*----
+      IDEPL=0
+      READ(TEXT12,'(2A4)') KNADPL(1),KNADPL(2)
+      DO 110 JEL=1,NEL
+        IF(KNADPL(1).EQ.ITNAM(1,JEL).AND.
+     >     KNADPL(2).EQ.ITNAM(2,JEL)) THEN
+          IDEPL=JEL
+          GO TO 115
+        ENDIF
+ 110  CONTINUE
+      WRITE(HSMG,'(16HSCREIR: ISOTOPE ,2A4,24H IS MISSING AMONG PARTIC,
+     > 35HULARIZED ISOTOPES OF THE SAPHYB(1).)') KNADPL(1),KNADPL(2)
+      CALL XABORT(HSMG)
+*----
+*  READ IZEA
+*----
+ 115  CALL REDGET(INDIC,INTG,FLOTT,TEXT12,DBLINP)
+      IF(INDIC.EQ.1) THEN
+         ITZEA(IDEPL)=INTG
+         CALL REDGET(INDIC,INTG,FLOTT,TEXT12,DBLINP)
+      ELSE
+         ITZEA(IDEPL)=0
+      ENDIF
+*----
+*  LOOP OVER ALL PARAMETERS ASSOCIATED WITH SON ISOTOPES
+*----
+ 120  IF(INDIC.NE.3) CALL XABORT('SCREIR: REACTION TYPE EXPECTED FOR'
+     > //' ISOTOPE '//TEXT12)
+*----
+*  IF KEYWORD IS 'FROM' READ LIST OF PARENT NUCLIDES
+*----
+      IF(TEXT12.EQ.'FROM') THEN
+*----
+*  LOOP OVER ALL PARAMETERS ASSOCIATED WITH PARENT ISOTOPES
+*----
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP)
+ 130    IF(INDIC.NE.3) CALL XABORT('SCREIR: REACTION TYPE EXPECTED.')
+        DO 140 IREAC=1,MAXR
+          RRAT=1.0
+*----
+*  TEST IF KEYWORD IS A REACTION
+*----
+          IF(TEXT12.EQ.NMDEPL(IREAC)) THEN
+*----
+*  READ LIST OF YIELD AND PARENT ISOTOPES
+*----
+            JDEPL=0
+            DO 150 JEL=1,NEL
+*----
+*  IF YIELD ABSENT GO TO TEST FOR NEW REACTION TYPE
+*----
+              CALL REDGET(INDIC,ISOT,RRAT,TEXT12,DBLINP)
+              IF(INDIC.NE.2) GO TO 130
+              CALL REDGET(INDIC,ISOT,FLOTT,TEXT12,DBLINP)
+              IF(INDIC.NE.3)
+     >          CALL XABORT('SCREIR: ISOTOPE NAME hnampar MISSING')
+*----
+*  ISOTOPE NAME READ
+*  IF NAME ALREADY EXISTS SELECT ISOTOPE NUMBER
+*  IF NAME NOT DEFINED ADD TO ISOTOPE LIST
+*----
+              READ(TEXT12,'(2A4)') KNADPL(1),KNADPL(2)
+              DO 160 JREL=1,NEL
+                IF(KNADPL(1).EQ.ITNAM(1,JREL).AND.
+     >             KNADPL(2).EQ.ITNAM(2,JREL)) THEN
+                  JDEPL=JREL
+                  GO TO 165
+                ENDIF
+ 160          CONTINUE
+              WRITE(HSMG,'(16HSCREIR: ISOTOPE ,2A4,16H IS MISSING AMON,
+     >        43HG PARTICULARIZED ISOTOPES OF THE SAPHYB(2).)')
+     >        KNADPL(1),KNADPL(2)
+              CALL XABORT(HSMG)
+ 165          KPAX(IDEPL,JDEPL)=IREAC
+              BPAX(IDEPL,JDEPL)=RRAT
+ 150        CONTINUE
+            CALL XABORT('SCREIR: TO MANY PARENT ISOTOPES')
+          ENDIF
+ 140    CONTINUE
+      ELSE IF(TEXT12.EQ.'STABLE') THEN
+        DO 141 IREAC=1,MAXR
+        IF(KPAX(NEL+IREAC,IDEPL).NE.0) KPAX(NEL+IREAC,IDEPL)=-9999
+ 141    CONTINUE
+        DO 142 IEL=1,NEL
+        KPAX(IDEPL,IEL)=0
+ 142    CONTINUE
+        CALL REDGET(INDIC,INTG,FLOTT,TEXT12,DBLINP)
+*----
+*  READ NEXT KEYWORD FOR THIS ISOTOPE
+*----
+      ELSE
+        DO 170 IREAC=1,MAXR
+          RRAT=0.0
+          IF(TEXT12.EQ.NMDEPL(IREAC)) THEN
+            CALL REDGET(INDIC,ISOT,RRAT,TEXT12,DBLINP)
+            IF(INDIC.EQ.1) THEN
+              CALL XABORT('SCREIR: INVALID INTEGER')
+            ELSE IF(INDIC.EQ.2) THEN
+              CALL REDGET(INDIC,INTG,FLOTT,TEXT12,DBLINP)
+            ENDIF
+            KPAX(NEL+IREAC,IDEPL)=1
+            BPAX(NEL+IREAC,IDEPL)=RRAT
+*----
+*  READ NEXT KEYWORD FOR THIS ISOTOPE
+*----
+            GO TO 120
+          ENDIF
+ 170    CONTINUE
+      ENDIF
+      GO TO 105
+*----
+*  FIND FISSION PRODUCTS
+*----
+ 190  DO 200 IEL=1,NEL
+        DO 210 JEL=1,NEL
+          IF(KPAX(JEL,IEL).EQ.KFISSP) KPAX(NEL+KFISSP,JEL)=-1
+ 210    CONTINUE
+ 200  CONTINUE
+*----
+*  RETURN FROM SCREIR
+*----
+      RETURN
+      END
diff --git a/Donjon/src/SCRFND.f b/Donjon/src/SCRFND.f
new file mode 100644
index 0000000..2837fd3
--- /dev/null
+++ b/Donjon/src/SCRFND.f
@@ -0,0 +1,86 @@
+*DECK SCRFND
+      SUBROUTINE SCRFND(MAXISO,NBISOI,NBISO,INAME,IBM,HRESID,HUSE,HNAME,
+     > IMIX,JSO)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Find the isotope index of an isotope in the microlib.
+*
+*Copyright:
+* Copyright (C) 2017 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* MAXISO  maximum number of isotopes in the microlib.
+* NBISOI  initial number of isotopes in the microlib.
+* NBISO   exact number of isotopes in the microlib.
+* INAME   name of an isotope.
+* IBM     mixture in which the isotope is present.
+* HRESID  character*8 name of the residual isotope in the Saphyb.
+* HUSE    alias names of microlib isotopes.
+* HNAME   reference name of microlib isotopes.
+* IMIX    full-core mixture belonging to each isotope.
+*
+*Parameters: output
+* NBISO   exact number of isotopes in the microlib.
+* HUSE    names of microlib isotopes.
+* HNAME   reference name of microlib isotopes.
+* IMIX    full-core mixture belonging to each isotope.
+* JSO     position of isotope INAME in isotope list.
+*
+*-----------------------------------------------------------------------
+*
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER MAXISO,NBISOI,NBISO,INAME(2),IBM,HUSE(3,MAXISO),
+     > HNAME(3,MAXISO),IMIX(MAXISO),JSO
+      CHARACTER HRESID*8
+*----
+*  LOCAL VARIABLES
+*----
+      CHARACTER TEXT4*4,TEXT8*8
+      INTEGER IBLANK, I0, ISO, ISAVE
+      INTEGER IHRES(2)
+      SAVE IBLANK,IHRES,ISAVE
+      DATA TEXT4,TEXT8/'    ','*MAC*RES'/
+      DATA ISAVE/0/
+*
+      IF(ISAVE.EQ.0) THEN
+        READ(TEXT4,'(A4)') IBLANK
+        READ(TEXT8,'(2A4)') IHRES(1),IHRES(2)
+        ISAVE=1   
+      ENDIF
+*
+      JSO=0
+      DO ISO=1,NBISOI
+        IF(IMIX(ISO).NE.IBM) CYCLE
+        IF((INAME(1).EQ.HUSE(1,ISO)).AND.(INAME(2).EQ.HUSE(2,ISO))) THEN
+          JSO=ISO
+          RETURN
+        ENDIF
+      ENDDO
+      NBISO=NBISO+1
+      IF(NBISO.GT.MAXISO) CALL XABORT('SCRFND: MAXISO OVERFLOW.')
+      JSO=NBISO
+      HUSE(1,JSO)=INAME(1)
+      HUSE(2,JSO)=INAME(2)
+      HUSE(3,JSO)=IBLANK
+      IF((INAME(1).EQ.IHRES(1)).AND.(INAME(2).EQ.IHRES(2))) THEN
+        READ(HRESID,'(2A4)') (HNAME(I0,JSO),I0=1,2)
+      ELSE
+        HNAME(1,JSO)=INAME(1)
+        HNAME(2,JSO)=INAME(2)
+      ENDIF
+      HNAME(3,JSO)=IBLANK
+      IMIX(JSO)=IBM
+      RETURN
+      END
diff --git a/Donjon/src/SCRISO.f b/Donjon/src/SCRISO.f
new file mode 100644
index 0000000..dc381e8
--- /dev/null
+++ b/Donjon/src/SCRISO.f
@@ -0,0 +1,269 @@
+*DECK SCRISO
+      SUBROUTINE SCRISO(IPLIB,NREA,NGRP,NL,NPRC,NOMREA,NWT0,XS,SIGS,
+     > SS2D,TAUXFI,LXS,LAMB,CHIRS,BETAR,INVELS,INAME,LSTRD,LPURE,ILUPS,
+     > ITRANC,IFISS)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Store an isotopic data recovered from a Saphyb into a Microlib.
+*
+*Copyright:
+* Copyright (C) 2012 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPLIB   address of the output microlib LCM object
+* NREA    number of reactions in the Saphyb object
+* NGRP    number of energy groups
+* NL      maximum Legendre order (NL=1 is for isotropic scattering)
+* NPRC    number of delayed neutron precursor groups
+* NOMREA  names of reactions in the Saphyb
+* NWT0    average flux
+* XS      cross sections per reaction
+* SIGS    scattering cross sections
+* SS2D    complete scattering matrix
+* TAUXFI  interpolated fission rate
+* LXS     existence flag of each reaction
+* LAMB    decay constants of the delayed neutron precursor groups
+* CHIRS   delayed neutron emission spectrums
+* BETAR   delayed neutron fractions
+* INVELS  group-average of the inverse neutron velocity
+* INAME   name of the isotope.
+* LSTRD   flag set to .true. if B2=0.0.
+* LPURE   =.true. if the interpolation is a pure linear interpolation 
+*         with TERP factors.
+* ILUPS   up-scattering removing flag (=1 to remove up-scattering from
+*         output cross-sections).
+*
+*Parameters: output
+* ITRANC  transport correction flag
+* IFISS   fission flag
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPLIB
+      INTEGER NREA,NGRP,NL,NPRC,INAME(2),ILUPS,ITRANC,IFISS
+      REAL NWT0(NGRP),XS(NGRP,NREA),SIGS(NGRP,NL),SS2D(NGRP,NGRP,NL),
+     > TAUXFI,LAMB(NPRC),CHIRS(NGRP,NPRC),BETAR(NPRC),INVELS(NGRP)
+      LOGICAL LXS(NREA),LSTRD,LPURE
+      CHARACTER NOMREA(NREA)*12
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER I0, IGFROM, IGMAX, IGMIN, IGR, JGR, IGTO, ILEG, IPRC,
+     & IREA, NXSCMP, IL, IRENT0,IRENT1
+      REAL FF,CSCAT
+      LOGICAL LDIFF,LZERO
+      CHARACTER TEXT12*12
+      CHARACTER HCM(0:10)*2,NAMLEG*2
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: ITYPRO,NJJ,IJJ
+      REAL, ALLOCATABLE, DIMENSION(:) :: STRD,WRK,XSSCMP
+      DATA HCM  /'00','01','02','03','04','05','06','07','08','09','10'/
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(STRD(NGRP))
+*----
+*  UP-SCATTERING CORRECTION
+*----
+      IF(ILUPS.EQ.1) THEN
+        IRENT0=0
+        IRENT1=0
+        DO IREA=1,NREA
+          IF(NOMREA(IREA).EQ.'TOTALE') IRENT0=IREA
+          IF(NOMREA(IREA).EQ.'TOTALE P1') IRENT1=IREA
+        ENDDO
+        IF(IRENT0.EQ.0) CALL XABORT('SCRISO: MISSING NTOT0.')
+        DO JGR=2,NGRP
+          DO IGR=1,JGR-1 ! IGR < JGR
+            CSCAT=SS2D(IGR,JGR,1)
+            FF=NWT0(JGR)/NWT0(IGR)
+            XS(IGR,IRENT0)=XS(IGR,IRENT0)-CSCAT*FF
+            XS(JGR,IRENT0)=XS(JGR,IRENT0)-CSCAT
+            IF((IRENT1.GT.0).AND.(NL.GT.1)) THEN
+              CSCAT=SS2D(IGR,JGR,2)
+              XS(IGR,IRENT1)=XS(IGR,IRENT1)-CSCAT*FF
+              XS(JGR,IRENT1)=XS(JGR,IRENT1)-CSCAT
+            ENDIF
+            DO IL=1,NL
+              CSCAT=SS2D(IGR,JGR,IL)
+              SIGS(IGR,IL)=SIGS(IGR,IL)-CSCAT*FF
+              SIGS(JGR,IL)=SIGS(JGR,IL)-CSCAT
+              SS2D(JGR,IGR,IL)=SS2D(JGR,IGR,IL)-CSCAT*FF
+              SS2D(IGR,JGR,IL)=0.0
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF
+*----
+*  BUILD MICROLIB
+*----
+      WRITE(TEXT12,'(2A4)') (INAME(I0),I0=1,2)
+      CALL LCMPTC(IPLIB,'ALIAS',12,TEXT12)
+      CALL LCMPUT(IPLIB,'NWT0',NGRP,2,NWT0)
+      IF(NPRC.GT.0) THEN
+        CALL LCMPUT(IPLIB,'LAMBDA-D',NPRC,2,LAMB)
+        CALL LCMPUT(IPLIB,'OVERV',NGRP,2,INVELS)
+      ENDIF
+      ITRANC=0
+      IFISS=0
+      LDIFF=.FALSE.
+      STRD(:NGRP)=0.0
+      DO IREA=1,NREA
+        IF(.NOT.LXS(IREA)) CYCLE
+        LZERO=.TRUE.
+        DO IGR=1,NGRP
+          LZERO=LZERO.AND.(XS(IGR,IREA).EQ.0.0)
+        ENDDO
+        IF(LZERO) CYCLE
+        IF(NOMREA(IREA).EQ.'TOTALE') THEN
+          IF(LSTRD) THEN
+            DO IGR=1,NGRP
+              STRD(IGR)=STRD(IGR)+XS(IGR,IREA)
+            ENDDO
+          ENDIF
+          CALL LCMPUT(IPLIB,'NTOT0',NGRP,2,XS(1,IREA))
+        ELSE IF(NOMREA(IREA).EQ.'TOTALE P1') THEN
+          CALL LCMPUT(IPLIB,'NTOT1',NGRP,2,XS(1,IREA))
+        ELSE IF(NOMREA(IREA).EQ.'EXCESS') THEN
+*         correct scattering XS with excess XS
+          DO IGR=1,NGRP
+            SIGS(IGR,1)=SIGS(IGR,1)+XS(IGR,IREA)
+          ENDDO
+          CALL LCMPUT(IPLIB,'N2N',NGRP,2,XS(1,IREA))
+        ELSE IF(NOMREA(IREA).EQ.'FISSION') THEN
+          CALL LCMPUT(IPLIB,'NFTOT',NGRP,2,XS(1,IREA))
+        ELSE IF(NOMREA(IREA).EQ.'ABSORPTION') THEN
+          CALL LCMPUT(IPLIB,'NG',NGRP,2,XS(1,IREA))
+        ELSE IF(NOMREA(IREA).EQ.'SPECTRE') THEN
+          IF(.NOT.LPURE) THEN
+            DO IGR=1,NGRP
+              IF(XS(IGR,IREA).NE.0.0) THEN
+                XS(IGR,IREA)=XS(IGR,IREA)/TAUXFI
+              ENDIF
+            ENDDO
+          ENDIF
+          CALL LCMPUT(IPLIB,'CHI',NGRP,2,XS(1,IREA))
+          DO IPRC=1,NPRC
+            WRITE(TEXT12,'(A3,I2.2)') 'CHI',IPRC
+            CALL LCMPUT(IPLIB,TEXT12,NGRP,2,CHIRS(1,IPRC))
+          ENDDO
+        ELSE IF(NOMREA(IREA).EQ.'NU*FISSION') THEN
+          IFISS=1
+          CALL LCMPUT(IPLIB,'NUSIGF',NGRP,2,XS(1,IREA))
+          IF(NPRC.GT.0) THEN
+            ALLOCATE(WRK(NGRP))
+            DO IPRC=1,NPRC
+              DO IGR=1,NGRP
+                WRK(IGR)=XS(IGR,IREA)*BETAR(IPRC)
+              ENDDO
+              WRITE(TEXT12,'(A6,I2.2)') 'NUSIGF',IPRC
+              CALL LCMPUT(IPLIB,TEXT12,NGRP,2,WRK)
+            ENDDO
+            DEALLOCATE(WRK)
+          ENDIF
+        ELSE IF(NOMREA(IREA).EQ.'ENERGIE') THEN
+          ALLOCATE(WRK(NGRP))
+          DO IGR=1,NGRP
+            WRK(IGR)=XS(IGR,IREA)*1.0E6 ! convert MeV to eV
+          ENDDO
+          CALL LCMPUT(IPLIB,'H-FACTOR',NGRP,2,WRK)
+          DEALLOCATE(WRK)
+        ELSE IF(NOMREA(IREA).EQ.'SELF') THEN
+          CALL LCMPUT(IPLIB,'SIGW00',NGRP,2,XS(1,IREA))
+        ELSE IF(NOMREA(IREA).EQ.'TRANSP-CORR') THEN
+          ITRANC=2
+          IF(LSTRD) THEN
+            DO IGR=1,NGRP
+              STRD(IGR)=STRD(IGR)-XS(IGR,IREA)
+            ENDDO
+          ENDIF
+          CALL LCMPUT(IPLIB,'TRANC',NGRP,2,XS(1,IREA))
+        ELSE IF(NOMREA(IREA).EQ.'FUITES') THEN
+          LDIFF=LSTRD
+          IF(.NOT.LSTRD) THEN
+            DO IGR=1,NGRP
+              LDIFF=LDIFF.OR.(XS(IGR,IREA).NE.0.0)
+              STRD(IGR)=XS(IGR,IREA)
+            ENDDO
+          ENDIF
+        ELSE IF(NOMREA(IREA).EQ.'DIFFUSION') THEN
+          CYCLE
+        ELSE IF(NOMREA(IREA).EQ.'TRANSFERT') THEN
+          CYCLE
+        ELSE
+          CALL LCMPUT(IPLIB,NOMREA(IREA),NGRP,2,XS(1,IREA))
+        ENDIF
+      ENDDO
+      IF(LSTRD) THEN
+        IF((ITRANC.EQ.0).AND.(NL.GT.1)) THEN
+*         Apollo-type transport correction
+          DO IGR=1,NGRP
+            STRD(IGR)=STRD(IGR)-SIGS(IGR,2)
+          ENDDO
+        ENDIF
+      ELSE
+        DO IGR=1,NGRP
+          STRD(IGR)=1.0/(3.0*STRD(IGR))
+        ENDDO
+      ENDIF
+      IF((ITRANC.EQ.0).AND.(NL.GT.1)) THEN
+*       Apollo-type transport correction
+        ITRANC=2
+        CALL LCMPUT(IPLIB,'TRANC',NGRP,2,SIGS(1,2))
+      ENDIF
+      IF(LDIFF.OR.LSTRD) CALL LCMPUT(IPLIB,'STRD',NGRP,2,STRD)
+*----
+*  SAVE SCATTERING VECTORS AND MATRICES (DO NOT USE XDRLGS TO SAVE CPU
+*  TIME)
+*----
+      ALLOCATE(NJJ(NGRP),IJJ(NGRP),XSSCMP(NGRP*NGRP),ITYPRO(NL))
+      DO ILEG=1,NL
+        IF(ILEG.LE.11) THEN
+          NAMLEG=HCM(ILEG-1)
+        ELSE
+          WRITE(NAMLEG,'(I2.2)') ILEG-1
+        ENDIF
+        CALL LCMPUT(IPLIB,'SIGS'//NAMLEG,NGRP,2,SIGS(1,ILEG))
+        NXSCMP=0
+        DO IGTO=1,NGRP
+          IGMIN=IGTO
+          IGMAX=IGTO
+          DO IGFROM=1,NGRP
+            IF(SS2D(IGTO,IGFROM,ILEG).NE.0.0) THEN
+              IGMIN=MIN(IGMIN,IGFROM)
+              IGMAX=MAX(IGMAX,IGFROM)
+            ENDIF
+          ENDDO
+          IJJ(IGTO)=IGMAX
+          NJJ(IGTO)=IGMAX-IGMIN+1
+          DO IGFROM=IGMAX,IGMIN,-1
+            NXSCMP=NXSCMP+1
+            XSSCMP(NXSCMP)=SS2D(IGTO,IGFROM,ILEG)
+          ENDDO
+        ENDDO
+        CALL LCMPUT(IPLIB,'NJJS'//NAMLEG,NGRP,1,NJJ)
+        CALL LCMPUT(IPLIB,'IJJS'//NAMLEG,NGRP,1,IJJ)
+        CALL LCMPUT(IPLIB,'SCAT'//NAMLEG,NXSCMP,2,XSSCMP)
+        ITYPRO(ILEG)=1
+      ENDDO
+      CALL LCMPUT(IPLIB,'SCAT-SAVED',NL,1,ITYPRO)
+      DEALLOCATE(ITYPRO,XSSCMP,IJJ,NJJ)
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(STRD)
+      RETURN
+      END
diff --git a/Donjon/src/SCRLIB.f b/Donjon/src/SCRLIB.f
new file mode 100644
index 0000000..5b98de3
--- /dev/null
+++ b/Donjon/src/SCRLIB.f
@@ -0,0 +1,1052 @@
+*DECK SCRLIB
+      SUBROUTINE SCRLIB(MAXNIS,MAXISO,IPLIB,IPMEM,IACCS,NMIX,NGRP,IMPX,
+     1 HEQUI,HMASL,NCAL,ITER,MY1,MY2,MD1,MD2,TERP,NISO,LISO,HISO,CONC,
+     2 ITODO,MIXC,LRES,LPURE,ILUPS,B2,VTOT,YLDS,DECAYC)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Build the Microlib by scanning the NCAL elementary calculations in
+* a Saphyb and weighting them with TERP factors.
+*
+*Copyright:
+* Copyright (C) 2012 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* MAXNIS  maximum value of NISO(I) in user data.
+* MAXISO  maximum allocated space for output Microlib TOC information.
+* IPLIB   address of the output Microlib LCM object.
+* IPMEM   pointer to the memory-resident Saphyb object.
+* IACCS   =0 Microlib is created; =1 ... is updated.
+* NMIX    maximum number of material mixtures in the Microlib.
+* NGRP    number of energy groups.
+* IMPX    print parameter (equal to zero for no print).
+* HEQUI   keyword of SPH-factor set to be recovered.
+* HMASL   keyword of MASL data set to be recovered.
+* NCAL    number of elementary calculations in the Saphyb.
+* ITER    completion flag (=0: compute the macrolib).
+* MY1     number of fissile isotopes including macroscopic sets.
+* MY2     number of fission fragment.
+* MD1     number of types of radioactive decay reactions.
+* MD2     number of particularized isotopes including macro.
+* TERP    interpolation factors.
+* NISO    number of user-selected isotopes.
+* LISO    type of treatment (=.true.: ALL; =.false.: ONLY).
+* HISO    name of the user-selected isotopes.
+* CONC    user-defined number density of the user-selected isotopes. A
+*         value of -99.99 is set to indicate that the Saphyb value is
+*         used.
+* ITODO   non-depletion mask (=1 to force a user-selected isotope to be
+*         non-depleting)
+* MIXC    mixture index in the Saphyb corresponding to each Microlib
+*         mixture. Equal to zero if a Microlib mixture is not updated.
+* LRES    =.true. if the interpolation is done without updating isotopic 
+*         densities
+* LPURE   =.true. if the interpolation is a pure linear interpolation 
+*         with TERP factors.
+* ILUPS   up-scattering removing flag (=1 to remove up-scattering from
+*         output cross-sections).
+* B2      buckling
+* VTOT    volume of updated core.
+* YLDS    fission yields.
+* DECAYC  radioactive decay constants.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPLIB,IPMEM
+      INTEGER MAXNIS,MAXISO,IACCS,NMIX,NGRP,IMPX,NCAL,ITER,MY1,MY2,MD1,
+     1 MD2,NISO(NMIX),HISO(2,NMIX,MAXNIS),ITODO(NMIX,MAXNIS),MIXC(NMIX),
+     2 ILUPS
+      REAL TERP(NCAL,NMIX),CONC(NMIX,MAXNIS),B2
+      DOUBLE PRECISION VTOT,YLDS(MY1,MY2),DECAYC(MD1,MD2)
+      LOGICAL LISO(NMIX),LRES,LPURE
+      CHARACTER HEQUI*4,HMASL*4
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXLOC=10
+      INTEGER, PARAMETER::MAXDIV=3
+      INTEGER, PARAMETER::MAXMAC=2
+      INTEGER, PARAMETER::MAXREA=50
+      INTEGER, PARAMETER::NSTATE=40
+      TYPE(C_PTR) JPLIB,KPLIB,JPMEM,KPMEM,LPMEM,MPMEM
+      REAL B2SAP, FACT0, WEIGHT
+      INTEGER I, I0, IAD, IBM, IBMOLD, ICAL, ID1, IED2, IFISS, IGR,
+     & ILENG, ILOC, ILONG, IMAC, IOF, IPRC, IREA, IREAF, IRES, IS2,
+     & ISO, ISOKEP, ITRANC, ITSTMP, ITYLCM, IY1, IY2, JSIGS, JSO, 
+     & JSS2D, JXS, KSO, KSO1, LMY1, LSO, MAXMIX, NADRX, NBISO, NBISO1,
+     & NBISO2, NBISO2I, NBS1, NCALS, NDATAP, NDATAX, NED2, NISF, NISOP,
+     & NISOT2, NISOTS, NISP, NL, NLAM, NLOC, NMAC, NMIL, NPARL, NPR,
+     & NPRC, NREA, NSURFD, NVDIV
+      CHARACTER TEXT12*12,HSMG*131,HVECT2(MAXREA)*8,NOMREA(MAXREA)*12,
+     1 LOCTYP(MAXLOC)*4,LOCKEY(MAXLOC)*4,IDVAL(MAXDIV)*4,HHISO*8,
+     2 NOMMAC(MAXMAC)*8,HRESID*8,HNISO*12
+      INTEGER ISTATE(NSTATE),DIMSAP(50),INAME(2),IHRES(2)
+      REAL VALDIV(MAXDIV),TMPDAY(3)
+      LOGICAL LUSER,LSPH,LMASL,LSTRD
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IMIX2,ITOTM,IRESM,IADRX,
+     1 ISOTS,LOCAD,ISADRX,LENGDX,LENGDP,IDATA,ISONA,ISOMI,ITOD2,ISTY1,
+     2 ISTY2,IPIFI,IMICR,ITOD1,JJSO,IPYMIX
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: INOMIS,HUSE2,HNAM2,IPYNAM
+      REAL, ALLOCATABLE, DIMENSION(:) :: DENS2,DENS3,VOL2,VOLMI2,SPH,
+     1 ENER,XVOLM,CONCE,TAUXFI,NWT0,SIGS,SS2D,XS,RVALO,FLUXS,RDATA,
+     2 SIGSB,SS2DB,XSB,DENIS,GAR1,GAR2,LAMB,CHIRS,BETAR,INVELS,CHIRSB,
+     3 BETARB,INVELSB,SURF,FMASL
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: DENS1,FACT,YLDS2,DECAY2,
+     1 SURFLX
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: DENS0,FLUX,ADF2
+      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: YLDSM
+      LOGICAL, ALLOCATABLE, DIMENSION(:) :: LXS,MASK,MASKL
+      CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: HADF
+*----
+*  RECOVER THE NUMBER OF DISCONTINUITY FACTORS
+*----
+      NSURFD=0
+      CALL LCMSIX(IPMEM,'geom',1)
+      CALL LCMLEN(IPMEM,'outgeom',ILONG,ITYLCM)
+      IF(ILONG.NE.0) THEN
+        CALL LCMSIX(IPMEM,'outgeom',1)
+        CALL LCMLEN(IPMEM,'SURF',NSURFD,ITYLCM)
+        IF(IMPX.GT.1) THEN
+          WRITE(IOUT,'(42H SCRLIB: number of discontinuity factors =,
+     1    I4/)') NSURFD
+        ENDIF
+        CALL LCMSIX(IPMEM,' ',2)
+      ENDIF
+      CALL LCMSIX(IPMEM,' ',2)
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(IMIX2(MAXISO),ITOD2(MAXISO),ISTY1(MAXISO),ISTY2(MAXISO),
+     1 HUSE2(3,MAXISO),HNAM2(3,MAXISO))
+      ALLOCATE(DENS2(MAXISO),DENS3(MAXISO),VOL2(MAXISO),VOLMI2(NMIX),
+     1 FLUX(NMIX,NGRP,2),SPH(NGRP),FMASL(NMIX))
+       ALLOCATE(HADF(NSURFD),ADF2(NMIX,NGRP,NSURFD))
+*----
+*  MICROLIB INITIALIZATION
+*----
+      VOLMI2(:NMIX)=0.0
+      DENS2(:MAXISO)=0.0
+      VOL2(:MAXISO)=0.0
+      IMIX2(:MAXISO)=0
+      ITOD2(:MAXISO)=0
+      ISTY2(:MAXISO)=0
+      IF(IACCS.EQ.0) THEN
+         IF(LRES) CALL XABORT('SCRLIB: RES OPTION IS INVALID.')
+         NBISO2=0
+         NED2=0
+         TEXT12='L_LIBRARY'
+         CALL LCMPTC(IPLIB,'SIGNATURE',12,TEXT12)
+      ELSE
+         CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+         IF(ISTATE(1).NE.NMIX) CALL XABORT('SCRLIB: INVALID NUMBER OF '
+     1   //'MATERIAL MIXTURES IN THE MICROLIB.')
+         IF(ISTATE(3).NE.NGRP) CALL XABORT('SCRLIB: INVALID NUMBER OF '
+     1   //'ENERGY GROUPS IN THE MICROLIB.')
+         NBISO2=ISTATE(2)
+         IF(NBISO2.GT.MAXISO) CALL XABORT('SCRLIB: MAXISO OVERFLOW(1).')
+         NED2=ISTATE(13)
+         IF(NED2.GT.MAXREA) CALL XABORT('SCRLIB: MAXREA OVERFLOW(1).')
+         CALL LCMLEN(IPLIB,'MIXTURESVOL',ILONG,ITYLCM)
+         IF(ILONG.GT.0) THEN
+           CALL LCMGET(IPLIB,'MIXTURESVOL',VOLMI2)
+         ELSE
+           VOLMI2(:NMIX)=0.0
+         ENDIF
+         CALL LCMGET(IPLIB,'ISOTOPESUSED',HUSE2)
+         CALL LCMGET(IPLIB,'ISOTOPERNAME',HNAM2)
+         CALL LCMGET(IPLIB,'ISOTOPESDENS',DENS2)
+         CALL LCMGET(IPLIB,'ISOTOPESVOL',VOL2)
+         CALL LCMGET(IPLIB,'ISOTOPESMIX',IMIX2)
+         CALL LCMGET(IPLIB,'ISOTOPESTODO',ITOD2)
+         CALL LCMGET(IPLIB,'ISOTOPESTYPE',ISTY2)
+         IF(NED2.GT.0) CALL LCMGTC(IPLIB,'ADDXSNAME-P0',8,NED2,HVECT2)
+         IF(NSURFD.GT.0) THEN
+           CALL LCMSIX(IPLIB,'MACROLIB',1)
+           CALL LCMLEN(IPLIB,'ADF',ILONG,ITYLCM)
+           IF(ILONG.EQ.0) THEN
+             CALL LCMLIB(IPLIB)
+             CALL XABORT('SCRLIB: UNABLE TO FIND DIRECTORY ADF.')
+           ENDIF
+           CALL LCMSIX(IPLIB,'ADF',1)
+           CALL LCMGTC(IPLIB,'HADF',8,NSURFD,HADF)
+           DO I=1,NSURFD
+             CALL LCMGET(IPLIB,HADF(I),ADF2(1,1,I))
+           ENDDO
+           CALL LCMSIX(IPLIB,' ',2)
+           CALL LCMSIX(IPLIB,' ',2)
+         ENDIF
+      ENDIF
+*----
+*  RECOVER SAPHYB CHARACTERISTICS
+*----
+      CALL LCMLEN(IPMEM,'DIMSAP',ILENG,ITYLCM)
+      IF(ILENG.EQ.0) CALL XABORT('SCRLIB: INVALID SAPHYB.')
+      CALL LCMGET(IPMEM,'DIMSAP',DIMSAP)
+      IF(NGRP.NE.DIMSAP(20)) THEN
+        CALL XABORT('SCRLIB: INVALID VALUE OF NGRP.')
+      ENDIF
+      NLAM=DIMSAP(3)   ! number of radioactive decay reactions
+      NREA=DIMSAP(4)   ! number of neutron-induced reactions
+      NISOP=DIMSAP(5)  ! number of particularized isotopes
+      NMAC=DIMSAP(6)   ! number of macroscopic sets
+      NMIL=DIMSAP(7)   ! number of mixtures in the Saphyb
+      NPARL=DIMSAP(11) ! number of local variables
+      NADRX=DIMSAP(18) ! number of address sets
+      NCALS=DIMSAP(19) ! number of elementary calculations in the Saphyb
+      NPRC=DIMSAP(31)  ! number of delayed neutron precursor groups
+      NISOTS=DIMSAP(32) ! maximum number of isotopes in output tables
+      IF(IMPX.GT.1) THEN
+        WRITE(IOUT,'(30H SCRLIB: number of reactions =,I3)') NREA
+        WRITE(IOUT,'(46H SCRLIB: number of radioactive decay reactions,
+     1  2H =,I3)') NLAM
+        WRITE(IOUT,'(46H SCRLIB: number of neutron-induced reactions =,
+     1  I3)') NREA
+        WRITE(IOUT,'(44H SCRLIB: number of particularized isotopes =,
+     1  I4)') NISOP
+        WRITE(IOUT,'(37H SCRLIB: number of macroscopic sets =,I2)') NMAC
+        WRITE(IOUT,'(29H SCRLIB: number of mixtures =,I5)') NMIL
+        WRITE(IOUT,'(36H SCRLIB: number of local variables =,I4)') NPARL
+        WRITE(IOUT,'(33H SCRLIB: number of address sets =,I4)') NADRX
+        WRITE(IOUT,'(33H SCRLIB: number of calculations =,I7)') NCALS
+        WRITE(IOUT,'(34H SCRLIB: number of energy groups =,I4)') NGRP
+        WRITE(IOUT,'(37H SCRLIB: number of precursor groups =,I4)') NPRC
+        WRITE(IOUT,'(46H SCRLIB: maximum number of isotopes in output ,
+     1  8Htables =,I4)') NISOTS
+      ENDIF
+      IF(NREA.GT.MAXREA) CALL XABORT('SCRLIB: MAXREA OVERFLOW(2)')
+      IF(NMAC.GT.MAXMAC) CALL XABORT('SCRLIB: MAXMAC OVERFLOW')
+*----
+*  RECOVER INFORMATION FROM constphysiq DIRECTORY.
+*----
+      ALLOCATE(ENER(NGRP+1))
+      CALL LCMSIX(IPMEM,'constphysiq',1)
+      CALL LCMGET(IPMEM,'ENRGS',ENER)
+      CALL LCMSIX(IPMEM,' ',2)
+      DO IGR=1,NGRP+1
+        ENER(IGR)=ENER(IGR)/1.0E-6
+      ENDDO
+      CALL LCMPUT(IPLIB,'ENERGY',NGRP+1,2,ENER)
+      DO IGR=1,NGRP
+        ENER(IGR)=LOG(ENER(IGR)/ENER(IGR+1))
+      ENDDO
+      CALL LCMPUT(IPLIB,'DELTAU',NGRP,2,ENER)
+      DEALLOCATE(ENER)
+*----
+*  RECOVER INFORMATION FROM contenu DIRECTORY.
+*----
+      ALLOCATE(ITOTM(NMIL),IRESM(NMIL))
+      CALL LCMSIX(IPMEM,'contenu',1)
+      IREAF=0
+      IF(NREA.GT.0) THEN
+        CALL LCMGTC(IPMEM,'NOMREA',12,NREA,NOMREA)
+        IF(IMPX.GT.1) THEN
+          WRITE(IOUT,'(29H SCRLIB: Available reactions:/(1X,10A13))')
+     1    (NOMREA(I),I=1,NREA)
+        ENDIF
+        DO IREA=1,NREA
+          IF(NOMREA(IREA).EQ.'NU*FISSION') THEN
+            IREAF=IREA
+            EXIT
+          ENDIF
+        ENDDO
+      ENDIF
+      CALL LCMGET(IPMEM,'TOTMAC',ITOTM)
+      CALL LCMGET(IPMEM,'RESMAC',IRESM)
+      ALLOCATE(INOMIS(2,NISOP+NMAC),JJSO(NISOP+NMAC))
+      NBISO1=NISOP
+      IF(NISOP.GT.0) CALL LCMGET(IPMEM,'NOMISO',INOMIS)
+      IF(NMAC.GT.0) THEN
+        CALL LCMLEN(IPMEM,'NOMMAC',ILONG,ITYLCM)
+        IF(ILONG.GT.2*MAXMAC) CALL XABORT('SCRLIB: MAXMAC OVERFLOW')
+        CALL LCMGTC(IPMEM,'NOMMAC',8,NMAC,NOMMAC)
+        HHISO='*MAC*RES'
+        NBISO1=NBISO1+1
+        READ(HHISO,'(2A4)') (INOMIS(I0,NBISO1),I0=1,2)
+      ENDIF
+      CALL LCMSIX(IPMEM,' ',2)
+      IF(NBISO1.EQ.0) CALL XABORT('SCRLIB: NO CROSS SECTIONS FOUND.')
+      IF(NBISO1.GT.MAXISO) CALL XABORT('SCRLIB: MAXISO OVERFLOW(2).')
+*----
+*  RECOVER INFORMATION FROM adresses DIRECTORY.
+*----
+      NL=0
+      IF(NADRX.GT.0) THEN
+        ALLOCATE(IADRX((NREA+2)*(NISOP+NMAC)*NADRX))
+        CALL LCMSIX(IPMEM,'adresses',1)
+        CALL LCMGET(IPMEM,'ADRX',IADRX)
+        CALL LCMSIX(IPMEM,' ',2)
+        DO IAD=1,NADRX
+          DO ISO=1,NISOP+NMAC
+            IOF=(NREA+2)*(NISOP+NMAC)*(IAD-1)+(NREA+2)*(ISO-1)+NREA+1
+            NL=MAX(NL,IADRX(IOF))
+            IOF=(NREA+2)*(NISOP+NMAC)*(IAD-1)+(NREA+2)*(ISO-1)+NREA+2
+            NL=MAX(NL,IADRX(IOF))
+          ENDDO
+        ENDDO
+      ENDIF
+      IF(IMPX.GT.1) THEN
+        WRITE(IOUT,'(36H SCRLIB: number of Legendre orders =,I4)') NL
+      ENDIF
+*----
+*  RECOVER INFORMATION FROM geom DIRECTORY.
+*----
+      CALL LCMSIX(IPMEM,'geom',1)
+      ALLOCATE(XVOLM(NMIL))
+      CALL LCMGET(IPMEM,'XVOLMT',XVOLM)
+      ALLOCATE(SURFLX(NSURFD,NGRP),SURF(NSURFD))
+      IF(NSURFD.GT.0) THEN
+        CALL LCMSIX(IPMEM,'outgeom',1)
+        CALL LCMGET(IPMEM,'SURF',SURF)
+        CALL LCMSIX(IPMEM,' ',2)
+      ENDIF
+      CALL LCMSIX(IPMEM,' ',2)
+*----
+*  LOOP OVER SAPHYB MIXTURES TO COMPUTE DENS0(NMIL,NCAL,NBISO1)
+*----
+      JPMEM=LCMGID(IPMEM,'calc')
+      ALLOCATE(DENS0(NMIL,NCAL,NBISO1))
+      IF(NISOTS.GT.0) ALLOCATE(ISOTS(NISOTS*2))
+      DENS0(:NMIL,:NCAL,:NBISO1)=0.0
+      ALLOCATE(CONCE(NISOTS))
+      DO 30 IBMOLD=1,NMIL
+      DO ICAL=1,NCAL
+        DO IBM=1,NMIX
+          IF((TERP(ICAL,IBM).NE.0.0).AND.(MIXC(IBM).EQ.IBMOLD)) GO TO 10
+        ENDDO
+        CYCLE
+  10    KPMEM=LCMGIL(JPMEM,ICAL)
+        CALL LCMSIX(KPMEM,'info',1)
+        CALL LCMGET(KPMEM,'NISOTS',NISOT2)
+        IF(NISOT2.GT.NISOTS) CALL XABORT('SCRLIB: NISOTS OVERFLOW.')
+        IF(NISOT2.GT.0) CALL LCMGET(KPMEM,'ISOTS',ISOTS)
+        CALL LCMSIX(KPMEM,' ',2)
+        LPMEM=LCMGID(KPMEM,'mili')
+        MPMEM=LCMGIL(LPMEM,IBMOLD)
+        IF(NISOT2.GT.0) THEN
+          CALL LCMGET(MPMEM,'CONCES',CONCE)
+          DO ISO=1,NISOP
+            INAME(1)=INOMIS(1,ISO)
+            INAME(2)=INOMIS(2,ISO)
+            DO IS2=1,NISOT2
+              ISOKEP=IS2
+              IF(INAME(1).NE.ISOTS(2*(IS2-1)+1)) CYCLE
+              IF(INAME(2).NE.ISOTS(2*(IS2-1)+2)) CYCLE
+              GO TO 20
+            ENDDO
+            CYCLE
+   20       DENS0(IBMOLD,ICAL,ISO)=CONCE(ISOKEP)
+          ENDDO
+        ENDIF
+      ENDDO
+   30 CONTINUE
+      DEALLOCATE(CONCE)
+*----
+*  LOOP OVER MICROLIB MIXTURES
+*----
+      YLDS(:MY1,:MY2)=0.0D0
+      DECAYC(:MD1,:MD2)=0.0D0
+      VTOT=0.0D0
+      DO 40 IBM=1,NMIX
+      IBMOLD=MIXC(IBM)
+      IF(IBMOLD.NE.0) VTOT=VTOT+XVOLM(IBMOLD)
+   40 CONTINUE
+      ALLOCATE(YLDSM(MY1,MY2))
+      ALLOCATE(ISADRX(NMIL),LENGDX(NMIL),LENGDP(NMIL),ITOD1(NBISO1))
+      ALLOCATE(TAUXFI(NISOP+NMAC),NWT0(NGRP),SIGS(NGRP*NL*(NISOP+NMAC)),
+     1 SS2D(NGRP*NGRP*NL*(NISOP+NMAC)),XS(NGRP*NREA*(NISOP+NMAC)))
+      ALLOCATE(LXS(NREA))
+      ALLOCATE(LAMB(NPRC),CHIRS(NGRP*NPRC),BETAR(NPRC),INVELS(NGRP))
+      LAMB(:NPRC)=0.0
+      CHIRS(:NGRP*NPRC)=0.0
+      BETAR(:NPRC)=0.0
+      INVELS(:NGRP)=0.0
+      FMASL(:NMIX)=0.0
+      ALLOCATE(CHIRSB(NGRP*NPRC),BETARB(NPRC),INVELSB(NGRP))
+      ALLOCATE(DENS1(NBISO1,NCAL),FACT(NBISO1,NCAL))
+      JPLIB=LCMLID(IPLIB,'ISOTOPESLIST',(NISOP+NMAC)*NMIX)
+*
+      DO 180 IBM=1,NMIX
+      IBMOLD=MIXC(IBM)
+      IF(IBMOLD.EQ.0) GO TO 180
+      IF(NISO(IBM).GT.MAXNIS) CALL XABORT('SCRLIB: MAXNIS OVERFLOW.')
+      VOLMI2(IBM)=XVOLM(IBMOLD)
+      IMAC=ITOTM(IBMOLD)
+      IRES=IRESM(IBMOLD)
+*----
+*  RECOVER ITOD1(NBISO1) INDICES.
+*----
+      ITOD1(:NBISO1)=0
+      DO 50 ISO=1,NBISO1 ! Saphyb isotope
+        INAME(1)=INOMIS(1,ISO)
+        INAME(2)=INOMIS(2,ISO)
+        DO KSO=1,NISO(IBM) ! user-selected isotope
+          IF((INAME(1).EQ.HISO(1,IBM,KSO)).AND.
+     1       (INAME(2).EQ.HISO(2,IBM,KSO))) THEN
+            ITOD1(ISO)=ITODO(IBM,KSO)
+            GO TO 50
+          ENDIF
+        ENDDO
+   50 CONTINUE
+*----
+*  COMPUTE THE NUMBER DENSITIES OF EACH ELEMENTARY CALCULATION.
+*----
+      DENS1(:NBISO1,:NCAL)=0.0
+      DENS3(:NBISO1)=0.0
+      DO ICAL=1,NCAL
+        WEIGHT=TERP(ICAL,IBM)
+        IF(WEIGHT.EQ.0.0) CYCLE
+        DO ISO=1,NISOP
+          LUSER=.FALSE.
+          INAME(1)=INOMIS(1,ISO)
+          INAME(2)=INOMIS(2,ISO)
+          KSO1=0
+          DO KSO=1,NISO(IBM) ! user-selected isotope
+            IF((INAME(1).EQ.HISO(1,IBM,KSO)).AND.
+     1         (INAME(2).EQ.HISO(2,IBM,KSO))) THEN
+              KSO1=KSO
+              LUSER=(CONC(IBM,KSO1).NE.-99.99)
+              GO TO 60
+            ENDIF
+          ENDDO
+   60     IF(LUSER) THEN
+            DENS1(ISO,ICAL)=CONC(IBM,KSO1)
+            CYCLE
+          ENDIF
+          IF(.NOT.LISO(IBM)) CYCLE
+          DENS1(ISO,ICAL)=DENS0(IBMOLD,ICAL,ISO)
+        ENDDO
+        IF(NMAC.GT.0) DENS1(NISOP+1,ICAL)=1.0
+        DO ISO=1,NBISO1
+          DENS3(ISO)=DENS3(ISO)+WEIGHT*DENS1(ISO,ICAL)
+        ENDDO
+      ENDDO
+      FACT(:NBISO1,:NCAL)=1.0
+      IF(.NOT.LPURE) THEN
+        DO ICAL=1,NCAL
+          IF(TERP(ICAL,IBM).EQ.0.0) CYCLE
+          DO ISO=1,NBISO1
+            IF(DENS3(ISO).GT.DENS1(ISO,ICAL)*1.0E-9) THEN
+              FACT(ISO,ICAL)=DENS1(ISO,ICAL)/DENS3(ISO)
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDIF
+*----
+*  INITIALIZE WORKING ARRAYS.
+*----
+      TAUXFI(:NBISO1)=0.0
+      NWT0(:NGRP)=0.0
+      SIGS(:NGRP*NL*NBISO1)=0.0
+      SS2D(:NGRP*NGRP*NL*NBISO1)=0.0
+      XS(:NGRP*NREA*NBISO1)=0.0
+      LXS(:NREA)=.FALSE.
+      YLDSM(:MY1,:MY2)=0.0D0
+*----
+*  MAIN LOOP OVER ELEMENTARY CALCULATIONS
+*----
+      TEXT12='*MAC*RES'
+      READ(TEXT12,'(2A4)') IHRES(1),IHRES(2)
+      LSTRD=.FALSE.
+      B2SAP=B2
+      DO 80 ICAL=1,NCAL
+      WEIGHT=TERP(ICAL,IBM)
+      IF(WEIGHT.EQ.0.0) GO TO 80
+*----
+*  RECOVER INFORMATION FROM caldir DIRECTORY.
+*----
+      KPMEM=LCMGIL(JPMEM,ICAL)
+      IF(NPRC.GT.0) THEN
+        CHIRSB(:NGRP*NPRC)=0.0
+        BETARB(:NPRC)=0.0
+        INVELSB(:NGRP)=0.0
+      ENDIF
+      CALL LCMSIX(KPMEM,'info',1)
+      LSPH=.FALSE.
+      LMASL=.FALSE.
+      IF(NPARL.GT.0) THEN
+        CALL LCMGET(KPMEM,'NLOC',NLOC)
+        IF(NLOC.GT.MAXLOC) CALL XABORT('SCRLIB: MAXLOC OVERFLOW')
+        CALL LCMGTC(KPMEM,'LOCTYP',4,NLOC,LOCTYP)
+        CALL LCMGTC(KPMEM,'LOCKEY',4,NLOC,LOCKEY)
+        ALLOCATE(LOCAD(NLOC+1))
+        CALL LCMGET(KPMEM,'LOCADR',LOCAD)
+        DO ILOC=1,NLOC
+          LSPH=LSPH.OR.((LOCTYP(ILOC).EQ.'EQUI').AND.
+     1                  (LOCKEY(ILOC).EQ.HEQUI))
+          LMASL=LMASL.OR.((LOCTYP(ILOC).EQ.'MASL').AND.
+     1                    (LOCKEY(ILOC).EQ.HMASL))
+        ENDDO
+      ENDIF
+      IF((HEQUI.NE.' ').AND.(.NOT.LSPH)) THEN
+        WRITE(HSMG,'(46HSCRLIB: UNABLE TO FIND A LOCAL PARAMETER SET O,
+     1  25HF TYPE EQUI WITH KEYWORD ,A4,1H.)') HEQUI
+        CALL XABORT(HSMG)
+      ELSE IF((HMASL.NE.' ').AND.(.NOT.LMASL)) THEN
+        WRITE(HSMG,'(46HSCRLIB: UNABLE TO FIND A LOCAL PARAMETER SET O,
+     1  25HF TYPE MASL WITH KEYWORD ,A4,1H.)') HMASL
+        CALL XABORT(HSMG)
+      ENDIF
+      CALL LCMGET(KPMEM,'ISADRX',ISADRX)
+      CALL LCMGET(KPMEM,'LENGDX',LENGDX)
+      CALL LCMGET(KPMEM,'LENGDP',LENGDP)
+      CALL LCMGET(KPMEM,'NISF',NISF)
+      IF(NISF+NMAC.NE.MY1) CALL XABORT('SCRLIB: MY1 ERROR')
+      CALL LCMGET(KPMEM,'NISP',NISP)
+      IF(NISP.NE.MY2) CALL XABORT('SCRLIB: MY2 ERROR')
+      CALL LCMGET(KPMEM,'NISOTS',NISOT2)
+      IF(NISOT2.GT.NISOTS) CALL XABORT('SCRLIB: NISOTS OVERFLOW.')
+      IF(NISOT2.GT.0) CALL LCMGET(KPMEM,'ISOTS',ISOTS)
+      CALL LCMSIX(KPMEM,' ',2)
+      CALL LCMSIX(KPMEM,'divers',1)
+      CALL LCMLEN(KPMEM,'NVDIV',ILENG,ITYLCM)
+      IF(ILENG.EQ.0) THEN
+        NVDIV=0
+      ELSE
+        CALL LCMGET(KPMEM,'NVDIV',NVDIV)
+      ENDIF
+      IF(NVDIV.GT.0) THEN
+        IF(NVDIV.GT.MAXDIV) CALL XABORT('SCRLIB: MAXDIV OVERFLOW.')
+        CALL LCMGTC(KPMEM,'IDVAL',4,NVDIV,IDVAL)
+        CALL LCMGET(KPMEM,'VALDIV',VALDIV)
+        DO I=1,NVDIV
+          IF(IMPX.GT.3) THEN
+            WRITE(IOUT,'(9H SCRLIB: ,I3,2X,A,1H=,1P,E13.5)') I,IDVAL(I),
+     1      VALDIV(I)
+          ENDIF
+          IF(IDVAL(I).EQ.'B2') B2SAP=VALDIV(I)
+        ENDDO
+      ENDIF
+*
+      CALL LCMLEN(KPMEM,'NPR',ILONG,ITYLCM)
+      IF((NPRC.GT.0).AND.(ILONG.EQ.1)) THEN
+        CALL LCMGET(KPMEM,'NPR',NPR)
+        IF(NPR.NE.NPRC) CALL XABORT('SCRLIB: NPR INCONSISTENCY(1).')
+        CALL LCMGET(KPMEM,'LAMBRS',LAMB)
+        CALL LCMGET(KPMEM,'CHIRS',CHIRSB)
+        CALL LCMGET(KPMEM,'BETARS',BETARB)
+        CALL LCMGET(KPMEM,'INVELS',INVELSB)
+      ENDIF
+      CALL LCMSIX(KPMEM,' ',2)
+*----
+*  SELECT SAPHYB MIXTURE IBMOLD.
+*----
+      IF(NADRX.EQ.0) CALL XABORT('SCRLIB: NO ADDRESS SETS AVAILABLE.')
+      LPMEM=LCMGID(KPMEM,'mili')
+      MPMEM=LCMGIL(LPMEM,IBMOLD)
+      SPH(:NGRP)=1.0
+      IF(LSPH) THEN
+        ALLOCATE(RVALO(LOCAD(NLOC+1)-1))
+        CALL LCMGET(MPMEM,'RVALOC',RVALO)
+        DO ILOC=1,NLOC
+          IF((LOCTYP(ILOC).EQ.'EQUI').AND.(LOCKEY(ILOC).EQ.HEQUI)) THEN
+            IF(LOCAD(ILOC+1)-LOCAD(ILOC).NE.NGRP) THEN
+              CALL XABORT('SCRLIB: INVALID NUMBER OF COMPONENTS FOR '
+     1        //'SPH FACTORS')
+            ENDIF
+            DO IGR=1,NGRP
+              SPH(IGR)=RVALO(LOCAD(ILOC)+IGR-1)
+            ENDDO
+          ENDIF
+        ENDDO
+        DEALLOCATE(RVALO)
+      ENDIF
+      IF(LMASL) THEN
+        ALLOCATE(RVALO(LOCAD(NLOC+1)-1))
+        CALL LCMGET(MPMEM,'RVALOC',RVALO)
+        DO ILOC=1,NLOC
+          IF((LOCTYP(ILOC).EQ.'MASL').AND.(LOCKEY(ILOC).EQ.HMASL))
+     1    THEN
+            IF(LOCAD(ILOC+1)-LOCAD(ILOC).NE.1) THEN
+              CALL XABORT('SCRLIB: INVALID NUMBER OF COMPONENTS FOR '
+     1        //'MASL')
+            ENDIF
+            FMASL(IBM)=FMASL(IBM)+WEIGHT*RVALO(LOCAD(ILOC))
+          ENDIF
+        ENDDO
+        DEALLOCATE(RVALO)
+      ENDIF
+      IF(NPARL.GT.0) DEALLOCATE(LOCAD)
+      IAD=ISADRX(IBMOLD)
+      NDATAX=LENGDX(IBMOLD)
+      NDATAP=LENGDP(IBMOLD)
+      ALLOCATE(FLUXS(NGRP),RDATA(NDATAX),IDATA(NDATAP))
+      CALL LCMGET(MPMEM,'FLUXS',FLUXS)
+      CALL LCMGET(MPMEM,'RDATAX',RDATA)
+      CALL LCMGET(MPMEM,'IDATAP',IDATA)
+      DO I=1,NGRP
+        FLUXS(I)=FLUXS(I)/XVOLM(IBMOLD)
+        NWT0(I)=NWT0(I)+WEIGHT*FLUXS(I)/SPH(I)
+      ENDDO
+      ALLOCATE(SIGSB(NGRP*NL),SS2DB(NGRP*NGRP*NL),XSB(NGRP*NREA))
+      IF(NISOP.NE.0) THEN
+        DO ISO=1,NISOP
+          FACT0=FACT(ISO,ICAL)
+          JXS=(ISO-1)*NGRP*NREA
+          JSIGS=(ISO-1)*NGRP*NL
+          JSS2D=(ISO-1)*NGRP*NGRP*NL
+          CALL SPHSXS(NREA,NISOP+NMAC,NADRX,NGRP,NL,NDATAX,NDATAP,
+     1    ISO,IAD,IADRX,RDATA,IDATA,NOMREA,SIGSB,SS2DB,XSB,LXS)
+          CALL SCRSXS(NGRP,NL,NREA,IREAF,NOMREA,LXS,B2SAP,FACT0,
+     1    WEIGHT,SPH,FLUXS,XSB,SIGSB,SS2DB,LPURE,XS(JXS+1),
+     2    SIGS(JSIGS+1),SS2D(JSS2D+1),TAUXFI(ISO))
+        ENDDO
+        IF(IRES.NE.0) THEN
+          FACT0=1.0
+          JXS=NISOP*NGRP*NREA
+          JSIGS=NISOP*NGRP*NL
+          JSS2D=NISOP*NGRP*NGRP*NL
+          CALL SPHSXS(NREA,NISOP+NMAC,NADRX,NGRP,NL,NDATAX,NDATAP,
+     1    NISOP+IRES,IAD,IADRX,RDATA,IDATA,NOMREA,SIGSB,SS2DB,XSB,LXS)
+          CALL SCRSXS(NGRP,NL,NREA,IREAF,NOMREA,LXS,B2SAP,FACT0,
+     1    WEIGHT,SPH,FLUXS,XSB,SIGSB,SS2DB,LPURE,XS(JXS+1),
+     2    SIGS(JSIGS+1),SS2D(JSS2D+1),TAUXFI(NISOP+1))
+        ENDIF
+      ELSE IF(IMAC.NE.0) THEN
+        FACT0=1.0
+        JXS=NISOP*NGRP*NREA
+        JSIGS=NISOP*NGRP*NL
+        JSS2D=NISOP*NGRP*NGRP*NL
+        CALL SPHSXS(NREA,NISOP+NMAC,NADRX,NGRP,NL,NDATAX,NDATAP,
+     1  NISOP+IMAC,IAD,IADRX,RDATA,IDATA,NOMREA,SIGSB,SS2DB,XSB,LXS)
+        CALL SCRSXS(NGRP,NL,NREA,IREAF,NOMREA,LXS,B2SAP,FACT0,WEIGHT,
+     1  SPH,FLUXS,XSB,SIGSB,SS2DB,LPURE,XS(JXS+1),SIGS(JSIGS+1),
+     2  SS2D(JSS2D+1),TAUXFI(NISOP+1))
+      ELSE
+        CALL XABORT('SCRLIB: NO MACROSCOPIC SET.')
+      ENDIF
+      DEALLOCATE(XSB,SS2DB,SIGSB,IDATA,RDATA,FLUXS)
+*
+      CALL LCMLEN(MPMEM,'cinetique',ILONG,ITYLCM)
+      IF((NPRC.GT.0).AND.(ILONG.NE.0)) THEN
+        CALL LCMSIX(MPMEM,'cinetique',1)
+        CALL LCMGET(MPMEM,'NPR',NPR)
+        IF(NPR.NE.NPRC) CALL XABORT('SCRLIB: NPR INCONSISTENCY(2).')
+        CALL LCMGET(MPMEM,'LAMBRS',LAMB)
+        CALL LCMGET(MPMEM,'CHIRS',CHIRSB)
+        CALL LCMGET(MPMEM,'BETARS',BETARB)
+        CALL LCMGET(MPMEM,'INVELS',INVELSB)
+        CALL LCMSIX(MPMEM,' ',2)
+      ENDIF
+      IF(NPRC.GT.0) THEN
+        DO IGR=1,NGRP
+          INVELS(IGR)=INVELS(IGR)+SPH(IGR)*WEIGHT*INVELSB(IGR)
+          DO IPRC=1,NPRC
+            IOF=(IPRC-1)*NGRP+IGR
+            CHIRS(IOF)=CHIRS(IOF)+WEIGHT*CHIRSB(IOF)
+          ENDDO
+        ENDDO
+        DO IPRC=1,NPRC
+          BETAR(IPRC)=BETAR(IPRC)+WEIGHT*BETARB(IPRC)
+        ENDDO
+      ENDIF
+*----
+*  COMPUTE DEPLETION CHAIN DATA
+*----
+      IF(MY1*MY2.GT.0) THEN
+        CALL LCMLEN(MPMEM,'YLDS',ILONG,ITYLCM)
+        IF(ILONG.NE.MY1*MY2) CALL XABORT('SCRLIB: BAD YLDS.')
+        ALLOCATE(YLDS2(MY1,MY2))
+        CALL LCMGET(MPMEM,'YLDS',YLDS2)
+        DO IY1=1,MY1
+          DO IY2=1,MY2
+            YLDSM(IY1,IY2)=YLDSM(IY1,IY2)+WEIGHT*YLDS2(IY1,IY2)
+            YLDS(IY1,IY2)=YLDS(IY1,IY2)+WEIGHT*YLDS2(IY1,IY2)*
+     >      VOLMI2(IBM)/VTOT
+          ENDDO
+        ENDDO
+        DEALLOCATE(YLDS2)
+      ENDIF
+      IF((MD1*MD2.GT.0).AND.(NISOT2.GT.0)) THEN
+        CALL LCMLEN(MPMEM,'DECAYC',ILONG,ITYLCM)
+        IF(ILONG.NE.NLAM*NISOT2) CALL XABORT('SCRLIB: BAD DECAYC.')
+        ALLOCATE(DECAY2(NLAM,NISOT2))
+        CALL LCMGET(MPMEM,'DECAYC',DECAY2)
+        DO ISO=1,NISOP
+          INAME(1)=INOMIS(1,ISO)
+          INAME(2)=INOMIS(2,ISO)
+          DO IS2=1,NISOT2
+            ISOKEP=IS2
+            IF(INAME(1).NE.ISOTS(2*(IS2-1)+1)) CYCLE
+            IF(INAME(2).NE.ISOTS(2*(IS2-1)+2)) CYCLE
+            GO TO 70
+          ENDDO
+          CYCLE
+   70     DO ID1=1,NLAM
+            DECAYC(ID1,ISO)=DECAYC(ID1,ISO)+WEIGHT*DECAY2(ID1,ISOKEP)*
+     >      VOLMI2(IBM)/VTOT
+          ENDDO
+        ENDDO
+        DEALLOCATE(DECAY2)
+      ENDIF
+   80 CONTINUE ! end of loop over elementary calculations.
+*----
+*  IDENTIFY SPECIAL FLUX EDITS
+*----
+      DO IREA=1,NREA
+        IF(.NOT.LXS(IREA)) CYCLE
+        IF(NOMREA(IREA).EQ.'TOTALE') CYCLE
+        IF(NOMREA(IREA).EQ.'TOTALE P1') CYCLE
+        IF(NOMREA(IREA).EQ.'EXCESS') CYCLE
+        IF(NOMREA(IREA).EQ.'SPECTRE') CYCLE
+        IF(NOMREA(IREA).EQ.'NU*FISSION') CYCLE
+        IF(NOMREA(IREA).EQ.'ENERGIE') CYCLE
+        IF(NOMREA(IREA).EQ.'SELF') CYCLE
+        IF(NOMREA(IREA).EQ.'TRANSP-CORR') CYCLE
+        IF(NOMREA(IREA).EQ.'FUITES') CYCLE
+        IF(NOMREA(IREA).EQ.'DIFFUSION') CYCLE
+        IF(NOMREA(IREA).EQ.'TRANSFERT') CYCLE
+        DO 90 IED2=1,NED2
+        IF(HVECT2(IED2).EQ.NOMREA(IREA)(:8)) GO TO 100
+        IF(HVECT2(IED2).EQ.'NFTOT') GO TO 100
+   90   CONTINUE
+        NED2=NED2+1
+        IF(NED2.GT.MAXREA) CALL XABORT('SCRLIB: MAXREA OVERFLOW(3).')
+        IF(NOMREA(IREA).EQ.'FISSION') THEN
+          HVECT2(NED2)='NFTOT'
+        ELSE
+          HVECT2(NED2)=NOMREA(IREA)(:8)
+        ENDIF
+  100   CONTINUE
+      ENDDO
+*----
+*  SET FLAG LSTRD
+*----
+      LSTRD=.TRUE.
+      DO IREA=1,NREA
+        IF(NOMREA(IREA).EQ.'FUITES') THEN
+          IF(LXS(IREA).AND.(B2SAP.NE.0.0)) LSTRD=.FALSE.
+          EXIT
+        ENDIF
+      ENDDO
+*----
+*  SAVE CROSS SECTIONS IN MICROLIB FOR MIXTURE IBM
+*----
+      ISTY1(:NBISO1)=0
+      JJSO(:NBISO1)=0
+      NBISO2I=NBISO2
+      IF(NISOP.NE.0) THEN
+        HRESID=' '
+        DO ISO=1,NISOP
+          JXS=(ISO-1)*NGRP*NREA
+          JSIGS=(ISO-1)*NGRP*NL
+          JSS2D=(ISO-1)*NGRP*NGRP*NL
+          INAME(1)=INOMIS(1,ISO)
+          INAME(2)=INOMIS(2,ISO)
+          CALL SCRFND(MAXISO,NBISO2I,NBISO2,INAME,IBM,HRESID,HUSE2,
+     1    HNAM2,IMIX2,JJSO(ISO))
+          KPLIB=LCMDIL(JPLIB,JJSO(ISO)) ! step up isot JJSO(ISO)
+          CALL SCRISO(KPLIB,NREA,NGRP,NL,NPRC,NOMREA,NWT0,XS(JXS+1),
+     1    SIGS(JSIGS+1),SS2D(JSS2D+1),TAUXFI(ISO),LXS,LAMB,CHIRS,BETAR,
+     2    INVELS,INAME,LSTRD,LPURE,ILUPS,ITRANC,IFISS)
+          IF(MY1*MY2.GT.0) CALL SCRNDF(IMPX,NISOP+NMAC,ISO,IBM,INOMIS,
+     1    IPMEM,KPLIB,NCAL,TERP(1,IBM),MY1,MY2,YLDSM,ISTY1(ISO))
+        ENDDO
+        IF(IRES.NE.0) THEN
+          HRESID=NOMMAC(IRES)
+          JXS=NISOP*NGRP*NREA
+          JSIGS=NISOP*NGRP*NL
+          JSS2D=NISOP*NGRP*NGRP*NL
+          CALL SCRFND(MAXISO,NBISO2I,NBISO2,IHRES,IBM,HRESID,HUSE2,
+     1    HNAM2,IMIX2,JJSO(NISOP+1))
+          KPLIB=LCMDIL(JPLIB,JJSO(NISOP+1)) ! step up isot JJSO(NISOP+1)
+          CALL SCRISO(KPLIB,NREA,NGRP,NL,NPRC,NOMREA,NWT0,XS(JXS+1),
+     1    SIGS(JSIGS+1),SS2D(JSS2D+1),TAUXFI(NISOP+1),LXS,LAMB,CHIRS,
+     2    BETAR,INVELS,IHRES,LSTRD,LPURE,ILUPS,ITRANC,IFISS)
+          IF(MY1*MY2.GT.0) CALL SCRNDF(IMPX,NISOP+NMAC,NISOP+IRES,
+     1    IBM,INOMIS,IPMEM,KPLIB,NCAL,TERP(1,IBM),MY1,MY2,YLDSM,
+     2    ISTY1(NISOP+IRES))
+        ENDIF
+      ELSE IF(IMAC.NE.0) THEN
+        HRESID=NOMMAC(IMAC)
+        JXS=NISOP*NGRP*NREA
+        JSIGS=NISOP*NGRP*NL
+        JSS2D=NISOP*NGRP*NGRP*NL
+        CALL SCRFND(MAXISO,NBISO2I,NBISO2,IHRES,IBM,HRESID,HUSE2,HNAM2,
+     1  IMIX2,JJSO(1))
+        KPLIB=LCMDIL(JPLIB,JJSO(1)) ! step up isot JJSO(1)
+        CALL SCRISO(KPLIB,NREA,NGRP,NL,NPRC,NOMREA,NWT0,XS(JXS+1),
+     1  SIGS(JSIGS+1),SS2D(JSS2D+1),TAUXFI(NISOP+1),LXS,LAMB,CHIRS,
+     2  BETAR,INVELS,IHRES,LSTRD,LPURE,ILUPS,ITRANC,IFISS)
+      ENDIF
+*----
+*  SET NUMBER DENSITIES AND VOLUMES IN OUTPUT MICROLIB
+*----
+      IF(LRES) THEN
+*       -- Number densities are left unchanged except if they are
+*       -- listed in HISO array.
+        DO 110 KSO=1,NISO(IBM) ! user-selected isotope
+          DO JSO=1,NBISO2 ! microlib isotope
+            IF(IMIX2(JSO).NE.IBM) CYCLE
+            IF((HISO(1,IBM,KSO).EQ.HUSE2(1,JSO)).AND.
+     1         (HISO(2,IBM,KSO).EQ.HUSE2(2,JSO))) THEN
+              ITOD2(JSO)=ITODO(IBM,KSO)
+              IF(CONC(IBM,KSO).EQ.-99.99) THEN
+*               -- Only number densities of isotopes set with "MICR" and
+*               -- "*" keywords are interpolated
+                DENS2(JSO)=0.0
+                DO ISO=1,NBISO1 ! Saphyb isotope
+                  IF(JJSO(ISO).EQ.JSO) DENS2(JSO)=DENS2(JSO)+DENS3(ISO)
+                ENDDO
+              ELSE IF(CONC(IBM,KSO).NE.-99.99) THEN
+*               -- Number densities of isotopes set with "MICR" and
+*               -- fixed value are forced to this value
+                DENS2(JSO)=CONC(IBM,KSO)
+              ENDIF
+              GO TO 110
+            ENDIF
+          ENDDO
+          WRITE(HSMG,'(31HSCRLIB: UNABLE TO FIND ISOTOPE ,2A4,6H IN MI,
+     1    5HXTURE,I8,1H.)') HISO(1,IBM,KSO),HISO(2,IBM,KSO),IBM
+          CALL XABORT(HSMG)
+  110   CONTINUE
+      ELSE
+*       -- Number densities are interpolated or not according to
+*       -- ALL/ONLY option
+        DO JSO=1,NBISO2 ! microlib isotope
+          IF(IBM.EQ.IMIX2(JSO)) THEN
+            DO ISO=1,NBISO1 ! Saphyb isotope
+              IF((INOMIS(1,ISO).EQ.HUSE2(1,JSO)).AND.
+     1          (INOMIS(2,ISO).EQ.HUSE2(2,JSO))) THEN
+                DENS2(JSO)=0.0
+                VOL2(JSO)=0.0
+                CYCLE
+              ENDIF
+            ENDDO
+          ENDIF
+        ENDDO
+        DO 130 ISO=1,NBISO1 ! Saphyb isotope
+        INAME(1)=INOMIS(1,ISO)
+        INAME(2)=INOMIS(2,ISO)
+        IF(.NOT.LISO(IBM)) THEN
+*         --ONLY option
+          DO KSO=1,NISO(IBM) ! user-selected isotope
+            IF((INAME(1).EQ.HISO(1,IBM,KSO)).AND.
+     1         (INAME(2).EQ.HISO(2,IBM,KSO))) GO TO 120
+          ENDDO
+          GO TO 130
+        ENDIF
+  120   JSO=JJSO(ISO)
+        IF(JSO.GT.0) THEN
+          ITOD2(JSO)=ITOD1(ISO)
+          ISTY2(JSO)=ISTY1(ISO)
+          DENS2(JSO)=DENS2(JSO)+DENS3(ISO)
+          VOL2(JSO)=VOL2(JSO)+XVOLM(IBMOLD)
+        ENDIF
+  130   CONTINUE
+      ENDIF
+*----
+*  SET PIFI INFORMATION
+*----
+      ALLOCATE(IMICR(NBISO1))
+      IMICR(:NBISO1)=0
+      NBS1=0
+      DO 140 JSO=1,NBISO2 ! microlib isotope
+      IF(IMIX2(JSO).EQ.IBM) THEN
+        NBS1=NBS1+1
+        IF(NBS1.GT.NBISO1) CALL XABORT('SCRLIB: NBISO1 OVERFLOW.')
+        IMICR(NBS1)=JSO
+      ENDIF
+  140 CONTINUE
+      DO 170 ISO=1,NBS1 ! Saphyb isotope
+      JSO=IMICR(ISO)
+      KPLIB=LCMDIL(JPLIB,JSO) ! step up isot JSO
+      CALL LCMLEN(KPLIB,'PYIELD',LMY1,ITYLCM)
+      IF(LMY1.GT.0) THEN
+        ALLOCATE(IPYNAM(2,LMY1),IPYMIX(LMY1),IPIFI(LMY1))
+        IPIFI(:LMY1)=0
+        CALL LCMGET(KPLIB,'PYNAM',IPYNAM)
+        CALL LCMGET(KPLIB,'PYMIX',IPYMIX)
+        DO 160 IY1=1,LMY1
+        INAME(1)=IPYNAM(1,IY1)
+        INAME(2)=IPYNAM(2,IY1)
+        WRITE(HNISO,'(2A4)') (INAME(I0),I0=1,2)
+        IF(HNISO.NE.' ') THEN
+          DO 150 KSO=1,NBS1
+          LSO=IMICR(KSO)
+          IF((INAME(1).EQ.HUSE2(1,LSO)).AND.(INAME(2).EQ.HUSE2(2,LSO))
+     1    .AND.(IPYMIX(IY1).EQ.IMIX2(LSO))) THEN
+            IPIFI(IY1)=LSO
+            GO TO 160
+          ENDIF
+  150     CONTINUE
+          IF(IPIFI(IY1).EQ.0) THEN
+            WRITE(HSMG,'(40HSCRLIB: FAILURE TO FIND FISSILE ISOTOPE ,
+     1      A12,25H AMONG MICROLIB ISOTOPES.)') HNISO
+            CALL XABORT(HSMG)
+          ENDIF
+        ENDIF
+  160   CONTINUE
+        CALL LCMPUT(KPLIB,'PIFI',LMY1,1,IPIFI)
+        DEALLOCATE(IPIFI,IPYMIX,IPYNAM)
+      ENDIF
+  170 CONTINUE
+      DEALLOCATE(IMICR)
+  180 CONTINUE ! end of loop over microlib mixtures.
+*----
+*  RELEASE MEMORY
+*----
+      DEALLOCATE(FACT,DENS1)
+      DEALLOCATE(INVELSB,BETARB,CHIRSB)
+      DEALLOCATE(INVELS,BETAR,CHIRS,LAMB)
+      DEALLOCATE(LXS)
+      DEALLOCATE(XS,SS2D,SIGS,NWT0,TAUXFI)
+      DEALLOCATE(ITOD1,LENGDP,LENGDX,ISADRX)
+      DEALLOCATE(YLDSM)
+      IF(NISOTS.GT.0) DEALLOCATE(ISOTS)
+      IF(NADRX.GT.0) DEALLOCATE(IADRX)
+      DEALLOCATE(DENS0,XVOLM,JJSO,INOMIS,IRESM,ITOTM)
+*----
+*  MICROLIB FINALIZATION
+*----
+      IF(.NOT.LRES) THEN
+        ISTATE(:NSTATE)=0
+        ISTATE(1)=NMIX
+        ISTATE(2)=NBISO2
+        ISTATE(3)=NGRP
+        ISTATE(4)=NL
+        ISTATE(5)=ITRANC
+        ISTATE(7)=1
+        IF(ITER.EQ.3) ISTATE(12)=NMIX
+        ISTATE(13)=NED2
+        ISTATE(14)=NMIX
+        ISTATE(18)=1
+        ISTATE(19)=NPRC
+        ISTATE(20)=MY1
+        ISTATE(22)=MAXISO/NMIX
+        IF(NSURFD.GT.0) ISTATE(24)=2 ! ADF information
+        IF(NBISO2.EQ.0) CALL XABORT('SCRLIB: NBISO2=0.')
+        CALL LCMPUT(IPLIB,'STATE-VECTOR',NSTATE,1,ISTATE)
+        CALL LCMPUT(IPLIB,'MIXTURESVOL',NMIX,2,VOLMI2)
+        CALL LCMPUT(IPLIB,'ISOTOPESUSED',3*NBISO2,3,HUSE2)
+        CALL LCMPUT(IPLIB,'ISOTOPERNAME',3*NBISO2,3,HNAM2)
+        CALL LCMPUT(IPLIB,'ISOTOPESDENS',NBISO2,2,DENS2)
+        CALL LCMPUT(IPLIB,'ISOTOPESMIX',NBISO2,1,IMIX2)
+        CALL LCMPUT(IPLIB,'ISOTOPESVOL',NBISO2,2,VOL2)
+        IF(NED2.GT.0) CALL LCMPTC(IPLIB,'ADDXSNAME-P0',8,NED2,HVECT2)
+        CALL LCMPUT(IPLIB,'ISOTOPESTODO',NBISO2,1,ITOD2)
+        CALL LCMPUT(IPLIB,'ISOTOPESTYPE',NBISO2,1,ISTY2)
+      ELSE IF(LRES.AND.(NISOP.GT.0)) THEN
+        CALL LCMPUT(IPLIB,'ISOTOPESDENS',NBISO2,2,DENS2)
+        CALL LCMPUT(IPLIB,'ISOTOPESVOL',NBISO2,2,VOL2)
+      ENDIF
+      IF(IMPX.GT.5) CALL LCMLIB(IPLIB)
+      IACCS=1
+*----
+*  COMPUTE THE MACROSCOPIC X-SECTIONS
+*----
+      IF((ITER.NE.0).AND.(ITER.NE.3)) GO TO 280
+      CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+      MAXMIX=ISTATE(1)
+      IF(MAXMIX.NE.NMIX) CALL XABORT('SCRLIB: INVALID NMIX.')
+      NBISO=ISTATE(2)
+      ALLOCATE(MASK(MAXMIX),MASKL(NGRP))
+      ALLOCATE(ISONA(3*NBISO),ISOMI(NBISO),DENIS(NBISO))
+      CALL LCMGET(IPLIB,'ISOTOPESUSED',ISONA)
+      CALL LCMGET(IPLIB,'ISOTOPESMIX',ISOMI)
+      CALL LCMGET(IPLIB,'ISOTOPESDENS',DENIS)
+      MASK(:MAXMIX)=.TRUE.
+      MASKL(:NGRP)=.TRUE.
+      ITSTMP=0
+      TMPDAY(1)=0.0
+      TMPDAY(2)=0.0
+      TMPDAY(3)=0.0
+      CALL LCMLEN(IPLIB,'MACROLIB',ILONG,ITYLCM)
+      IF(ILONG.NE.0) CALL LCMDEL(IPLIB,'MACROLIB')
+      CALL LIBMIX(IPLIB,MAXMIX,NGRP,NBISO,ISONA,ISOMI,DENIS,MASK,MASKL,
+     1 ITSTMP,TMPDAY)
+      DEALLOCATE(MASKL,MASK)
+      DEALLOCATE(DENIS,ISOMI,ISONA)
+      IF(NSURFD.GT.0) THEN
+        CALL LCMSIX(IPLIB,'MACROLIB',1)
+        CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+        ISTATE(12)=2
+        CALL LCMPUT(IPLIB,'STATE-VECTOR',NSTATE,1,ISTATE)
+        CALL LCMSIX(IPLIB,' ',2)
+      ENDIF
+*----
+*  SAVE MASL INFORMATION
+*----
+      IF(HMASL.NE.' ') THEN
+        CALL LCMSIX(IPLIB,'MACROLIB',1)
+        CALL LCMPUT(IPLIB,'MASL',NMIX,2,FMASL)
+        CALL LCMSIX(IPLIB,' ',2)
+      ENDIF
+*----
+*  INCLUDE LEAKAGE IN THE MACROLIB (USED ONLY FOR NON-REGRESSION TESTS)
+*----
+      IF(B2.NE.0.0) THEN
+        IF(IMPX.GT.0) WRITE(IOUT,'(/31H SCRLIB: INCLUDE LEAKAGE IN THE,
+     1  14H MACROLIB (B2=,1P,E12.5,2H).)') B2
+        CALL LCMSIX(IPLIB,'MACROLIB',1)
+        JPLIB=LCMGID(IPLIB,'GROUP')
+        ALLOCATE(GAR1(NMIX),GAR2(NMIX))
+        DO 270 IGR=1,NGRP
+          KPLIB=LCMGIL(JPLIB,IGR)
+          CALL LCMGET(KPLIB,'NTOT0',GAR1)
+          CALL LCMGET(KPLIB,'DIFF',GAR2)
+          DO 260 IBM=1,NMIX
+            IF(MIXC(IBM).NE.0) GAR1(IBM)=GAR1(IBM)+B2*GAR2(IBM)
+  260     CONTINUE
+          CALL LCMPUT(KPLIB,'NTOT0',NMIX,2,GAR1)
+  270   CONTINUE
+        DEALLOCATE(GAR2,GAR1)
+        CALL LCMSIX(IPLIB,' ',2)
+      ENDIF
+*----
+*  PROCESS ADF INFORMATION
+*----
+  280 IF(NSURFD.GT.0) THEN
+        DO 285 IBM=1,NMIX ! mixtures in Macrolib
+          IF(MIXC(IBM).NE.0) ADF2(IBM,:NGRP,:NSURFD)=0.0
+  285   CONTINUE
+        DO 300 ICAL=1,NCAL
+        DO 290 IBM=1,NMIX ! mixtures in Macrolib
+        IF(MIXC(IBM).EQ.0) GO TO 290
+        WEIGHT=TERP(ICAL,IBM)
+        IF(WEIGHT.EQ.0.0) GO TO 290
+        KPMEM=LCMGIL(JPMEM,ICAL)
+        CALL LCMSIX(KPMEM,'outflx',1)
+        CALL LCMGET(KPMEM,'SURFLX',SURFLX)
+        CALL LCMSIX(KPMEM,' ',2)
+        CALL LCMSIX(KPMEM,' ',2)
+        DO I=1,NSURFD
+          WRITE(HADF(I),'(3HFD_,I5.5)') I
+          DO IGR=1,NGRP
+            ADF2(IBM,IGR,I)=ADF2(IBM,IGR,I)+WEIGHT*SURFLX(I,IGR)/SURF(I)
+          ENDDO
+        ENDDO
+  290   CONTINUE
+  300   CONTINUE
+        CALL LCMSIX(IPLIB,'MACROLIB',1)
+        CALL LCMSIX(IPLIB,'ADF',1)
+        CALL LCMPUT(IPLIB,'NTYPE',1,1,NSURFD)
+        CALL LCMPTC(IPLIB,'HADF',8,NSURFD,HADF)
+        DO I=1,NSURFD
+          CALL LCMPUT(IPLIB,HADF(I),NMIX*NGRP,2,ADF2(1,1,I))
+        ENDDO
+        CALL LCMSIX(IPLIB,' ',2)
+        CALL LCMSIX(IPLIB,' ',2)
+        DEALLOCATE(ADF2,HADF)
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(SURFLX,SURF)
+      DEALLOCATE(ADF2,HADF)
+      DEALLOCATE(FMASL,SPH,FLUX,VOLMI2,VOL2,DENS3,DENS2)
+      DEALLOCATE(HNAM2,HUSE2,ISTY2,ISTY1,ITOD2,IMIX2)
+      RETURN
+      END
diff --git a/Donjon/src/SCRMEM.f b/Donjon/src/SCRMEM.f
new file mode 100644
index 0000000..5f5f38f
--- /dev/null
+++ b/Donjon/src/SCRMEM.f
@@ -0,0 +1,95 @@
+*DECK SCRMEM
+      SUBROUTINE SCRMEM(IPSAP,IPMEM,NCAL,NMIL,NMIX,TERP,MIXC)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Copy a Saphyb into memory taking care to keep only required
+* calculations and mixtures.
+*
+*Copyright:
+* Copyright (C) 2013 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPSAP   address of the Saphyb object.
+* IPMEM   address of the simplified Saphyb in memory created by SCRMEM.
+* NCAL    number of elementary calculations in the Saphyb.
+* NMIL    number of material mixtures in the Saphyb
+* NMIX    maximum number of material mixtures in the microlib.
+* TERP    interpolation factors.
+* MIXC    mixture index in the Saphyb corresponding to each microlib
+*         mixture.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPSAP,IPMEM
+      INTEGER NCAL,NMIL,NMIX,MIXC(NMIX)
+      REAL TERP(NCAL,NMIX)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER DIMSAP(50)
+      INTEGER IBM, IBMOLD, ICAL, ILONG, ITYLCM
+      CHARACTER SIGN*12,TEXT12*12
+      TYPE(C_PTR) JPSAP,KPSAP,JPMEM1,JPMEM2,KPMEM1,KPMEM2
+*
+      CALL LCMOP(IPMEM,'*tempSaphyb*',0,1,0)
+      CALL LCMGTC(IPSAP,'SIGNATURE',12,SIGN)
+      CALL LCMPTC(IPMEM,'SIGNATURE',12,SIGN)
+      CALL LCMGET(IPSAP,'DIMSAP',DIMSAP)
+      CALL LCMPUT(IPMEM,'DIMSAP',50,1,DIMSAP)
+      JPSAP=LCMGID(IPSAP,'constphysiq')
+      JPMEM1=LCMDID(IPMEM,'constphysiq')
+      CALL LCMEQU(JPSAP,JPMEM1)
+      JPSAP=LCMGID(IPSAP,'contenu')
+      JPMEM1=LCMDID(IPMEM,'contenu')
+      CALL LCMEQU(JPSAP,JPMEM1)
+      JPSAP=LCMGID(IPSAP,'adresses')
+      JPMEM1=LCMDID(IPMEM,'adresses')
+      CALL LCMEQU(JPSAP,JPMEM1)
+      JPSAP=LCMGID(IPSAP,'geom')
+      JPMEM1=LCMDID(IPMEM,'geom')
+      CALL LCMEQU(JPSAP,JPMEM1)
+      JPMEM1=LCMLID(IPMEM,'calc',NCAL)
+      DO 30 ICAL=1,NCAL
+        DO IBM=1,NMIX
+          IF(TERP(ICAL,IBM).NE.0.0) GO TO 10
+        ENDDO
+        GO TO 30
+   10   WRITE(TEXT12,'(4Hcalc,I8)') ICAL
+        JPSAP=LCMGID(IPSAP,TEXT12)
+        JPMEM2=LCMDIL(JPMEM1,ICAL)
+        KPSAP=LCMGID(JPSAP,'info')
+        KPMEM1=LCMDID(JPMEM2,'info')
+        CALL LCMEQU(KPSAP,KPMEM1)
+        KPSAP=LCMGID(JPSAP,'divers')
+        KPMEM1=LCMDID(JPMEM2,'divers')
+        CALL LCMEQU(KPSAP,KPMEM1)
+        CALL LCMLEN(JPSAP,'outflx',ILONG,ITYLCM)
+        IF(ILONG.NE.0) THEN
+          KPSAP=LCMGID(JPSAP,'outflx')
+          KPMEM1=LCMDID(JPMEM2,'outflx')
+          CALL LCMEQU(KPSAP,KPMEM1)
+        ENDIF
+        KPMEM1=LCMLID(JPMEM2,'mili',NMIL)
+        DO IBMOLD=1,NMIL
+          DO IBM=1,NMIX
+           IF((TERP(ICAL,IBM).NE.0.).AND.(MIXC(IBM).EQ.IBMOLD)) GO TO 20
+          ENDDO
+          CYCLE
+   20     WRITE(TEXT12,'(4Hmili,I8)') IBMOLD
+          KPSAP=LCMGID(JPSAP,TEXT12)
+          KPMEM2=LCMDIL(KPMEM1,IBMOLD)
+          CALL LCMEQU(KPSAP,KPMEM2)
+        ENDDO
+   30 CONTINUE
+      RETURN
+      END
diff --git a/Donjon/src/SCRNDF.f b/Donjon/src/SCRNDF.f
new file mode 100644
index 0000000..643d4de
--- /dev/null
+++ b/Donjon/src/SCRNDF.f
@@ -0,0 +1,115 @@
+*DECK SCRNDF
+      SUBROUTINE SCRNDF(IMPX,NBISO1,ISO,IBM,INOMIS,IPMEM,IPLIB,NCAL,
+     1 TERP,MY1,MY2,YLDS,ISTYP)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Store records PYNAM, PYMIX and PYIELD into a Microlib.
+*
+*Copyright:
+* Copyright (C) 2015 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IMPX    print parameter (equal to zero for no print).
+* NBISO1  number of particularized isotopes.
+* ISO     particularized isotope index.
+* IBM     material mixture.
+* INOMIS  array containing the names of the particularized isotopes.
+* IPMEM   pointer to the memory-resident Saphyb object.
+* IPLIB   address of the output microlib LCM object.
+* NCAL    number of elementary calculations in the Saphyb.
+* TERP    interpolation factors.
+* MY1     number of fissile isotopes including macroscopic sets.
+* MY2     number of fission fragment.
+* YLDS    fission yields.
+*
+*Parameters: output
+* ISTYP   type of isotope ISO (=2: fissile; =3: fission product).
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMEM,IPLIB
+      INTEGER IMPX,NBISO1,ISO,IBM,INOMIS(2,NBISO1),NCAL,MY1,MY2,ISTYP
+      REAL TERP(NCAL)
+      DOUBLE PRECISION YLDS(MY1,MY2)
+*----
+*  LOCAL VARIABLES
+*----
+      TYPE(C_PTR) JPMEM,KPMEM
+      INTEGER I, I0, ICAL, IY1, IY2, JSO, NISY
+*----
+*  ALLOCATABLE AYYAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: ADRY,IPYMIX
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: IPYNAM
+      REAL, ALLOCATABLE, DIMENSION(:) :: PYIELD
+*
+      JPMEM=LCMGID(IPMEM,'calc')
+      ISTYP=0
+      DO 10 ICAL=NCAL,1,-1
+      IF(TERP(ICAL).EQ.0.0) GO TO 10
+      KPMEM=LCMGIL(JPMEM,ICAL)
+      CALL LCMSIX(KPMEM,'info',1)
+      CALL LCMGET(KPMEM,'NISY',NISY)
+      IF(ISO.GT.NISY) CALL XABORT('SCRNDF: NISY OVERFLOW.')
+      ALLOCATE(ADRY(NISY))
+      CALL LCMGET(KPMEM,'ADRY',ADRY)
+      CALL LCMSIX(KPMEM,' ',2)
+      IF(ADRY(ISO).GT.0) THEN
+*       ISO is a fissile isotope
+        ISTYP=2
+      ELSE IF(ADRY(ISO).LT.0) THEN
+*       ISO is a fission product
+        ISTYP=3
+        IY2=-ADRY(ISO)
+        IF(IY2.GT.MY2) CALL XABORT('SCRNDF: MY2 OVERFLOW.')
+        ALLOCATE(IPYNAM(2,MY1),IPYMIX(MY1),PYIELD(MY1))
+        IPYNAM(:2,:MY1)=0
+        IPYMIX(:MY1)=0
+        PYIELD(:MY1)=0.0
+        IF(IMPX.GT.2) THEN
+          WRITE(6,'(25H SCRNDF: fission product=,2A4,9H mixture=,I8)')
+     1    (INOMIS(I0,ISO),I0=1,2),IBM
+        ENDIF
+        DO JSO=1,NISY
+          IF(ADRY(JSO).GT.0) THEN
+            IY1=ADRY(JSO)
+            IF(IY1.GT.MY1) CALL XABORT('SCRNDF: MY1 OVERFLOW.')
+            IPYNAM(1,IY1)=INOMIS(1,JSO)
+            IPYNAM(2,IY1)=INOMIS(2,JSO)
+            IPYMIX(IY1)=IBM
+            PYIELD(IY1)=REAL(YLDS(IY1,IY2))
+            IF(IMPX.GT.2) THEN
+              WRITE(6,'(9X,16Hfissile isotope(,I4,2H)=,2A4,9H mixture=,
+     1        I8)') IY1,(IPYNAM(I0,IY1),I0=1,2),IPYMIX(IY1)
+            ENDIF
+          ENDIF
+        ENDDO
+        CALL LCMPUT(IPLIB,'PYNAM',2*MY1,3,IPYNAM)
+        CALL LCMPUT(IPLIB,'PYMIX',MY1,1,IPYMIX)
+        CALL LCMPUT(IPLIB,'PYIELD',MY1,2,PYIELD)
+        IF(IMPX.GT.2) THEN
+          WRITE(6,'(3X,7HPYIELD=,1P,8E12.4/(8X,10E12.4))') (PYIELD(I),
+     1    I=1,MY1)
+        ENDIF
+        DEALLOCATE(PYIELD,IPYMIX,IPYNAM)
+      ENDIF
+      DEALLOCATE(ADRY)
+      RETURN
+   10 CONTINUE
+      CALL XABORT('SCRNDF: UNABLE TO FIND A CALCULATION DIRECTORY.')
+      RETURN
+      END
diff --git a/Donjon/src/SCRRGR.f b/Donjon/src/SCRRGR.f
new file mode 100644
index 0000000..522f157
--- /dev/null
+++ b/Donjon/src/SCRRGR.f
@@ -0,0 +1,882 @@
+*DECK SCRRGR
+      SUBROUTINE SCRRGR(IPSAP,IPMAP,LCUBIC,NMIX,IMPX,NMIL,NCAL,MD2,
+     1 NCH,NB,NFUEL,NPARM,ITER,MAXNIS,MIXC,TERP,NISO,LISO,HISO,CONC,
+     2 ITODO)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute TERP factors for Saphyb interpolation. Use global parameters
+* from a fuel-map object and optional user-defined values.
+*
+*Copyright:
+* Copyright (C) 2012 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPSAP   address of the Saphyb object.
+* IPMAP   address of the fuel-map object.
+* LCUBIC  =.TRUE.: cubic Ceschino interpolation; =.FALSE: linear
+*         Lagrange interpolation.
+* NMIX    number of material mixtures in the fuel-map macrolib.
+* IMPX    printing index (=0 for no print).
+* NMIL    number of material mixtures in the Saphyb.
+* NCAL    number of elementary calculations in the Saphyb.
+* MD2     number of particularized and macro isotopes in the Saphyb.
+* NCH     number of reactor channels.
+* NB      number of fuel bundles per channel.
+* NFUEL   number of fuel types.
+* NPARM   number of additional parameters (other than burnup) defined
+*         in FMAP object
+*
+*Parameters: output
+* ITER    completion flag (=0: all over; =1: use another Saphyb;
+*         =2 use another L_MAP + Saphyb).
+* MAXNIS  maximum value of NISO(I) in user data.
+* MIXC    mixture index in the Saphyb corresponding to each microlib
+*         mixture.
+* TERP    interpolation factors.
+* NISO    number of user-selected isotopes.
+* LISO    type of treatment (=.true.: ALL; =.false.: ONLY).
+* HISO    name of the user-selected isotopes.
+* CONC    user-defined number density of the user-selected isotopes. A
+*         value of -99.99 is set to indicate that the compo value is
+*         used.
+* ITODO   non-depletion mask (=1 to force a user-selected isotope to be
+*         non-depleting)
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPSAP,IPMAP
+      INTEGER NMIX,IMPX,NMIL,NCAL,MD2,NFUEL,NCH,NB,ITER,MAXNIS,
+     1        MIXC(NMIX),NPARM,HISO(2,NMIX,MD2),NISO(NMIX),
+     2        ITODO(NMIX,MD2)
+      REAL TERP(NCAL,NMIX),CONC(NMIX,MD2)
+      LOGICAL LCUBIC,LISO(NMIX)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXADD=10
+      INTEGER, PARAMETER::MAXPAR=50
+      INTEGER, PARAMETER::MAXLIN=50
+      INTEGER, PARAMETER::MAXVAL=200
+      REAL, PARAMETER::REPS=1.0E-4
+      INTEGER I0, IBMOLD, IBM, IBTYP, IB, ICAL, ICH, IFUEL, ILONG, IMIX,
+     & IMPY, INDIC, IPAR, ISO, ITYLCM, ITYPE, ITYP, IVARTY, I, JBM, JB,
+     & JCAL, JPARM, JPAR, J, LENGTH, NCOMLI, NISOMI, NITMA, NPARMP,
+     & NPAR, NTOT, NVP, N
+      REAL BURN0, BURN1, FLOTT, SUM, VALR1, VALR2, VARVAL
+      CHARACTER TEXT12*12,PARKEY(MAXPAR)*4,PARTYP(MAXPAR)*4,
+     1 PARFMT(MAXPAR)*8,HSMG*131,COMMEN(MAXLIN)*80,VALH(MAXPAR)*12,
+     2 VCHAR(MAXVAL)*12,RECNAM*12,PARNAM*12,HCUBIC*12,HNAVAL*12
+      INTEGER DIMSAP(50),VALI(MAXPAR),NVALUE(MAXPAR),VINTE(MAXVAL),
+     1 MUPLET(2*MAXPAR),MUTYPE(2*MAXPAR),MAPLET(2*MAXPAR,MAXADD),
+     2 MATYPE(2*MAXPAR,MAXADD),IDLTA(2*MAXPAR,MAXADD),NDLTA(2*MAXPAR),
+     3 IDLTA1,MUPLT2(2*MAXPAR),MUTYP2(2*MAXPAR),HISOMI(2,MD2)
+      DOUBLE PRECISION DFLOTT
+      REAL VALR(2*MAXPAR,2),VREAL(MAXVAL),VALRA(2*MAXPAR,2,MAXADD),
+     1 CONCMI(MD2)
+      LOGICAL LDELT(2*MAXPAR),LDELT1,LSET(2*MAXPAR),LADD(2*MAXPAR),
+     1 LSET1,LADD1,LDMAP(2*MAXPAR,2),LAMAP(2*MAXPAR,2,MAXADD),
+     2 LCUB2(MAXPAR),LTST,LISOMI
+      TYPE(C_PTR) JPMAP,KPMAP,LPSAP
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: FMIX,ZONEC
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ZONEDP
+      REAL, ALLOCATABLE, DIMENSION(:) :: BRN0,BRN1,VARC,TERPA
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: WPAR
+      LOGICAL, ALLOCATABLE, DIMENSION(:) :: LPARM,LDELTA
+      CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: HPAR
+*----
+*  SCRATCH STORAGE ALLOCATION
+*   FMIX    fuel mixture indices per fuel bundle.
+*   BRN0    contains either low burnup integration limits or
+*           instantaneous burnups per fuel bundle.
+*   BRN1    upper burnup integration limits per fuel bundle.
+*   WPAR    other parameter distributions.
+*   HPAR    'PARKEY' name of the other parameters.
+*----
+      ALLOCATE(LPARM(NPARM+1),FMIX(NCH*NB),ZONEDP(NCH,NB),ZONEC(NCH),
+     1 BRN0(NCH*NB),BRN1(NCH*NB),WPAR(NCH*NB,NPARM),LDELTA(NMIX),
+     2 HPAR(NPARM+1))
+*----
+*  RECOVER TABLE-OF-CONTENT INFORMATION FOR THE SAPHYB.
+*----
+      CALL LCMGET(IPSAP,'DIMSAP',DIMSAP)
+      NCOMLI=DIMSAP(1)
+      NPAR=DIMSAP(8)
+      NVP=DIMSAP(17)
+      IF(NCOMLI.GT.MAXLIN) CALL XABORT('SCRRGR: MAXLIN OVERFLOW.')
+      IF(NPAR.GT.MAXPAR) CALL XABORT('SCRRGR: MAXPAR OVERFLOW.')
+      CALL LCMGTC(IPSAP,'COMMEN',80,NCOMLI,COMMEN)
+      IF(NPAR.GT.0)THEN
+        CALL LCMSIX(IPSAP,'paramdescrip',1)
+        CALL LCMGTC(IPSAP,'PARKEY',4,NPAR,PARKEY)
+        CALL LCMGTC(IPSAP,'PARTYP',4,NPAR,PARTYP)
+        CALL LCMGTC(IPSAP,'PARFMT',8,NPAR,PARFMT)
+        CALL LCMSIX(IPSAP,' ',2)
+      ENDIF
+      IF(IMPX.GT.0)WRITE(IOUT,'(1X,A)') (COMMEN(I),I=1,NCOMLI)
+      TERP(:NCAL,:NMIX)=0.0
+      MIXC(:NMIX)=0
+*----
+*  READ (INTERP_DATA) AND SET VALI, VALR AND VALH PARAMETERS
+*  CORRESPONDING TO THE INTERPOLATION POINT. FILL MUPLET FOR
+*  PARAMETERS SET WITHOUT INTERPOLATION.
+*----
+      IBM=0
+      MAXNIS=0
+      NISOMI=0
+      LISOMI=.TRUE.
+      LDELT1=.FALSE.
+      LADD1=.FALSE.
+      NISO(:NMIX)=0
+      LISO(:NMIX)=.TRUE.
+      LDELTA(:NMIX)=.FALSE.
+      ITODO(:NMIX,:MD2)=0
+      IDLTA1=0
+      DO I=1,2*MAXPAR
+         LSET(I)=.FALSE.
+         LDELT(I)=.FALSE.
+         LADD(I)=.FALSE.
+         LDMAP(I,:2)=.FALSE.
+         LAMAP(I,:2,:MAXADD)=.FALSE.
+         NDLTA(I)=0
+      ENDDO
+*----
+*  READ THE PARKEY NAME OF THE BURNUP FOR THIS SAPHYB.
+*----
+      CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+      IF(INDIC.NE.3)CALL XABORT('SCRRGR: CHARACTER DATA EXPECTED(1).')
+      IF((TEXT12.EQ.'MIX').OR.(TEXT12.EQ.';')) THEN
+        NPARMP=NPARM
+        GO TO 30
+      ELSE
+*       add burnup to parameters
+        NPARMP=NPARM+1
+        HPAR(NPARMP)=TEXT12(:4)
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3)CALL XABORT('MCRRGR: CHARACTER DATA EXPECTED(2).')
+        IF((TEXT12.EQ.'MIX').OR.(TEXT12.EQ.';')) GO TO 30
+        HNAVAL=TEXT12
+      ENDIF
+*----
+*  MAIN LOOP OF THE SUBROUTINE (UNTIL THE END)
+*----
+   20 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+      IF(INDIC.NE.3)CALL XABORT('SCRRGR: CHARACTER DATA EXPECTED(2).')
+   30 IF(TEXT12.EQ.'MIX')THEN
+        NISOMI=0
+        LISOMI=.TRUE.
+        IVARTY=0
+        IBTYP=0
+        HNAVAL=' '
+        MUPLET(:NPAR)=0
+        MUTYPE(:NPAR)=0
+        VALI(:NPAR)=0
+        VALR(:NPAR,1)=0.0
+        VALR(:NPAR,2)=0.0
+        DO 35 I=1,MAXADD
+          MAPLET(:NPAR,I)=0
+          MATYPE(:NPAR,I)=0
+          VALRA(:NPAR,1,I)=0.0
+          VALRA(:NPAR,2,I)=0.0
+   35   CONTINUE
+        DO I=1,2*MAXPAR
+          LSET(I)=.FALSE.
+          LDELT(I)=.FALSE.
+          LADD(I)=.FALSE.
+          LDMAP(I,:2)=.FALSE.
+          LAMAP(I,:2,:MAXADD)=.FALSE.
+        ENDDO
+        DO 40 I=1,NPAR
+        VALH(I)=' '
+   40   CONTINUE
+        LCUB2(:NPAR)=LCUBIC
+        CALL REDGET(INDIC,IBM,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1)CALL XABORT('SCRRGR: INTEGER DATA EXPECTED.')
+*       CHECK FUEL MIXTURE
+        JPMAP=LCMGID(IPMAP,'FUEL')
+        DO IFUEL=1,NFUEL
+          KPMAP=LCMGIL(JPMAP,IFUEL)
+          CALL LCMGET(KPMAP,'MIX',IMIX)
+          IF(IMIX.EQ.IBM)GOTO 50
+        ENDDO
+        WRITE(IOUT,*)'SCRRGR: UNABLE TO FIND FUEL MIXTURE ',IBM
+        CALL XABORT('SCRRGR: WRONG MIXTURE NUMBER.')
+   50   IBMOLD=1
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3)CALL XABORT('SCRRGR: CHARACTER DATA EXPECTED(3).')
+        IF(TEXT12.EQ.'FROM')THEN
+          CALL REDGET(INDIC,IBMOLD,FLOTT,TEXT12,DFLOTT)
+          IF(INDIC.NE.1)CALL XABORT('SCRRGR: INTEGER DATA EXPECTED.')
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          IF(INDIC.NE.3)CALL XABORT('SCRRGR: CHARACTER DATA EXPECTE'
+     1     //'D.')
+        ELSE IF(TEXT12.EQ.'USE') THEN
+          IBMOLD=IBM
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          IF(INDIC.NE.3)CALL XABORT('SCRRGR: CHARACTER DATA EXPECTE'
+     1     //'D.')
+        ENDIF
+        GOTO 30
+      ELSEIF(TEXT12.EQ.'MICRO')THEN
+        IF(IBM.EQ.0) CALL XABORT('SCRRGR: MIX NOT SET (1).')
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3)CALL XABORT('SCRRGR: CHARACTER DATA EXPECTED(4).')
+        IF(TEXT12.EQ.'ALL')THEN
+          LISOMI=.TRUE.
+        ELSEIF(TEXT12.EQ.'ONLY')THEN
+          LISOMI=.FALSE.
+        ENDIF
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3)CALL XABORT('SCRRGR: CHARACTER DATA EXPECTED(5).')
+   60   IF(TEXT12.EQ.'ENDMIX')THEN
+          GOTO 30
+        ELSE IF(TEXT12.EQ.'NOEV') THEN
+          IF(NISOMI.EQ.0) CALL XABORT('SCRRGR: MISPLACED NOEV.')
+          ITODO(IBM,NISOMI)=1
+        ELSE
+          NISOMI=NISOMI+1
+          IF(NISOMI.GT.MD2) CALL XABORT('SCRRGR: MD2 OVERFLOW.')
+          MAXNIS=MAX(MAXNIS,NISOMI)
+          READ(TEXT12,'(2A4)') (HISOMI(I0,NISOMI),I0=1,2)
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          IF(INDIC.EQ.2)THEN
+            CONCMI(NISOMI)=FLOTT
+          ELSEIF((INDIC.EQ.3).AND.(TEXT12.EQ.'*'))THEN
+            CONCMI(NISOMI)=-99.99
+          ELSE
+            CALL XABORT('SCRRGR: INVALID HISO DATA.')
+          ENDIF
+        ENDIF
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3)CALL XABORT('SCRRGR: CHARACTER DATA EXPECTED.')
+        GOTO 60
+      ELSEIF((TEXT12.EQ.'SET').OR.(TEXT12.EQ.'DELTA').OR.
+     1       (TEXT12.EQ.'ADD'))THEN
+        IF(IBM.EQ.0) CALL XABORT('SCRRGR: MIX NOT SET (2).')
+        LSET1=.FALSE.
+        LDELT1=.FALSE.
+        LADD1=.FALSE.
+        ITYPE=0
+        IF(TEXT12.EQ.'SET')THEN
+          ITYPE=1
+          LSET1=.TRUE.
+        ELSEIF(TEXT12.EQ.'DELTA')THEN
+          ITYPE=2
+          LDELT1=.TRUE.
+        ELSEIF(TEXT12.EQ.'ADD')THEN
+          ITYPE=2
+          LADD1=.TRUE.
+          IDLTA1=IDLTA1+1
+          DO 65 JPAR=1,NPAR
+            MAPLET(JPAR,IDLTA1)=MUPLET(JPAR)
+            MATYPE(JPAR,IDLTA1)=MUTYPE(JPAR)
+   65     CONTINUE
+        ENDIF
+        CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.3)CALL XABORT('SCRRGR: CHARACTER DATA EXPECTED(7).')
+        IF((TEXT12.EQ.'LINEAR').OR.(TEXT12.EQ.'CUBIC')) THEN
+          HCUBIC=TEXT12
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+        ELSE
+          HCUBIC=' '
+        ENDIF
+        IF(INDIC.NE.3)CALL XABORT('SCRRGR: CHARACTER DATA EXPECTED(8).')
+        DO I=1,NPAR
+          IF(TEXT12.EQ.PARKEY(I))THEN
+            IPAR=I
+            PARNAM=TEXT12
+            GOTO 70
+          ENDIF
+        ENDDO
+        WRITE(HSMG,'(18HSCRRGR: PARAMETER ,A,14H NOT FOUND(1).)') TEXT12
+        CALL XABORT(HSMG)
+*
+   70   IF(HCUBIC.EQ.'LINEAR') THEN
+          LCUB2(IPAR)=.FALSE.
+        ELSE IF(HCUBIC.EQ.'CUBIC') THEN
+          LCUB2(IPAR)=.TRUE.
+        ENDIF
+        WRITE(RECNAM,'(''pval'',I8)') IPAR
+        LPSAP=LCMGID(IPSAP,'paramdescrip')
+        CALL LCMGET(LPSAP,'NVALUE',NVALUE)
+        IF(NVALUE(IPAR).GT.MAXVAL)CALL XABORT('SCRRGR: MAXVAL OVERFLOW')
+        LPSAP=LCMGID(IPSAP,'paramvaleurs')
+        CALL LCMLEN(LPSAP,RECNAM,LENGTH,ITYLCM)
+        IF(LENGTH.EQ.0)THEN
+          CALL LCMLIB(LPSAP)
+          WRITE(HSMG,'(25HSCRRGR: GLOBAL PARAMETER ,A,12H NOT SET(2).)')
+     1    PARNAM
+          CALL XABORT(HSMG)
+        ENDIF
+        IF((IPAR.GT.NPAR).OR.
+     1   ((IPAR.LE.NPAR).AND.(PARFMT(IPAR).EQ.'FLOTTANT')))THEN
+          CALL LCMGET(LPSAP,RECNAM,VREAL)
+          CALL REDGET(INDIC,NITMA,VALR1,TEXT12,DFLOTT)
+          IF(INDIC.EQ.2)THEN
+            VALR2=VALR1
+            IF(LSET1) THEN
+              LSET(IPAR)=.TRUE.
+              VALR(IPAR,1)=VALR1
+              VALR(IPAR,2)=VALR1
+            ENDIF
+            IF(LDELT1) THEN
+              LDELT(IPAR)=.TRUE.
+              VALR(IPAR,1)=VALR1
+              VALR(IPAR,2)=VALR1
+            ELSEIF(LADD1) THEN
+              LADD(IPAR)=.TRUE.
+              VALRA(IPAR,1,IDLTA1)=VALR1
+              VALRA(IPAR,2,IDLTA1)=VALR1
+              NDLTA(IPAR)=NDLTA(IPAR)+1
+              IF(NDLTA(IPAR).GT.MAXADD) CALL XABORT('SCRRGR: MAXADD OV'
+     1        //'ERFLOW.')
+              IDLTA(IPAR,NDLTA(IPAR))=IDLTA1
+            ENDIF
+          ELSEIF(TEXT12.EQ.'MAP')THEN
+            IF(LDELT1)THEN
+              LDELT(IPAR)=.TRUE.
+              LDMAP(IPAR,1)=.TRUE.
+            ELSEIF(LADD1)THEN
+              LADD(IPAR)=.TRUE.
+              NDLTA(IPAR)=NDLTA(IPAR)+1
+              IF(NDLTA(IPAR).GT.MAXADD) CALL XABORT('SCRRGR: MAXADD OV'
+     1        //'ERFLOW.')
+              LAMAP(IPAR,1,NDLTA(IPAR))=.TRUE.
+              IDLTA(IPAR,NDLTA(IPAR))=IDLTA1
+            ENDIF
+            IF(LSET1.AND.(.NOT.LSET(IPAR))) GO TO 20
+          ELSE
+            CALL XABORT('SCRRGR: real value or "MAP" expected(1).')
+          ENDIF
+          CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          IF(ITYPE.GE.2)THEN
+            IF(INDIC.EQ.2)THEN
+              VALR2=FLOTT
+              IF(LDELT1)THEN
+                VALR(IPAR,2)=VALR2
+              ELSEIF(LADD1)THEN
+                VALRA(IPAR,2,IDLTA1)=VALR2
+              ENDIF
+            ELSEIF(TEXT12.EQ.'MAP')THEN
+              IF(LDELT1)THEN
+                LDMAP(IPAR,2)=.TRUE.
+              ELSEIF(LADD1)THEN
+                LAMAP(IPAR,2,IDLTA1)=.TRUE.
+              ENDIF
+            ELSE
+              CALL XABORT('SCRRGR: real value or "MAP" expected(2).')
+            ENDIF
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          ENDIF
+          LTST=.FALSE.
+          IF(.NOT.LADD1)THEN
+            IF(VALR(IPAR,1).EQ.VALR(IPAR,2)) LTST=.TRUE.
+            MUPLET(IPAR)=-1
+            MUTYPE(IPAR)=ITYPE
+          ELSE
+            MAPLET(IPAR,IDLTA1)=-1
+            MATYPE(IPAR,IDLTA1)=2
+          ENDIF
+          IF((LTST).AND.(ITYPE.EQ.1))THEN
+            DO J=1,NVALUE(IPAR)
+              IF(ABS(VALR(IPAR,1)-VREAL(J)).LE.REPS*ABS(VREAL(J)))THEN
+                MUPLET(IPAR)=J
+                GOTO 30
+              ENDIF
+            ENDDO
+          ENDIF
+*----
+*  ERRORS HANDLING
+*----
+          IF(VALR1.LT.VREAL(1))THEN
+*           OUTSIDE OF THE DOMAIN (1)
+            WRITE(HSMG,'(23HSCRRGR: REAL PARAMETER ,A,10H WITH VALU,
+     1       1HE,1P,E12.4,26H IS OUTSIDE THE DOMAIN.(1))') PARNAM,VALR1
+             WRITE(6,*)'Domain:',VREAL(1),' <-> ',VREAL(NVALUE(IPAR))
+            CALL XABORT(HSMG)
+          ELSEIF(VALR2.GT.VREAL(NVALUE(IPAR)))THEN
+*           OUTSIDE OF THE DOMAIN (2)
+            WRITE(HSMG,'(23HSCRRGR: REAL PARAMETER ,A,10H WITH VALU,
+     1       1HE,1P,E12.4,26H IS OUTSIDE THE DOMAIN.(2))') PARNAM,VALR2
+             WRITE(6,*)'Domain:',VREAL(1),' <-> ',VREAL(NVALUE(IPAR))
+            CALL XABORT(HSMG)
+          ELSEIF((VALR1.GT.VALR2).AND.(ITYPE.EQ.1))THEN
+*           ITYPE=1 correspond to an integral between VALR1 and VALR2
+*           otherwise it is a simple difference
+            WRITE(HSMG,'(23HSCRRGR: REAL PARAMETER ,A,9H IS DEFIN,
+     1       7HED WITH,1P,E12.4,2H >,E12.4,4H.(1))') PARNAM,
+     2       VALR1,VALR2
+            CALL XABORT(HSMG)
+          ENDIF
+          IF((LADD1).AND.(TEXT12.EQ.'REF'))THEN
+  120       IPAR=-99
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+            IF(TEXT12.EQ.'ENDREF') GOTO 140
+            DO I=1,NPAR
+              IF(TEXT12.EQ.PARKEY(I))THEN
+                IPAR=I
+                GOTO 130
+              ENDIF
+            ENDDO
+            CALL XABORT('SCRRGR: PARAMETER '//TEXT12//' NOT FOUND(2).')
+  130       CONTINUE
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+            IF(INDIC.EQ.2)THEN
+              VALRA(IPAR,1,IDLTA1)=FLOTT
+              VALRA(IPAR,2,IDLTA1)=FLOTT
+              WRITE(RECNAM,'(''pval'',I8)') IPAR
+              LPSAP=LCMGID(IPSAP,'paramdescrip')
+              CALL LCMGET(LPSAP,'NVALUE',NVALUE)
+              LPSAP=LCMGID(IPSAP,'paramvaleurs')
+              CALL LCMGET(LPSAP,RECNAM,VREAL)
+              MAPLET(IPAR,IDLTA1)=-1
+              MATYPE(IPAR,IDLTA1)=1
+              DO J=1,NVALUE(IPAR)
+                IF(ABS(VALRA(IPAR,1,IDLTA1)-VREAL(J)).LE.
+     1             REPS*ABS(VREAL(J)))THEN
+                  MAPLET(IPAR,IDLTA1)=J
+                  GOTO 120
+                ENDIF
+              ENDDO
+            ELSEIF(TEXT12.EQ.'SAMEASREF')THEN
+              MAPLET(IPAR,IDLTA1)=-1
+              MATYPE(IPAR,IDLTA1)=-1
+            ELSE
+              CALL XABORT('SCRRGR: REAL or "SAMEASREF" expected')
+            ENDIF
+            GOTO 120
+  140       CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          ELSE IF((LDELT1).AND.(TEXT12.EQ.'REF'))THEN
+  150       IPAR=-99
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+            IF(TEXT12.EQ.'ENDREF') GOTO 170
+            DO I=1,NPAR
+              IF(TEXT12.EQ.PARKEY(I))THEN
+                IPAR=I
+                GOTO 160
+              ENDIF
+            ENDDO
+            CALL XABORT('SCRRGR: PARAMETER '//TEXT12//' NOT FOUND(3).')
+  160       CONTINUE
+            CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+            IF(INDIC.EQ.2)THEN
+              VALR(IPAR,1)=FLOTT
+              VALR(IPAR,2)=FLOTT
+              WRITE(RECNAM,'(''pval'',I8)') IPAR
+              LPSAP=LCMGID(IPSAP,'paramdescrip')
+              CALL LCMGET(LPSAP,'NVALUE',NVALUE)
+              LPSAP=LCMGID(IPSAP,'paramvaleurs')
+              CALL LCMGET(LPSAP,RECNAM,VREAL)
+              MUPLET(IPAR)=-1
+              MUTYPE(IPAR)=1
+              DO J=1,NVALUE(IPAR)
+                IF(ABS(VALR(IPAR,1)-VREAL(J)).LE.REPS*ABS(VREAL(J)))THEN
+                  MUPLET(IPAR)=J
+                  GOTO 150
+                ENDIF
+              ENDDO
+            ELSEIF(TEXT12.EQ.'SAMEASREF')THEN
+              MUPLET(IPAR)=-1
+              MUTYPE(IPAR)=-1
+            ELSE
+              CALL XABORT('SCRRGR: REAL or "SAMEASREF" expected')
+            ENDIF
+            GOTO 150
+  170       CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+          ENDIF
+          GOTO 30
+        ELSEIF(PARFMT(IPAR).EQ.'ENTIER')THEN
+          IF(ITYPE.NE.1)CALL XABORT('SCRRGR: SET MANDATORY WITH INT'
+     1     //'EGER PARAMETERS.')
+          CALL REDGET(INDIC,VALI(IPAR),FLOTT,TEXT12,DFLOTT)
+          IF(INDIC.NE.1)CALL XABORT('SCRRGR: INTEGER DATA EXPECTED.')
+          CALL LCMGET(LPSAP,RECNAM,VINTE)
+          DO 175 J=1,NVALUE(IPAR)
+            IF(VALI(IPAR).EQ.VINTE(J))THEN
+              MUPLET(IPAR)=J
+              MUTYPE(IPAR)=ITYPE
+              GOTO 20
+            ENDIF
+  175      CONTINUE
+          WRITE(HSMG,'(26HSCRRGR: INTEGER PARAMETER ,A,9H WITH VAL,
+     1     2HUE,I5,30H NOT FOUND IN SAPHYB DATABASE.)') PARKEY(IPAR),
+     2     VALI(IPAR)
+           CALL XABORT(HSMG)
+        ELSEIF(PARFMT(IPAR).EQ.'CHAINE')THEN
+          IF(ITYPE.NE.1)CALL XABORT('SCRRGR: SET MANDATORY WITH STR'
+     1     //'ING PARAMETERS.')
+          CALL REDGET(INDIC,NITMA,FLOTT,VALH(IPAR),DFLOTT)
+          IF(INDIC.NE.3)CALL XABORT('SCRRGR: STRING DATA EXPECTED.')
+          CALL LCMGTC(LPSAP,RECNAM,12,NVALUE(IPAR),VCHAR)
+          DO 180 J=1,NVALUE(IPAR)
+            IF(VALH(IPAR).EQ.VCHAR(J))THEN
+              MUPLET(IPAR)=J
+              MUTYPE(IPAR)=ITYPE
+              GOTO 20
+            ENDIF
+  180     CONTINUE
+          WRITE(HSMG,'(25HSCRRGR: STRING PARAMETER ,A,10H WITH VALU,
+     1     1HE,A12,30H NOT FOUND IN SAPHYB DATABASE.)') PARKEY(IPAR),
+     2     VALH(IPAR)
+          CALL XABORT(HSMG)
+        ELSE
+          CALL XABORT('SCRRGR: INVALID FORMAT='//PARFMT(IPAR))
+        ENDIF
+      ELSEIF(TEXT12.EQ.'TIMAV-BURN')THEN
+        IF(IBM.EQ.0) CALL XABORT('SCRRGR: MIX NOT SET (3).')
+        IBTYP=1
+      ELSEIF(TEXT12.EQ.'INST-BURN')THEN
+        IF(IBM.EQ.0) CALL XABORT('SCRRGR: MIX NOT SET (4).')
+        IBTYP=2
+      ELSEIF(TEXT12.EQ.'AVG-EX-BURN')THEN
+        IF(IBM.EQ.0) CALL XABORT('SCRRGR: MIX NOT SET (5).')
+        IBTYP=3
+        CALL REDGET(INDIC,IVARTY,FLOTT,TEXT12,DFLOTT)
+        IF(INDIC.NE.1)CALL XABORT('SCRRGR: INTEGER DATA EXPECTED.')
+      ELSEIF(TEXT12.EQ.'ENDMIX')THEN
+*----
+*  RECOVER FUEL-MAP INFORMATION.
+*----
+        IF(IMPX.GT.0) THEN
+          DO IPAR=1,NPAR
+            IF(PARFMT(IPAR).EQ.'FLOTTANT')THEN
+              IF(LCUB2(IPAR)) THEN
+                WRITE(IOUT,'(26H SCRRGR: GLOBAL PARAMETER:,A12,5H ->CU,
+     1          18HBIC INTERPOLATION.)') PARKEY(IPAR)
+              ELSE
+                WRITE(IOUT,'(26H SCRRGR: GLOBAL PARAMETER:,A12,5H ->LI,
+     1          19HNEAR INTERPOLATION.)') PARKEY(IPAR)
+              ENDIF
+            ENDIF
+          ENDDO
+        ENDIF
+        FMIX(:NCH*NB)=0
+        CALL LCMGET(IPMAP,'FLMIX',FMIX)
+        CALL NCRMAP(IPMAP,NPARM,HPAR,NCH,NB,IBTYP,HNAVAL,IMPX,BRN0,BRN1,
+     1              WPAR,LPARM)
+        IF(IBTYP.EQ.3) THEN
+          IF(IVARTY.EQ.0) CALL XABORT('SCRRGR: IVARTY NOT SET.')
+          CALL LCMGET(IPMAP,'B-ZONE',ZONEC)
+          DO ICH=1,NCH
+            DO J=1,NB
+              IF(ZONEC(ICH).EQ.IVARTY) THEN
+                ZONEDP(ICH,J)=1
+              ELSE
+                ZONEDP(ICH,J)=0
+              ENDIF
+            ENDDO
+          ENDDO
+          CALL LCMLEN(IPMAP,'B-VALUE',ILONG,ITYP)
+          IF (ILONG.EQ.0) CALL XABORT('SCRRGR: NO SAVED VALUES FOR '
+     1    //'THIS TYPE OF VARIABLE IN L_MAP')
+          ALLOCATE(VARC(ILONG))
+          CALL LCMGET(IPMAP,'B-VALUE',VARC)
+          VARVAL=VARC(IVARTY)
+          DEALLOCATE(VARC)
+        ENDIF
+*----
+*  PERFORM INTERPOLATION OVER THE FUEL MAP.
+*----
+        DO 186 JPARM=1,NPARMP
+          IPAR=0
+          DO I=1,NPAR
+            IF(HPAR(JPARM).EQ.PARKEY(I))THEN
+              IPAR=I
+              IF(LSET(IPAR)) THEN
+                IF(IMPX.GT.0) WRITE(6,*) 'L_MAP values overwritten by '
+     1          // 'the SET option for parameter '//HPAR(JPARM)
+                IF(.NOT.LADD(IPAR)) LPARM(JPARM)=.FALSE.
+              ENDIF
+              GOTO 185
+            ENDIF
+          ENDDO
+          LPARM(JPARM)=.FALSE.
+          GO TO 186
+  185     IF(PARTYP(IPAR).EQ.'TEMP') THEN
+*           CONVERT FUEL MAP TEMPERATURES TO CELSIUS
+            DO I=1,NCH*NB
+              WPAR(I,JPARM)=WPAR(I,JPARM)-273.16
+            ENDDO
+          ENDIF
+  186   CONTINUE
+*----
+*  COMPUTE ALL THE MUPLETS FOR EACH BUNDLE
+*----
+        IMPY=MAX(0,IMPX-1)
+        NTOT=0
+        DO 285 JB=1,NB
+        DO 280 ICH=1,NCH
+        IB=(JB-1)*NCH+ICH
+        IF(FMIX(IB).EQ.0) GO TO 280
+        NTOT=NTOT+1
+        IF(FMIX(IB).EQ.IBM)THEN
+          IF(NTOT.GT.NMIX) CALL XABORT('SCRRGR: NMIX OVERFLOW.')
+          DO 260 JPARM=1,NPARMP
+          IF(.NOT.LPARM(JPARM))GOTO 260
+        DO I=1,NPAR
+          IF(HPAR(JPARM).EQ.PARKEY(I))THEN
+            IPAR=I
+            PARNAM=HPAR(JPARM)
+            GOTO 190
+          ENDIF
+        ENDDO
+        WRITE(HSMG,'(18HSCRRGR: PARAMETER ,A,14H NOT FOUND(4).)')
+     1  HPAR(JPARM)
+        CALL XABORT(HSMG)
+  190   CONTINUE
+        WRITE(RECNAM,'(''pval'',I8)') IPAR
+        LPSAP=LCMGID(IPSAP,'paramdescrip')
+        CALL LCMGET(LPSAP,'NVALUE',NVALUE)
+        IF(NVALUE(IPAR).GT.MAXVAL)CALL XABORT('SCRRGR: MAXVAL OVERFLOW')
+        LPSAP=LCMGID(IPSAP,'paramvaleurs')
+        CALL LCMLEN(LPSAP,RECNAM,LENGTH,ITYLCM)
+        IF(LENGTH.EQ.0)THEN
+          WRITE(HSMG,'(25HSCRRGR: GLOBAL PARAMETER ,A,12H NOT SET(3).)')
+     1    PARNAM
+          CALL XABORT(HSMG)
+        ENDIF
+        ITYPE=0
+        IF((JPARM.EQ.NPARMP).AND.(NPARMP.EQ.NPARM+1))THEN
+*         parameter JPARAM is burnup
+          IF(.NOT.LSET(IPAR))THEN
+            MUTYPE(IPAR)=1
+            MUPLET(IPAR)=-1
+            BURN0=0.0
+            BURN1=0.0
+            IF(IBTYP.EQ.1)THEN
+*             TIME-AVERAGE
+              BURN0=BRN0(IB)
+              BURN1=BRN1(IB)
+            ELSEIF(IBTYP.EQ.2)THEN
+*             INSTANTANEOUS
+              BURN0=BRN0(IB)
+              BURN1=BURN0
+            ELSEIF(IBTYP.EQ.3)THEN
+*             DIFFERENCIATION RELATIVE TO EXIT BURNUP
+              ITYPE=3
+              BURN0=BRN0(IB)
+              BURN1=BRN1(IB)
+            ENDIF
+            VALR(IPAR,1)=BURN0
+            VALR(IPAR,2)=BURN1
+            VALR1=VALR(IPAR,1)
+            VALR2=VALR(IPAR,2)
+            ITYPE=1
+          ENDIF
+        ELSE
+          IF(.NOT.LSET(IPAR))THEN
+            VALR(IPAR,1)=WPAR(IB,JPARM)
+            VALR(IPAR,2)=WPAR(IB,JPARM)
+            MUPLET(IPAR)=-1
+            MUTYPE(IPAR)=1
+            VALR1=VALR(IPAR,1)
+            VALR2=VALR(IPAR,2)
+            ITYPE=1
+          ENDIF
+          IF(LDMAP(IPAR,1).OR.LDMAP(IPAR,2))THEN
+            IF(LDMAP(IPAR,1)) VALR(IPAR,1)=WPAR(IB,JPARM)
+            IF(LDMAP(IPAR,2)) VALR(IPAR,2)=WPAR(IB,JPARM)
+            MUPLET(IPAR)=-1
+            MUTYPE(IPAR)=2
+            VALR1=VALR(IPAR,1)
+            VALR2=VALR(IPAR,2)
+            ITYPE=2
+          ELSE IF(LADD(IPAR))THEN
+            DO N=1,NDLTA(IPAR)
+              IDLTA1=IDLTA(IPAR,N)
+              IF(LAMAP(IPAR,1,IDLTA1)) THEN
+                VALRA(IPAR,1,IDLTA1)=WPAR(IB,JPARM)
+                MAPLET(IPAR,IDLTA1)=-1
+                MATYPE(IPAR,IDLTA1)=2
+              ENDIF
+              IF(LAMAP(IPAR,2,IDLTA1)) THEN
+                VALRA(IPAR,2,IDLTA1)=WPAR(IB,JPARM)
+                MAPLET(IPAR,IDLTA1)=-1
+                MATYPE(IPAR,IDLTA1)=2
+              ENDIF
+            ENDDO
+            VALR1=VALRA(IPAR,1,IDLTA(IPAR,1))
+            VALR2=VALRA(IPAR,2,IDLTA(IPAR,1))
+            ITYPE=2
+          ENDIF
+        ENDIF
+        LPSAP=LCMGID(IPSAP,'paramdescrip')
+        CALL LCMGET(LPSAP,'NVALUE',NVALUE)
+        IF(NVALUE(IPAR).GT.MAXVAL) CALL XABORT('SCRRGR: MAXVAL OVERF'
+     1  //'LOW.')
+        WRITE(RECNAM,'(''pval'',I8)') IPAR
+        LPSAP=LCMGID(IPSAP,'paramvaleurs')
+        CALL LCMLEN(LPSAP,RECNAM,LENGTH,ITYLCM)
+        IF(LENGTH.EQ.0)THEN
+          WRITE(HSMG,'(25HSCRRGR: GLOBAL PARAMETER ,A,12H NOT SET(1).)')
+     1    PARNAM
+          CALL XABORT(HSMG)
+        ENDIF
+        IF(LENGTH.GT.MAXVAL) CALL XABORT('SCRRGR: MAXVAL OVERFLOW.')
+        CALL LCMGET(LPSAP,RECNAM,VREAL)
+        IF(ITYPE.EQ.1)THEN
+          IF(VALR1.EQ.VALR2)THEN
+            DO J=1,NVALUE(IPAR)
+              IF(ABS(VALR1-VREAL(J)).LE.REPS*ABS(VREAL(J)))THEN
+                MUPLET(IPAR)=J
+                MUTYPE(IPAR)=ITYPE
+                GOTO 260
+              ENDIF
+            ENDDO
+          ENDIF
+        ENDIF
+*----
+*  ERRORS HANDLING
+*----
+        IF(VALR1.LT.VREAL(1))THEN
+*         OUTSIDE OF THE DOMAIN (1)
+          WRITE(HSMG,'(23HSCRRGR: REAL PARAMETER ,A,10H WITH VALU,
+     1    1HE,1P,E12.4,26H IS OUTSIDE THE DOMAIN(3).)') PARNAM,VALR1
+          WRITE(6,*)'Domain:',VREAL(1),' <-> ',VREAL(NVALUE(IPAR))
+          CALL XABORT(HSMG)
+        ELSEIF(VALR2.GT.VREAL(NVALUE(IPAR)))THEN
+*         OUTSIDE OF THE DOMAIN (2)
+          WRITE(HSMG,'(23HSCRRGR: REAL PARAMETER ,A,10H WITH VALU,
+     1    1HE,1P,E12.4,26H IS OUTSIDE THE DOMAIN(4).)') PARNAM,VALR2
+          WRITE(6,*)'Domain:',VREAL(1),' <-> ',VREAL(NVALUE(IPAR))
+          CALL XABORT(HSMG)
+        ELSEIF((ITYPE.EQ.1).AND.(VALR1.GT.VALR2))THEN
+*         VALR1 > VALR2
+          WRITE(HSMG,'(23HSCRRGR: REAL PARAMETER ,A,9H IS DEFIN,
+     1    7HED WITH,1P,E12.4,2H >,E12.4,4H.(2))') PARNAM,
+     2    VALR1,VALR2
+          CALL XABORT(HSMG)
+        ENDIF
+*----
+*  COMPUTE THE TERP FACTORS USING TABLE-OF-CONTENT INFORMATION.
+*----
+  260     CONTINUE
+          MIXC(NTOT)=IBMOLD
+          IF(IBMOLD.GT.NMIL)
+     1       CALL XABORT('SCRRGR: MIX OVERFLOW (SAPHYB).')
+          IF(IMPY.GT.2) WRITE(6,'(32H SCRRGR: COMPUTE TERP FACTORS IN,
+     1    12H NEW MIXTURE,I5,1H.)') NTOT
+          NISO(NTOT)=NISOMI
+          LISO(NTOT)=LISOMI
+          LDELTA(NTOT)=LDELT1
+          DO ISO=1,NISOMI
+            HISO(1,NTOT,ISO)=HISOMI(1,ISO)
+            HISO(2,NTOT,ISO)=HISOMI(2,ISO)
+            CONC(NTOT,ISO)=CONCMI(ISO)
+          ENDDO
+          DO JPAR=1,NPAR
+            MUPLT2(JPAR)=MUPLET(JPAR)
+          ENDDO
+          IF(IBTYP.EQ.3)THEN
+             IF(ZONEDP(ICH,JB).NE.0) THEN
+                CALL SCRTRP(IPSAP,LCUB2,IMPY,NVP,NPAR,NCAL,MUPLT2,
+     1                      MUTYPE,VALR(1,1),VARVAL,TERP(1,NTOT))
+             ELSE
+                TERP(:NCAL,NTOT)=0.0
+             ENDIF
+          ELSE
+             CALL SCRTRP(IPSAP,LCUB2,IMPY,NVP,NPAR,NCAL,MUPLT2,MUTYPE,
+     1                   VALR(1,1),VARVAL,TERP(1,NTOT))
+          ENDIF
+*         DELTA-ADD
+          DO 270 IPAR=1,NPAR
+            IF(LADD(IPAR))THEN
+              DO N=1,NDLTA(IPAR)
+                IDLTA1=IDLTA(IPAR,N)
+                DO JPAR=1,NPAR
+                  MUPLT2(JPAR)=MAPLET(JPAR,IDLTA1)
+                  MUTYP2(JPAR)=MATYPE(JPAR,IDLTA1)
+                ENDDO
+                DO JPAR=1,NPAR
+                  IF(MUTYP2(JPAR).LT.0)THEN
+                    MUPLT2(JPAR)=MUPLET(JPAR)
+                    MUTYP2(JPAR)=MUTYPE(JPAR)
+                    VALRA(JPAR,1,IDLTA1)=VALR(JPAR,1)
+                    VALRA(JPAR,2,IDLTA1)=VALR(JPAR,2)
+                  ENDIF
+                ENDDO
+                ALLOCATE(TERPA(NCAL))
+                CALL SCRTRP(IPSAP,LCUB2,IMPY,NVP,NPAR,NCAL,MUPLT2,
+     1          MUTYP2,VALRA(1,1,IDLTA1),VARVAL,TERPA(1))
+                DO 275 JCAL=1,NCAL
+                TERP(JCAL,NTOT)=TERP(JCAL,NTOT)+TERPA(JCAL)
+  275           CONTINUE
+                DEALLOCATE(TERPA)
+              ENDDO
+            ENDIF
+  270     CONTINUE
+        ENDIF
+  280   CONTINUE
+  285   CONTINUE
+        IF(NTOT.NE.NMIX) CALL XABORT('SCRRGR: ALGORITHM FAILURE.')
+        IBM=0
+      ELSEIF((TEXT12.EQ.'SAPHYB').OR.(TEXT12.EQ.'TABLE').OR.
+     1   (TEXT12.EQ.'CHAIN').OR.(TEXT12.EQ.';')) THEN
+*----
+*  CHECK TERP FACTORS AND RETURN
+*----
+        IF(TEXT12.EQ.';') ITER=0
+        IF(TEXT12.EQ.'SAPHYB') ITER=1
+        IF(TEXT12.EQ.'TABLE') ITER=2
+        IF(TEXT12.EQ.'CHAIN') ITER=3
+        DO 300 IBM=1,NMIX
+        IBMOLD=MIXC(IBM)
+        IF(IBMOLD.EQ.0) GO TO 300
+        IF(NISO(IBM).GT.MAXNIS) CALL XABORT('SCRRGR: MAXNIS OVERFLOW.')
+        IF(LDELTA(IBM)) THEN
+          SUM=0.0
+        ELSE
+          SUM=1.0
+        ENDIF
+        DO 290 ICAL=1,NCAL
+        SUM=SUM-TERP(ICAL,IBM)
+  290   CONTINUE
+        IF(ABS(SUM).GT.1.0E-4) THEN
+           WRITE(HSMG,'(43HSCRRGR: INVALID INTERPOLATION FACTORS IN MI,
+     1     5HXTURE,I4,1H.)') IBM
+           CALL XABORT(HSMG)
+        ENDIF
+  300   CONTINUE
+*----
+*  EXIT MAIN LOOP OF THE SUBROUTINE
+*----
+        GO TO 310
+      ELSE
+        CALL XABORT('SCRRGR: '//TEXT12//' IS AN INVALID KEYWORD.')
+      ENDIF
+      GOTO 20
+*----
+*  PRINT INTERPOLATION (TERP) FACTORS
+*----
+  310 IF(IMPX.GT.2) THEN
+        WRITE(IOUT,'(/30H SCRRGR: INTERPOLATION FACTORS)')
+        DO ICAL=1,NCAL
+          DO IBM=1,NMIX
+            IF(TERP(ICAL,IBM).NE.0.0) THEN
+              WRITE(IOUT,320) ICAL,(TERP(ICAL,JBM),JBM=1,NMIX)
+              EXIT
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(HPAR,LDELTA,WPAR,BRN1,BRN0,ZONEC,ZONEDP,FMIX,LPARM)
+      RETURN
+*
+  320 FORMAT(6H CALC=,I8,6H TERP=,1P,8E13.5/(20X,8E13.5))
+      END
diff --git a/Donjon/src/SCRSAP.f b/Donjon/src/SCRSAP.f
new file mode 100644
index 0000000..b51a4ab
--- /dev/null
+++ b/Donjon/src/SCRSAP.f
@@ -0,0 +1,534 @@
+*DECK SCRSAP
+      SUBROUTINE SCRSAP(IPMAC,IPMEM,IACCS,NMIL,NMIX,NGRP,IMPX,HEQUI,
+     1 HMASL,NCAL,NSURFD,ILUPS,MIXC,TERP,LPURE,B2)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Build the Macrolib by scanning the NCAL elementary calculations of
+* a Saphyb and weighting them with TERP factors.
+*
+*Copyright:
+* Copyright (C) 2012 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPMAC   address of the output Macrolib LCM object.
+* IPMEM   pointer to the memory-resident Saphyb.
+* IACCS   =0 macrolib is created; =1 ... is updated.
+* NMIL    number of material mixtures in the Saphyb.
+* NMIX    maximum number of material mixtures in the Macrolib.
+* NGRP    number of energy groups.
+* IMPX    print parameter (equal to zero for no print).
+* HEQUI   keyword of SPH-factor set to be recovered.
+* HMASL   keyword of MASL data set to be recovered.
+* NCAL    number of elementary calculations in the Saphyb.
+* NSURFD  number of discontinuity factors.
+* ILUPS   up-scattering removing flag (=1 to remove up-scattering from
+*         output cross-sections).
+* MIXC    mixture index in the Saphyb corresponding to each Microlib
+*         mixture. Equal to zero if a Microlib mixture is not updated.
+* TERP    interpolation factors.
+* LPURE   =.true. if the interpolation is a pure linear interpolation 
+*         with TERP factors.
+* B2      buckling
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAC,IPMEM
+      INTEGER IACCS,NMIL,NMIX,NGRP,IMPX,NCAL,NSURFD,ILUPS,MIXC(NMIX)
+      REAL TERP(NCAL,NMIX),B2
+      CHARACTER HEQUI*4,HMASL*4
+      LOGICAL LPURE
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAX1D=40
+      INTEGER, PARAMETER::MAX2D=20
+      INTEGER, PARAMETER::MAXED=30
+      INTEGER, PARAMETER::MAXNFI=1
+      INTEGER, PARAMETER::MAXNL=5
+      INTEGER, PARAMETER::NSTATE=40
+      INTEGER, PARAMETER::MAXRES=MAX1D-8
+      REAL FLOTVA, WEIGHT, FKEFF, B2R
+      INTEGER I, I1D, I2D, IBM, IBMOLD, ICAL, IDEL, IDF, IED, IGMAX,
+     & IGMIN, IGR, IKEFF, IL, ILONG, IMC, IOF, IPOSDE, ITRANC, ITYLCM,
+     & ITYPE, JGR, LENGTH, N1D, N2D, NDEL, NED, NEDTMP, NF, NFTMP, NL,
+     & NLTMP, NTYPE, NALBP
+      TYPE(C_PTR) JPMAC,KPMAC,IPTMP,JPTMP,KPTMP
+      INTEGER ISTATE(NSTATE),DIMSAP(50)
+      LOGICAL LMAKE1(MAX1D),LMAKE2(MAX2D),LWD
+      CHARACTER TEXT8*8,TEXT12*12,CM*2,HMAK1(MAX1D)*12,HMAK2(MAX2D)*12,
+     1 HVECT(MAXED)*8
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IJJ,NJJ,IPOS,IJJB,NJJB,IPOSB
+      REAL, ALLOCATABLE, DIMENSION(:) :: GAR4,GAR4B,WORK1,WORK2,XVOLM,
+     1 ENERG,VOSAP,WDLA,FMASL,FMASLB
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: SPH
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: GAR1,ADF2
+      REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: GAR2,GAR3
+      CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: HADF
+      REAL, POINTER, DIMENSION(:) :: FLOT
+      TYPE(C_PTR) FLOT_PTR
+*----
+*  DATA STATEMENTS
+*----
+      DATA HMAK1 / 'FLUX-INTG','NTOT0','OVERV','DIFF','FLUX-INTG-P1',
+     1 'NTOT1','H-FACTOR','TRANC',MAXRES*' '/
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(IJJ(NMIX),NJJ(NMIX),IPOS(NMIX),IJJB(NMIL),NJJB(NMIL),
+     1 IPOSB(NMIL))
+      ALLOCATE(GAR1(NMIX,NGRP,MAX1D),GAR2(NMIX,MAXNFI,NGRP,MAX2D),
+     1 GAR3(NMIX,NGRP,NGRP,MAXNL),GAR4(NMIX*NGRP),GAR4B(NMIL*NGRP),
+     2 ADF2(NMIX,NGRP,NSURFD),FMASL(NMIX),FMASLB(NMIX))
+      ALLOCATE(HADF(NSURFD))
+*----
+*  MACROLIB INITIALIZATION
+*----
+      CALL LCMGET(IPMEM,'DIMSAP',DIMSAP)
+      IF(DIMSAP(7).NE.NMIL) THEN
+        CALL XABORT('SCRSAP: INVALID NUMBER OF MIXTURES(1).')
+      ELSE IF(DIMSAP(19).NE.NCAL) THEN
+        CALL XABORT('SCRSAP: INVALID NUMBER OF CALCULATIONS(1).')
+      ELSE IF(DIMSAP(20).NE.NGRP) THEN
+        CALL XABORT('SCRSAP: INVALID NUMBER OF ENERGY GROUPS(1).')
+      ENDIF
+      LMAKE1(:MAX1D)=.FALSE.
+      LMAKE2(:MAX2D)=.FALSE.
+      GAR1(:NMIX,:NGRP,:MAX1D)=0.0
+      GAR2(:NMIX,:MAXNFI,:NGRP,:MAX2D)=0.0
+      GAR3(:NMIX,:NGRP,:NGRP,:MAXNL)=0.0
+      FMASL(:NMIX)=0.0
+      IF(NSURFD.GT.0) ADF2(:NMIX,:NGRP,:NSURFD)=0.0
+      ALLOCATE(XVOLM(NMIX),ENERG(NGRP+1))
+      XVOLM(:NMIX)=0.0
+      ENERG(:NGRP+1)=0.0
+      IBMOLD=0
+      N1D=0
+      N2D=0
+      NDEL=0
+      NL=0
+      NF=0
+      NED=0
+      ITRANC=0
+      IDF=0
+      N1D=0
+      N2D=0
+*----
+*  READ EXISTING MACROLIB INFORMATION
+*----
+      IF(IACCS.EQ.0) THEN
+        TEXT12='L_MACROLIB'
+        CALL LCMPTC(IPMAC,'SIGNATURE',12,TEXT12)
+      ELSE
+        CALL LCMGTC(IPMAC,'SIGNATURE',12,TEXT12)
+        IF(TEXT12.NE.'L_MACROLIB') THEN
+          CALL XABORT('SCRSAP: SIGNATURE OF INPUT MACROLIB IS '//TEXT12
+     1    //'. L_MACROLIB EXPECTED.')
+        ENDIF
+        CALL LCMGET(IPMAC,'STATE-VECTOR',ISTATE)
+        IF(ISTATE(1).NE.NGRP) THEN
+          CALL XABORT('SCRSAP: INVALID NUMBER OF ENERGY GROUPS(2).')
+        ELSE IF(ISTATE(2).NE.NMIX) THEN
+          CALL XABORT('SCRSAP: INVALID NUMBER OF MIXTURES(2).')
+        ENDIF
+        NL=ISTATE(3)
+        NF=ISTATE(4)
+        IF(NF.GT.MAXNFI) CALL XABORT('SCRSAP: MAXNFI OVERFLOW(1).')
+        NED=ISTATE(5)
+        ITRANC=ISTATE(6)
+        NDEL=ISTATE(7)
+        IDF=ISTATE(12)
+        IF(NED.GT.MAXED) CALL XABORT('SCRSAP: MAXED OVERFLOW(1).')
+        CALL LCMGTC(IPMAC,'ADDXSNAME-P0',8,NED,HVECT)
+        N1D=8+NED+NL
+        N2D=2*(NDEL+1)
+        IF(NL.GT.MAXNL) CALL XABORT('SCRSAP: MAXNL OVERFLOW(1).')
+        IF(N1D.GT.MAX1D) CALL XABORT('SCRSAP: MAX1D OVERFLOW(1).')
+        IF(N2D.GT.MAX2D) CALL XABORT('SCRSAP: MAX2D OVERFLOW(1).')
+        DO 20 IED=1,NED
+        HMAK1(8+IED)=HVECT(IED)
+   20   CONTINUE
+        DO 30 IL=1,NL
+        WRITE(CM,'(I2.2)') IL-1
+        HMAK1(8+NED+IL)='SIGS'//CM
+   30   CONTINUE
+        HMAK2(1)='NUSIGF'
+        HMAK2(2)='CHI'
+        DO 40 IDEL=1,NDEL
+        WRITE(TEXT8,'(6HNUSIGF,I2.2)') IDEL
+        HMAK2(2+2*(IDEL-1)+1)=TEXT8
+        WRITE(TEXT8,'(3HCHI,I2.2)') IDEL
+        HMAK2(2+2*(IDEL-1)+2)=TEXT8
+   40   CONTINUE
+        CALL LCMGET(IPMAC,'STATE-VECTOR',ISTATE)
+        CALL LCMGET(IPMAC,'VOLUME',XVOLM)
+        JPMAC=LCMGID(IPMAC,'GROUP')
+        DO 105 IGR=1,NGRP
+        KPMAC=LCMGIL(JPMAC,IGR)
+        DO 60 I1D=1,N1D
+        CALL LCMLEN(KPMAC,HMAK1(I1D),ILONG,ITYLCM)
+        IF(ILONG.NE.0) THEN
+          LMAKE1(I1D)=.TRUE.
+          CALL LCMGET(KPMAC,HMAK1(I1D),GAR1(1,IGR,I1D))
+          DO 55 IBM=1,NMIX
+          DO 50 IBMOLD=1,NMIL
+          IF(MIXC(IBM).EQ.IBMOLD) GAR1(IBM,IGR,I1D)=0.0
+   50     CONTINUE
+   55     CONTINUE
+        ENDIF
+   60   CONTINUE
+        DO 80 I2D=1,N2D
+        CALL LCMLEN(KPMAC,HMAK2(I2D),ILONG,ITYLCM)
+        IF(ILONG.NE.0) THEN
+          LMAKE2(I2D)=.TRUE.
+          CALL LCMGET(KPMAC,HMAK2(I2D),GAR2(1,1,IGR,I2D))
+          DO 72 I=1,NF
+          DO 71 IBM=1,NMIX
+          DO 70 IBMOLD=1,NMIL
+          IF(MIXC(IBM).EQ.IBMOLD) GAR2(IBM,I,IGR,I2D)=0.0
+   70     CONTINUE
+   71     CONTINUE
+   72     CONTINUE
+        ENDIF
+   80   CONTINUE
+        DO 100 IL=1,NL
+        WRITE(CM,'(I2.2)') IL-1
+        ILONG=1
+        IF(IL.GT.1) CALL LCMLEN(KPMAC,'SCAT'//CM,ILONG,ITYLCM)
+        IF(ILONG.NE.0) THEN
+          CALL LCMGET(KPMAC,'SCAT'//CM,GAR4)
+          CALL LCMGET(KPMAC,'NJJS'//CM,NJJ)
+          CALL LCMGET(KPMAC,'IJJS'//CM,IJJ)
+          CALL LCMGET(KPMAC,'IPOS'//CM,IPOS)
+          DO 95 IBM=1,NMIX
+          IPOSDE=IPOS(IBM)
+          DO 90 JGR=IJJ(IBM),IJJ(IBM)-NJJ(IBM)+1,-1
+          GAR3(IBM,JGR,IGR,IL)=GAR4(IPOSDE)
+          DO 85 IBMOLD=1,NMIL
+          IF(MIXC(IBM).EQ.IBMOLD) GAR3(IBM,JGR,IGR,IL)=0.0
+   85     CONTINUE
+          IPOSDE=IPOSDE+1
+   90     CONTINUE
+   95     CONTINUE
+        ENDIF
+  100   CONTINUE
+  105   CONTINUE
+        IF(IDF.EQ.2) THEN
+          CALL LCMSIX(IPMAC,'ADF',1)
+          CALL LCMGTC(IPMAC,'HADF',8,NSURFD,HADF)
+          DO ITYPE=1,NSURFD
+            CALL LCMGET(IPMAC,HADF(ITYPE),ADF2(1,1,ITYPE))
+          ENDDO
+          CALL LCMSIX(IPMAC,' ',2)
+        ENDIF
+      ENDIF
+*----
+*  OVERALL ELEMENTARY CALCULATION LOOP
+*----
+      DO 210 ICAL=1,NCAL
+      DO 110 IBM=1,NMIX ! mixtures in Macrolib
+      WEIGHT=TERP(ICAL,IBM)
+      IF(WEIGHT.NE.0.0) GO TO 120
+  110 CONTINUE
+      GO TO 210
+*----
+*  PRODUCE AN ELEMENTARY MACROLIB (IF IPTMP=0)
+*----
+  120 CALL LCMOP(IPTMP,'*ELEMENTARY*',0,1,0)
+      ALLOCATE(SPH(NMIL,NGRP))
+      B2R=B2
+      CALL SCRSPH(IPMEM,IPTMP,ICAL,IMPX,HEQUI,HMASL,NMIL,NGRP,ILUPS,
+     1 SPH,B2R)
+*----
+*  RECOVER MACROLIB PARAMETERS
+*----
+      CALL LCMGET(IPTMP,'STATE-VECTOR',ISTATE)
+      NLTMP=ISTATE(3)
+      NFTMP=ISTATE(4)
+      NEDTMP=ISTATE(5)
+      IF(NLTMP.GT.MAXNL) CALL XABORT('SCRMAC: MAXNL OVERFLOW(2).')
+      IF(NFTMP.GT.MAXNFI) CALL XABORT('SCRMAC: MAXNFI OVERFLOW(2).')
+      IF(NEDTMP.GT.MAXED) CALL XABORT('SCRMAC: MAXED OVERFLOW(2).')
+      IF(IACCS.EQ.0) THEN
+        IF(ISTATE(1).NE.NGRP) THEN
+          CALL XABORT('SCRSAP: INVALID NUMBER OF ENERGY GROUPS(3).')
+        ELSE IF(ISTATE(2).NE.NMIL) THEN
+          CALL XABORT('SCRSAP: INVALID NUMBER OF MIXTURES(3).')
+        ENDIF
+        NL=NLTMP
+        NF=NFTMP
+        NED=NEDTMP
+        ITRANC=ISTATE(6)
+        NDEL=ISTATE(7)
+        IDF=ISTATE(12)
+        CALL LCMGTC(IPTMP,'ADDXSNAME-P0',8,NED,HVECT)
+        N1D=8+NED+NL
+        N2D=2*(NDEL+1)
+        IF(N1D.GT.MAX1D) CALL XABORT('SCRSAP: MAX1D OVERFLOW(2).')
+        IF(N2D.GT.MAX2D) CALL XABORT('SCRSAP: MAX2D OVERFLOW(2).')
+        DO 130 IED=1,NED
+        HMAK1(8+IED)=HVECT(IED)
+  130   CONTINUE
+        DO 140 IL=1,NL
+        WRITE(CM,'(I2.2)') IL-1
+        HMAK1(8+NED+IL)='SIGS'//CM
+  140   CONTINUE
+        HMAK2(1)='NUSIGF'
+        HMAK2(2)='CHI'
+        DO 150 IDEL=1,NDEL
+        WRITE(TEXT8,'(6HNUSIGF,I2.2)') IDEL
+        HMAK2(2+2*(IDEL-1)+1)=TEXT8
+        WRITE(TEXT8,'(3HCHI,I2.2)') IDEL
+        HMAK2(2+2*(IDEL-1)+2)=TEXT8
+  150   CONTINUE
+      ELSE
+        IF(NLTMP.GT.NL) CALL XABORT('SCRMAC: NL OVERFLOW.')
+        ITRANC=MAX(ITRANC,ISTATE(6))
+        IF(ISTATE(1).NE.NGRP) THEN
+          CALL XABORT('SCRSAP: INVALID NUMBER OF ENERGY GROUPS(3).')
+        ELSE IF(ISTATE(2).NE.NMIL)THEN
+          CALL XABORT('SCRSAP: INVALID NUMBER OF MIXTURES(3).')
+        ELSE IF(ISTATE(5).NE.NED) THEN
+          CALL XABORT('SCRSAP: INVALID NUMBER OF EDIT REACTIONS(3).')
+        ELSE IF((NFTMP.NE.0).AND.(NFTMP.NE.NF)) THEN
+          CALL XABORT('SCRSAP: INVALID NUMBER OF FISSILE ISOTOPES(3).')
+        ELSE IF(ISTATE(7).NE.NDEL) THEN
+          CALL XABORT('SCRSAP: INVALID NUMBER OF PRECURSOR GROUPS(3).')
+        ELSE IF(ISTATE(12).NE.IDF) THEN
+          CALL XABORT('SCRSAP: INVALID TYPE OF ADF DIRECTORY.')
+        ENDIF
+      ENDIF
+*----
+*  SPH CORRECTION OF MACROLIB INFORMATION
+*----
+      IMC=1 ! SPH correction for SPN macro-calculation
+      NALBP=0 ! no albedo correction
+      CALL SPHCMA(IPTMP,IMPX,IMC,NMIL,NGRP,NFTMP,NEDTMP,NALBP,SPH)
+      DEALLOCATE(SPH)
+*----
+*  RECOVER KEFF, VOLUMES, ENERGY GROUPS, EDIT NAMES, AND LAMBDA-D.
+*----
+      CALL LCMLEN(IPTMP,'K-EFFECTIVE',IKEFF,ITYLCM)
+      IF(IKEFF.EQ.1) CALL LCMGET(IPTMP,'K-EFFECTIVE',FKEFF)
+      CALL LCMLEN(IPTMP,'VOLUME',ILONG,ITYLCM)
+      IF(ILONG.EQ.NMIL) THEN
+        ALLOCATE(VOSAP(NMIL))
+        CALL LCMGET(IPTMP,'VOLUME',VOSAP)
+        DO 160 IBM=1,NMIX ! mixtures in Macrolib
+        IBMOLD=MIXC(IBM) ! mixture in Saphyb
+        IF(IBMOLD.NE.0) XVOLM(IBM)=VOSAP(IBMOLD)
+  160   CONTINUE
+        DEALLOCATE(VOSAP)
+      ENDIF
+      CALL LCMLEN(IPTMP,'ENERGY',ILONG,ITYLCM)
+      IF(ILONG.EQ.NGRP+1) CALL LCMGET(IPTMP,'ENERGY',ENERG)
+      CALL LCMLEN(IPTMP,'LAMBDA-D',LENGTH,ITYLCM)
+      LWD=(LENGTH.EQ.NDEL).AND.(NDEL.GT.0)
+      IF(LWD) THEN
+        ALLOCATE(WDLA(NDEL))
+        CALL LCMGET(IPTMP,'LAMBDA-D',WDLA)
+        CALL LCMPUT(IPMAC,'LAMBDA-D',NDEL,2,WDLA)
+        DEALLOCATE(WDLA)
+      ENDIF
+*----
+*  RECOVER MASL INFORMATION
+*----
+      IF(HMASL.NE.' ') CALL LCMGET(IPTMP,'MASL',FMASLB)
+*----
+*  PERFORM INTERPOLATION
+*----
+      JPTMP=LCMGID(IPTMP,'GROUP')
+      DO 200 IBM=1,NMIX ! mixtures in Macrolib
+      WEIGHT=TERP(ICAL,IBM)
+      IF(WEIGHT.EQ.0.0) GO TO 200
+      IBMOLD=MIXC(IBM) ! mixture in Saphyb
+      IF(IBMOLD.EQ.0) GO TO 200
+      IF(HMASL.NE.' ') FMASL(IBM)=FMASL(IBM)+WEIGHT*FMASLB(IBMOLD)
+*
+      DO 195 IGR=1,NGRP
+      KPTMP=LCMGIL(JPTMP,IGR)
+      DO 170 I1D=1,N1D
+      CALL LCMLEN(KPTMP,HMAK1(I1D),ILONG,ITYLCM)
+      IF(ILONG.NE.0) THEN
+        LMAKE1(I1D)=.TRUE.
+        CALL LCMGPD(KPTMP,HMAK1(I1D),FLOT_PTR)
+        CALL C_F_POINTER(FLOT_PTR,FLOT,(/ ILONG /))
+        FLOTVA=FLOT(IBMOLD)
+        IF((.NOT.LPURE).AND.(I1D.EQ.4)) FLOTVA=1.0/FLOTVA
+        GAR1(IBM,IGR,I1D)=GAR1(IBM,IGR,I1D)+WEIGHT*FLOTVA
+      ENDIF
+  170 CONTINUE
+      IF(ISTATE(4).GT.0) THEN
+        DO 175 I2D=1,N2D
+        CALL LCMLEN(KPTMP,HMAK2(I2D),ILONG,ITYLCM)
+        IF(ILONG.NE.0) THEN
+          LMAKE2(I2D)=.TRUE.
+          CALL LCMGPD(KPTMP,HMAK2(I2D),FLOT_PTR)
+          CALL C_F_POINTER(FLOT_PTR,FLOT,(/ ILONG /))
+          DO 174 I=1,NF
+          IOF=(IBMOLD-1)*NF+I
+          GAR2(IBM,I,IGR,I2D)=GAR2(IBM,I,IGR,I2D)+WEIGHT*FLOT(IOF)
+  174     CONTINUE
+        ENDIF
+  175   CONTINUE
+      ENDIF
+      DO 190 IL=1,NLTMP
+      WRITE(CM,'(I2.2)') IL-1
+      ILONG=1
+      IF(IL.GT.1) CALL LCMLEN(KPTMP,'SCAT'//CM,ILONG,ITYLCM)
+      IF(ILONG.NE.0) THEN
+        CALL LCMGET(KPTMP,'SCAT'//CM,GAR4B)
+        CALL LCMGET(KPTMP,'NJJS'//CM,NJJB)
+        CALL LCMGET(KPTMP,'IJJS'//CM,IJJB)
+        CALL LCMGET(KPTMP,'IPOS'//CM,IPOSB)
+        IPOSDE=IPOSB(IBMOLD)
+        DO 180 JGR=IJJB(IBMOLD),IJJB(IBMOLD)-NJJB(IBMOLD)+1,-1
+        GAR3(IBM,JGR,IGR,IL)=GAR3(IBM,JGR,IGR,IL)+WEIGHT*GAR4B(IPOSDE)
+        IPOSDE=IPOSDE+1
+  180   CONTINUE
+      ENDIF
+  190 CONTINUE
+  195 CONTINUE
+*----
+*  PROCESS ADF INFORMATION
+*----
+      IF(IDF.EQ.2) THEN
+        CALL LCMSIX(IPTMP,'ADF',1)
+        CALL LCMGET(IPTMP,'NTYPE',NTYPE)
+        IF(NTYPE.NE.NSURFD) CALL XABORT('SCRSAP: INVALID NTYPE VALUE.')
+        CALL LCMGTC(IPTMP,'HADF',8,NSURFD,HADF)
+        DO ITYPE=1,NSURFD
+          CALL LCMGET(IPTMP,HADF(ITYPE),GAR4)
+          DO IGR=1,NGRP
+            ADF2(IBM,IGR,ITYPE)=ADF2(IBM,IGR,ITYPE)+WEIGHT*GAR4(IGR)
+          ENDDO
+        ENDDO
+        CALL LCMSIX(IPTMP,' ',2)
+      ENDIF
+  200 CONTINUE
+      CALL LCMCL(IPTMP,2)
+  210 CONTINUE
+*----
+*  WRITE INTERPOLATED MACROLIB INFORMATION
+*----
+      IF(IKEFF.EQ.1) CALL LCMPUT(IPMAC,'K-EFFECTIVE',1,2,FKEFF)
+      CALL LCMPUT(IPMAC,'VOLUME',NMIX,2,XVOLM)
+      CALL LCMPUT(IPMAC,'ENERGY',NGRP+1,2,ENERG)
+      IF(HMASL.NE.' ') CALL LCMPUT(IPMAC,'MASL',NMIX,2,FMASL)
+      DEALLOCATE(ENERG,XVOLM)
+      IF(NED.GT.0) CALL LCMPTC(IPMAC,'ADDXSNAME-P0',8,NED,HVECT)
+      JPMAC=LCMLID(IPMAC,'GROUP',NGRP)
+      DO 365 IGR=1,NGRP
+      KPMAC=LCMDIL(JPMAC,IGR)
+      DO 320 I1D=1,N1D
+      IF(LMAKE1(I1D)) THEN
+        IF((.NOT.LPURE).AND.(I1D.EQ.4)) THEN
+          DO 311 IBM=1,NMIX
+          DO 310 IBMOLD=1,NMIL
+          IF(MIXC(IBM).EQ.IBMOLD) GAR1(IBM,IGR,I1D)=1./GAR1(IBM,IGR,I1D)
+  310     CONTINUE
+  311     CONTINUE
+        ELSE IF(I1D.EQ.7) THEN
+          DO 316 IBM=1,NMIX
+          DO 315 IBMOLD=1,NMIL
+          IF(MIXC(IBM).EQ.IBMOLD) GAR1(IBM,IGR,I1D)=GAR1(IBM,IGR,I1D)*
+     1    1.0E6 ! convert MeV to eV
+  315     CONTINUE
+  316     CONTINUE
+        ENDIF
+        CALL LCMPUT(KPMAC,HMAK1(I1D),NMIX,2,GAR1(1,IGR,I1D))
+      ENDIF
+  320 CONTINUE
+      DO 325 I2D=1,N2D
+      IF(LMAKE2(I2D).AND.(NF.GT.0)) THEN
+        CALL LCMPUT(KPMAC,HMAK2(I2D),NMIX*NF,2,GAR2(1,1,IGR,I2D))
+      ENDIF
+  325 CONTINUE
+      DO 360 IL=1,NL
+      WRITE(CM,'(I2.2)') IL-1
+      IPOSDE=0
+      DO 350 IBM=1,NMIX
+      IPOS(IBM)=IPOSDE+1
+      IGMIN=IGR
+      IGMAX=IGR
+      DO 330 JGR=1,NGRP
+      IF(GAR3(IBM,JGR,IGR,IL).NE.0.0) THEN
+        IGMIN=MIN(IGMIN,JGR)
+        IGMAX=MAX(IGMAX,JGR)
+      ENDIF
+  330 CONTINUE
+      IJJ(IBM)=IGMAX
+      NJJ(IBM)=IGMAX-IGMIN+1
+      DO 340 JGR=IGMAX,IGMIN,-1
+      IPOSDE=IPOSDE+1
+      GAR4(IPOSDE)=GAR3(IBM,JGR,IGR,IL)
+  340 CONTINUE
+  350 CONTINUE
+      IF(IPOSDE.GT.0) THEN
+        CALL LCMPUT(KPMAC,'SCAT'//CM,IPOSDE,2,GAR4)
+        CALL LCMPUT(KPMAC,'NJJS'//CM,NMIX,1,NJJ)
+        CALL LCMPUT(KPMAC,'IJJS'//CM,NMIX,1,IJJ)
+        CALL LCMPUT(KPMAC,'IPOS'//CM,NMIX,1,IPOS)
+        CALL LCMPUT(KPMAC,'SIGW'//CM,NMIX,2,GAR3(1,IGR,IGR,IL))
+      ENDIF
+  360 CONTINUE
+  365 CONTINUE
+      IF(IDF.EQ.2) THEN
+        CALL LCMSIX(IPMAC,'ADF',1)
+        CALL LCMPUT(IPMAC,'NTYPE',1,1,NSURFD)
+        CALL LCMPTC(IPMAC,'HADF',8,NSURFD,HADF)
+        DO ITYPE=1,NSURFD
+          CALL LCMPUT(IPMAC,HADF(ITYPE),NMIX*NGRP,2,ADF2(1,1,ITYPE))
+        ENDDO
+        CALL LCMSIX(IPMAC,' ',2)
+      ENDIF
+      IACCS=1
+*----
+*  UPDATE STATE-VECTOR
+*----
+      ISTATE(2)=NMIX
+      ISTATE(3)=NL
+      ISTATE(4)=NF
+      ISTATE(5)=NED
+      ISTATE(6)=ITRANC
+      CALL LCMPUT(IPMAC,'STATE-VECTOR',NSTATE,1,ISTATE)
+*----
+*  INCLUDE LEAKAGE IN THE MACROLIB (USED ONLY FOR NON-REGRESSION TESTS)
+*----
+      IF(B2.NE.0.0) THEN
+        IF(IMPX.GT.0) WRITE(IOUT,'(/31H SCRSAP: INCLUDE LEAKAGE IN THE,
+     1  14H MACROLIB (B2=,1P,E12.5,2H).)') B2
+        JPMAC=LCMGID(IPMAC,'GROUP')
+        ALLOCATE(WORK1(NMIX),WORK2(NMIX))
+        DO 520 IGR=1,NGRP
+          KPMAC=LCMGIL(JPMAC,IGR)
+          CALL LCMGET(KPMAC,'NTOT0',WORK1)
+          CALL LCMGET(KPMAC,'DIFF',WORK2)
+          DO 510 IBM=1,NMIX
+            IF(MIXC(IBM).NE.0) WORK1(IBM)=WORK1(IBM)+B2*WORK2(IBM)
+  510     CONTINUE
+          CALL LCMPUT(KPMAC,'NTOT0',NMIX,2,WORK1)
+  520   CONTINUE
+        DEALLOCATE(WORK2,WORK1)
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(HADF)
+      DEALLOCATE(FMASLB,FMASL,ADF2,GAR4B,GAR4,GAR3,GAR2,GAR1)
+      DEALLOCATE(IPOSB,NJJB,IJJB,IPOS,NJJ,IJJ)
+      RETURN
+      END
diff --git a/Donjon/src/SCRSPH.f b/Donjon/src/SCRSPH.f
new file mode 100644
index 0000000..e99385a
--- /dev/null
+++ b/Donjon/src/SCRSPH.f
@@ -0,0 +1,728 @@
+*DECK SCRSPH
+      SUBROUTINE SCRSPH(IPMEM,IPMAC,ICAL,IMPX,HEQUI,HMASL,NMIL,NGROUP,
+     > ILUPS,SPH,B2)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Extract a Macrolib corresponding to an elementary calculation in a
+* memory-resident Saphyb.
+*
+*Copyright:
+* Copyright (C) 2011 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPMEM   pointer to the memory-resident Saphyb object.
+* ICAL    index of the elementary calculation being considered.
+* IMPX    print parameter (equal to zero for no print).
+* HEQUI   keyword of SPH-factor set to be recovered.
+* HMASL   keyword of MASL data set to be recovered.
+* NMIL    number of mixtures in the elementary calculation.
+* NGROUP  number of energy groups in the elementary calculation.
+* ILUPS   up-scattering removing flag (=1 to remove up-scattering from
+*         output cross-sections).
+* B2      imposed buckling.
+*
+*Parameters: output
+* IPMAC   pointer to the Macrolib (L_MACROLIB signature).
+* SPH     SPH-factor set extracted from the Saphyb.
+* B2      buckling recovered from the Saphyb.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMEM,IPMAC
+      INTEGER ICAL,IMPX,NMIL,NGROUP,ILUPS
+      REAL SPH(NMIL,NGROUP),B2
+      CHARACTER HEQUI*4,HMASL*4
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXDIV=3
+      INTEGER, PARAMETER::MAXLOC=10
+      INTEGER, PARAMETER::MAXREA=25
+      INTEGER, PARAMETER::MAXMAC=2
+      INTEGER, PARAMETER::NSTATE=40
+      REAL DEN,FF,CSCAT
+      INTEGER I, J, IR, I0, IAD, IBM, IDF, IFISS, IGMAX, IGMIN, IGR, IL,
+     & ILENG, ILOC, ILONG, IMAC, INDX, IPOSDE, IPRC, IREA, IRES, IS2,
+     & ISO, ISOKEP, ITRANC, ITYLCM, JGR, NADRX, NCALS, NDATAP, NDATAX,
+     & NED,  NISO, NISOTS, NL, NW, NLOC, NMAC, NPARL, NPR, NPRC, NREA,
+     & NSURFD, NVDIV, IRENT0, IRENT1
+      INTEGER ISTATE(NSTATE),DIMSAP(50)
+      REAL VALDIV(MAXDIV)
+      LOGICAL LSTRD,LDIFF,LSPH,LMASL
+      CHARACTER TEXT12*12,HSMG*131,NOMREA(MAXREA)*12,CM*2,
+     1 IDVAL(MAXDIV)*4,LOCTYP(MAXLOC)*4,LOCKEY(MAXLOC)*4,TEXT8*8,
+     2 TEXT9*8
+      TYPE(C_PTR) JPMAC,KPMAC,JPMEM,KPMEM,LPMEM,MPMEM
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: LOCAD,ISADRX,LENGDX,LENGDP,
+     1 IDATA,IHEDI,TOTM,RESM,ISOTS,NOMISO,IPOS,NJJM,IJJM
+      INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: IADRX
+      REAL, ALLOCATABLE, DIMENSION(:) :: ENER,XVOLM,FLUXS,RDATA,STR,WRK,
+     1 SCAT,GAR,RVALO,CONCES,LAMB,SURF,FMASL
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: NWT0,XSB,SIGS0,SIGSB,SURFLX,
+     1 WORK,BETAR,INVELS
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: XS,SIGS,SS2DB,CHIRS
+      REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: SS2D
+      LOGICAL, ALLOCATABLE, DIMENSION(:) :: LXS
+      CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: HADF
+      CHARACTER(LEN=20), ALLOCATABLE, DIMENSION(:) :: NOMMIL
+*----
+*  SCRATCH STORAGE ALLOCATION
+*   SIGS0    P0 scattering cross sections.
+*----
+      ALLOCATE(IPOS(NMIL),NJJM(NMIL),IJJM(NMIL),NOMMIL(NMIL))
+      ALLOCATE(SIGS0(NMIL,NGROUP),FMASL(NMIL))
+      FMASL(:NMIL)=0.0
+*----
+*  RECOVER SAPHYB CHARACTERISTICS
+*----
+      CALL LCMLEN(IPMEM,'DIMSAP',ILENG,ITYLCM)
+      IF(ILENG.EQ.0) CALL XABORT('SCRSPH: INVALID SAPHYB.')
+      CALL LCMGET(IPMEM,'DIMSAP',DIMSAP)
+      IF(NMIL.NE.DIMSAP(7)) THEN
+         CALL XABORT('SCRSPH: INVALID VALUE OF NMIL.')
+      ELSE IF(NGROUP.NE.DIMSAP(20)) THEN
+         CALL XABORT('SCRSPH: INVALID VALUE OF NGROUP.')
+      ENDIF
+      NREA=DIMSAP(4)   ! number of reactions
+      NISO=DIMSAP(5)   ! number of particularized isotopes
+      NMAC=DIMSAP(6)   ! number of macroscopic sets
+      NPARL=DIMSAP(11) ! number of local variables
+      NADRX=DIMSAP(18) ! number of address sets
+      NCALS=DIMSAP(19) ! number of elementary calculations in the Saphyb
+      NPRC=DIMSAP(31)  ! number of delayed neutron precursor groups
+      NISOTS=DIMSAP(32) ! number of isotopes in edition tables
+      IF(IMPX.GT.1) THEN
+        WRITE(IOUT,'(30H SCRSPH: number of reactions =,I3)') NREA
+        WRITE(IOUT,'(44H SCRSPH: number of particularized isotopes =,
+     1  I4)') NISO
+        WRITE(IOUT,'(37H SCRSPH: number of macroscopic sets =,I2)') NMAC
+        WRITE(IOUT,'(29H SCRSPH: number of mixtures =,I5)') NMIL
+        WRITE(IOUT,'(36H SCRSPH: number of local variables =,I4)') NPARL
+        WRITE(IOUT,'(33H SCRSPH: number of address sets =,I4)') NADRX
+        WRITE(IOUT,'(33H SCRSPH: number of calculations =,I5)') NCALS
+        WRITE(IOUT,'(34H SCRSPH: number of energy groups =,I4)') NGROUP
+        WRITE(IOUT,'(37H SCRSPH: number of precursor groups =,I4)') NPRC
+        WRITE(IOUT,'(46H SCRSPH: number of isotopes in output tables =,
+     1  I4)') NISOTS
+      ENDIF
+      IF(NREA.GT.MAXREA) CALL XABORT('SCRSPH: MAXREA OVERFLOW')
+      IF(NMAC.GT.MAXMAC) CALL XABORT('SCRSPH: MAXMAC OVERFLOW')
+      INDX=NISO+NMAC
+      IF(INDX.EQ.0) CALL XABORT('SCRSPH: NO CROSS SECTIONS FOUND.')
+*----
+*  RECOVER INFORMATION FROM constphysiq DIRECTORY.
+*----
+      ALLOCATE(ENER(NGROUP+1))
+      CALL LCMSIX(IPMEM,'constphysiq',1)
+      CALL LCMGET(IPMEM,'ENRGS',ENER)
+      CALL LCMSIX(IPMEM,' ',2)
+      DO IGR=1,NGROUP+1
+        ENER(IGR)=ENER(IGR)/1.0E-6
+      ENDDO
+      CALL LCMPUT(IPMAC,'ENERGY',NGROUP+1,2,ENER)
+      DEALLOCATE(ENER)
+*----
+*  RECOVER INFORMATION FROM contenu DIRECTORY.
+*----
+      ALLOCATE(TOTM(NMIL),RESM(NMIL))
+      CALL LCMSIX(IPMEM,'contenu',1)
+      IF(NREA.GT.0) THEN
+        CALL LCMGTC(IPMEM,'NOMREA',12,NREA,NOMREA)
+        IF(IMPX.GT.1) THEN
+          WRITE(IOUT,'(29H SCRSPH: Available reactions:/(1X,10A13))')
+     1    (NOMREA(I),I=1,NREA)
+        ENDIF
+      ENDIF
+      CALL LCMGET(IPMEM,'TOTMAC',TOTM)
+      CALL LCMGET(IPMEM,'RESMAC',RESM)
+      IF(NISO.GT.0) THEN
+        ALLOCATE(NOMISO(NISO*2))
+        CALL LCMGET(IPMEM,'NOMISO',NOMISO)
+      ENDIF
+      CALL LCMSIX(IPMEM,' ',2)
+*----
+*  RECOVER INFORMATION FROM adresses DIRECTORY.
+*----
+      NL=0
+      IF(NADRX.GT.0) THEN
+         ALLOCATE(IADRX((NREA+2),(NISO+NMAC),NADRX))
+         CALL LCMSIX(IPMEM,'adresses',1)
+         CALL LCMGET(IPMEM,'ADRX',IADRX)
+         CALL LCMSIX(IPMEM,' ',2)
+         DO IAD=1,NADRX
+          DO ISO=1,NISO+NMAC
+            NL=MAX(NL,IADRX(NREA+1,ISO,IAD))
+            NL=MAX(NL,IADRX(NREA+2,ISO,IAD))
+          ENDDO
+         ENDDO
+      ENDIF
+      IF(IMPX.GT.1) THEN
+        WRITE(IOUT,'(36H SCRSPH: number of legendre orders =,I4)') NL
+      ENDIF
+*----
+*  RECOVER INFORMATION FROM geom DIRECTORY.
+*----
+      NSURFD=0
+      CALL LCMSIX(IPMEM,'geom',1)
+      ALLOCATE(XVOLM(NMIL))
+      CALL LCMGET(IPMEM,'XVOLMT',XVOLM)
+      CALL LCMGTC(IPMEM,'NOMMIL',20,NMIL,NOMMIL)
+      CALL LCMLEN(IPMEM,'outgeom',ILONG,ITYLCM)
+      IF(ILONG.NE.0) THEN
+        CALL LCMSIX(IPMEM,'outgeom',1)
+        CALL LCMLEN(IPMEM,'SURF',NSURFD,ITYLCM)
+        IF(IMPX.GT.1) THEN
+          WRITE(IOUT,'(42H SCRSPH: number of discontinuity factors =,
+     1    I4/)') NSURFD
+        ENDIF
+        CALL LCMSIX(IPMEM,' ',2)
+      ENDIF
+      ALLOCATE(SURFLX(NSURFD,NGROUP),SURF(NSURFD))
+      IF(NSURFD.GT.0) THEN
+        CALL LCMSIX(IPMEM,'outgeom',1)
+        CALL LCMGET(IPMEM,'SURF',SURF)
+        CALL LCMSIX(IPMEM,' ',2)
+      ENDIF
+      CALL LCMSIX(IPMEM,' ',2)
+*----
+*  RECOVER INFORMATION FROM caldir DIRECTORY.
+*----
+      JPMEM=LCMGID(IPMEM,'calc')
+      KPMEM=LCMGIL(JPMEM,ICAL)
+      CALL LCMSIX(KPMEM,'info',1)
+      LSPH=.FALSE.
+      LMASL=.FALSE.
+      IF(NPARL.GT.0) THEN
+        CALL LCMGET(KPMEM,'NLOC',NLOC)
+        IF(NLOC.GT.MAXLOC) CALL XABORT('SCRSPH: MAXLOC OVERFLOW')
+        CALL LCMGTC(KPMEM,'LOCTYP',4,NLOC,LOCTYP)
+        CALL LCMGTC(KPMEM,'LOCKEY',4,NLOC,LOCKEY)
+        ALLOCATE(LOCAD(NLOC+1))
+        CALL LCMGET(KPMEM,'LOCADR',LOCAD)
+        DO ILOC=1,NLOC
+          LSPH=LSPH.OR.((LOCTYP(ILOC).EQ.'EQUI').AND.
+     1                  (LOCKEY(ILOC).EQ.HEQUI))
+          LMASL=LMASL.OR.((LOCTYP(ILOC).EQ.'MASL').AND.
+     1                    (LOCKEY(ILOC).EQ.HMASL))
+        ENDDO
+      ENDIF
+      IF((HEQUI.NE.' ').AND.(.NOT.LSPH)) THEN
+        WRITE(HSMG,'(46HSCRSPH: UNABLE TO FIND A LOCAL PARAMETER SET O,
+     1  25HF TYPE EQUI WITH KEYWORD ,A4,1H.)') HEQUI
+        CALL XABORT(HSMG)
+      ELSE IF((HMASL.NE.' ').AND.(.NOT.LMASL)) THEN
+        WRITE(HSMG,'(46HSCRSPH: UNABLE TO FIND A LOCAL PARAMETER SET O,
+     1  25HF TYPE MASL WITH KEYWORD ,A4,1H.)') HMASL
+        CALL XABORT(HSMG)
+      ENDIF
+      ALLOCATE(ISADRX(NMIL),LENGDX(NMIL),LENGDP(NMIL))
+      CALL LCMGET(KPMEM,'ISADRX',ISADRX)
+      CALL LCMGET(KPMEM,'LENGDX',LENGDX)
+      CALL LCMGET(KPMEM,'LENGDP',LENGDP)
+      IF(NISOTS.GT.0) THEN
+        ALLOCATE(ISOTS(NISOTS*2))
+        CALL LCMGET(KPMEM,'ISOTS',ISOTS)
+      ENDIF
+      CALL LCMSIX(KPMEM,' ',2)
+      CALL LCMSIX(KPMEM,'divers',1)
+      CALL LCMLEN(KPMEM,'NVDIV',ILONG,ITYLCM)
+      IF(ILONG.EQ.0) THEN
+        NVDIV=0
+      ELSE
+        CALL LCMGET(KPMEM,'NVDIV',NVDIV)
+      ENDIF
+      LSTRD=(B2.EQ.0.0)
+      IF(NVDIV.GT.0) THEN
+        IF(NVDIV.GT.MAXDIV) CALL XABORT('SCRSPH: MAXDIV OVERFLOW.')
+        CALL LCMGTC(KPMEM,'IDVAL',4,NVDIV,IDVAL)
+        CALL LCMGET(KPMEM,'VALDIV',VALDIV)
+        DO I=1,NVDIV
+          IF(IMPX.GT.1) THEN
+            WRITE(IOUT,'(9H SCRSPH: ,I3,2X,A,1H=,1P,E13.5)') I,IDVAL(I),
+     1      VALDIV(I)
+          ENDIF
+          IF(IDVAL(I).EQ.'KEFF') THEN
+            CALL LCMPUT(IPMAC,'K-EFFECTIVE',1,2,VALDIV(I))
+          ELSE IF(IDVAL(I).EQ.'KINF') THEN
+            CALL LCMPUT(IPMAC,'K-INFINITY',1,2,VALDIV(I))
+          ELSE IF(IDVAL(I).EQ.'B2') THEN
+            B2=VALDIV(I)
+            LSTRD=(B2.EQ.0.0)
+            CALL LCMPUT(IPMAC,'B2  B1HOM',1,2,VALDIV(I))
+          ENDIF
+        ENDDO
+      ENDIF
+      CALL LCMSIX(KPMEM,' ',2)
+*----
+*  ALLOCATE MACROLIB WORKING ARRAYS.
+*----
+      ALLOCATE(LXS(NREA),NWT0(NMIL,NGROUP),SIGS(NMIL,NGROUP,NL),
+     1 SS2D(NMIL,NGROUP,NGROUP,NL),XS(NMIL,NGROUP,NREA))
+      NWT0(:NMIL,:NGROUP)=0.0
+      SIGS(:NMIL,:NGROUP,:NL)=0.0
+      SS2D(:NMIL,:NGROUP,:NGROUP,:NL)=0.0
+      XS(:NMIL,:NGROUP,:NREA)=0.0
+      LXS(:NREA)=.FALSE.
+*----
+*  ALLOCATE DELAYED NEUTRON WORKING ARRAYS.
+*----
+      ALLOCATE(LAMB(NPRC),CHIRS(NGROUP,NPRC,NMIL),BETAR(NPRC,NMIL),
+     1 INVELS(NGROUP,NMIL))
+      LAMB(:NPRC)=0.0
+      CHIRS(:NGROUP,:NPRC,:NMIL)=0.0
+      BETAR(:NPRC,:NMIL)=0.0
+      INVELS(:NGROUP,:NMIL)=0.0
+      CALL LCMSIX(KPMEM,'divers',1)
+      CALL LCMLEN(KPMEM,'NPR',ILONG,ITYLCM)
+      IF((NPRC.GT.0).AND.(ILONG.EQ.1)) THEN
+        CALL LCMGET(KPMEM,'NPR',NPR)
+        IF(NPR.NE.NPRC) CALL XABORT('SCRSPH: NPR INCONSISTENCY(1).')
+        CALL LCMGET(KPMEM,'LAMBRS',LAMB)
+        DO IBM=1,NMIL
+          CALL LCMGET(IPMEM,'CHIRS',CHIRS(1,1,IBM))
+          CALL LCMGET(IPMEM,'BETARS',BETAR(1,IBM))
+          CALL LCMGET(IPMEM,'INVELS',INVELS(1,IBM))
+        ENDDO
+      ENDIF
+      CALL LCMSIX(KPMEM,' ',2)
+*----
+*  LOOP OVER SAPHYB MIXTURES.
+*----
+      IF(NADRX.EQ.0) CALL XABORT('SCRSPH: NO ADDRESS SETS AVAILABLE.')
+      LPMEM=LCMGID(KPMEM,'mili')
+      DO IBM=1,NMIL
+        CALL LCMLEL(LPMEM,IBM,ILONG,ITYLCM)
+        IF(ILONG.EQ.0) CYCLE
+        MPMEM=LCMGIL(LPMEM,IBM)
+        IMAC=TOTM(IBM)
+        IRES=RESM(IBM)
+        IAD=ISADRX(IBM)
+        NDATAX=LENGDX(IBM)
+        NDATAP=LENGDP(IBM)
+        ALLOCATE(FLUXS(NGROUP),RDATA(NDATAX),IDATA(NDATAP))
+        CALL LCMGET(MPMEM,'FLUXS',FLUXS)
+        CALL LCMGET(MPMEM,'RDATAX',RDATA)
+        CALL LCMGET(MPMEM,'IDATAP',IDATA)
+        DO I=1,NGROUP
+          NWT0(IBM,I)=NWT0(IBM,I)+FLUXS(I)
+        ENDDO
+        ALLOCATE(SIGSB(NGROUP,NL),SS2DB(NGROUP,NGROUP,NL),
+     1  XSB(NGROUP,NREA))
+        IF(IMAC.NE.0) THEN
+          CALL SPHSXS(NREA,INDX,NADRX,NGROUP,NL,NDATAX,NDATAP,
+     1    NISO+IMAC,IAD,IADRX,RDATA,IDATA,NOMREA,SIGSB,SS2DB,XSB,
+     2    LXS)
+          DO IL=1,NL
+            DO I=1,NGROUP
+              SIGS(IBM,I,IL)=SIGS(IBM,I,IL)+SIGSB(I,IL)
+            ENDDO
+          ENDDO
+          DO IL=1,NL
+            DO J=1,NGROUP
+              DO I=1,NGROUP
+                SS2D(IBM,I,J,IL)=SS2D(IBM,I,J,IL)+SS2DB(I,J,IL)
+              ENDDO
+            ENDDO
+          ENDDO
+          DO IR=1,NREA
+            DO I=1,NGROUP
+              XS(IBM,I,IR)=XS(IBM,I,IR)+XSB(I,IR)
+            ENDDO
+          ENDDO
+        ELSE IF(NISO.NE.0) THEN
+          IF(NISOTS.EQ.0) CALL XABORT('SCRSPH: MISSING CONCES INFO.')
+          ALLOCATE(CONCES(NISOTS))
+          CALL LCMGET(MPMEM,'CONCES',CONCES)
+          DO ISO=1,NISO
+            WRITE(TEXT8,'(2A4)') (NOMISO(2*(ISO-1)+I0),I0=1,2)
+            ISOKEP=0
+            DO IS2=1,NISOTS
+              ISOKEP=IS2
+              WRITE(TEXT9,'(2A4)') (ISOTS(2*(IS2-1)+I0),I0=1,2)
+              IF(TEXT9.EQ.TEXT8) GO TO 10
+            ENDDO
+            CYCLE
+   10       DEN=CONCES(ISOKEP)
+            IF(DEN.NE.0.0) THEN
+              CALL SPHSXS(NREA,INDX,NADRX,NGROUP,NL,NDATAX,NDATAP,ISO,
+     1        IAD,IADRX,RDATA,IDATA,NOMREA,SIGSB,SS2DB,XSB,LXS)
+              DO IL=1,NL
+                DO I=1,NGROUP
+                  SIGS(IBM,I,IL)=SIGS(IBM,I,IL)+DEN*SIGSB(I,IL)
+                ENDDO
+              ENDDO
+              DO IL=1,NL
+                DO J=1,NGROUP
+                  DO I=1,NGROUP
+                    SS2D(IBM,I,J,IL)=SS2D(IBM,I,J,IL)+DEN*SS2DB(I,J,IL)
+                  ENDDO
+                ENDDO
+              ENDDO
+              DO IR=1,NREA
+                DO I=1,NGROUP
+                  XS(IBM,I,IR)=XS(IBM,I,IR)+DEN*XSB(I,IR)
+                ENDDO
+              ENDDO
+            ENDIF
+          ENDDO
+          DEALLOCATE(CONCES)
+          IF(IRES.NE.0) THEN
+            CALL SPHSXS(NREA,INDX,NADRX,NGROUP,NL,NDATAX,NDATAP,
+     1      NISO+IRES,IAD,IADRX,RDATA,IDATA,NOMREA,SIGSB,SS2DB,XSB,
+     2      LXS)
+            DO IL=1,NL
+              DO I=1,NGROUP
+                SIGS(IBM,I,IL)=SIGS(IBM,I,IL)+SIGSB(I,IL)
+              ENDDO
+            ENDDO
+            DO IL=1,NL
+              DO J=1,NGROUP
+                DO I=1,NGROUP
+                  SS2D(IBM,I,J,IL)=SS2D(IBM,I,J,IL)+SS2DB(I,J,IL)
+                ENDDO
+              ENDDO
+            ENDDO
+            DO IR=1,NREA
+              DO I=1,NGROUP
+                XS(IBM,I,IR)=XS(IBM,I,IR)+XSB(I,IR)
+              ENDDO
+            ENDDO
+          ENDIF
+        ELSE
+          CALL XABORT('SCRSPH: NO MACROSCOPIC SET.')
+        ENDIF
+        DEALLOCATE(XSB,SS2DB,SIGSB,IDATA,RDATA,FLUXS)
+*
+*       UP-SCATTERING CORRECTION OF THE MACROLIB.
+        IF(ILUPS.EQ.1) THEN
+          IRENT0=0
+          IRENT1=0
+          DO IREA=1,NREA
+            IF(NOMREA(IREA).EQ.'TOTALE') IRENT0=IREA
+            IF(NOMREA(IREA).EQ.'TOTALE P1') IRENT1=IREA
+          ENDDO
+          IF(IRENT0.EQ.0) CALL XABORT('SCRSPH: MISSING NTOT0.')
+          DO JGR=2,NGROUP
+            DO IGR=1,JGR-1 ! IGR < JGR
+              FF=NWT0(IBM,JGR)/NWT0(IBM,IGR)
+              CSCAT=SS2D(IBM,IGR,JGR,1) ! IGR < JGR
+              XS(IBM,IGR,IRENT0)=XS(IBM,IGR,IRENT0)-CSCAT*FF
+              XS(IBM,JGR,IRENT0)=XS(IBM,JGR,IRENT0)-CSCAT
+              IF((IRENT1.GT.0).AND.(NL.GT.1)) THEN
+                CSCAT=SS2D(IBM,IGR,JGR,2)
+                XS(IBM,IGR,IRENT1)=XS(IBM,IGR,IRENT1)-CSCAT*FF
+                XS(IBM,JGR,IRENT1)=XS(IBM,JGR,IRENT1)-CSCAT
+              ENDIF
+              DO IL=1,NL
+                CSCAT=SS2D(IBM,IGR,JGR,IL)
+                SIGS(IBM,IGR,IL)=SIGS(IBM,IGR,IL)-CSCAT*FF
+                SIGS(IBM,JGR,IL)=SIGS(IBM,JGR,IL)-CSCAT
+                SS2D(IBM,JGR,IGR,IL)=SS2D(IBM,JGR,IGR,IL)-CSCAT*FF
+                SS2D(IBM,IGR,JGR,IL)=0.0
+              ENDDO
+            ENDDO
+          ENDDO
+        ENDIF
+*
+        IF(LSPH) THEN
+          ALLOCATE(RVALO(LOCAD(NLOC+1)-1))
+          CALL LCMGET(MPMEM,'RVALOC',RVALO)
+          DO ILOC=1,NLOC
+            IF((LOCTYP(ILOC).EQ.'EQUI').AND.(LOCKEY(ILOC).EQ.HEQUI))
+     1      THEN
+              IF(LOCAD(ILOC+1)-LOCAD(ILOC).NE.NGROUP) THEN
+                CALL XABORT('SCRSPH: INVALID NUMBER OF COMPONENTS FOR '
+     1          //'SPH FACTORS')
+              ENDIF
+              DO IGR=1,NGROUP
+                SPH(IBM,IGR)=RVALO(LOCAD(ILOC)+IGR-1)
+              ENDDO
+            ENDIF
+          ENDDO
+          DEALLOCATE(RVALO)
+        ELSE
+          SPH(IBM,:NGROUP)=1.0
+        ENDIF
+        IF(LMASL) THEN
+          ALLOCATE(RVALO(LOCAD(NLOC+1)-1))
+          CALL LCMGET(MPMEM,'RVALOC',RVALO)
+          DO ILOC=1,NLOC
+            IF((LOCTYP(ILOC).EQ.'MASL').AND.(LOCKEY(ILOC).EQ.HMASL))
+     1      THEN
+              IF(LOCAD(ILOC+1)-LOCAD(ILOC).NE.1) THEN
+                CALL XABORT('SCRSPH: INVALID NUMBER OF COMPONENTS FOR '
+     1          //'MASL')
+              ENDIF
+              FMASL(IBM)=RVALO(LOCAD(ILOC))
+            ENDIF
+          ENDDO
+          DEALLOCATE(RVALO)
+        ENDIF
+*
+        CALL LCMLEN(MPMEM,'cinetique',ILONG,ITYLCM)
+        IF((NPRC.GT.0).AND.(ILONG.NE.0)) THEN
+          CALL LCMSIX(MPMEM,'cinetique',1)
+          CALL LCMGET(MPMEM,'NPR',NPR)
+          IF(NPR.NE.NPRC) CALL XABORT('SCRSPH: NPR INCONSISTENCY(2).')
+          CALL LCMGET(MPMEM,'LAMBRS',LAMB)
+          CALL LCMGET(MPMEM,'CHIRS',CHIRS(1,1,IBM))
+          CALL LCMGET(MPMEM,'BETARS',BETAR(1,IBM))
+          CALL LCMGET(MPMEM,'INVELS',INVELS(1,IBM))
+          CALL LCMSIX(MPMEM,' ',2)
+        ENDIF
+*       END OF LOOP OVER SAPHYB MIXTURES
+      ENDDO
+      IF(NPARL.GT.0) DEALLOCATE(LOCAD)
+*----
+*  RECOVER DISCONTINUITY FACTOR INFORMATION
+*----
+      IDF=0
+      IF(NSURFD.GT.0) THEN
+        IDF=2
+        CALL LCMSIX(KPMEM,'outflx',1)
+        CALL LCMGET(KPMEM,'SURFLX',SURFLX)
+        CALL LCMSIX(KPMEM,' ',2)
+        CALL LCMSIX(IPMAC,'ADF',1)
+        CALL LCMPUT(IPMAC,'NTYPE',1,1,NSURFD)
+        ALLOCATE(HADF(NSURFD),WORK(NMIL,NGROUP))
+        DO I=1,NSURFD
+          WRITE(HADF(I),'(3HFD_,I5.5)') I
+          DO IGR=1,NGROUP
+            WORK(:,IGR)=SURFLX(I,IGR)/SURF(I)
+          ENDDO
+          CALL LCMPUT(IPMAC,HADF(I),NMIL*NGROUP,2,WORK)
+        ENDDO
+        CALL LCMPTC(IPMAC,'HADF',8,NSURFD,HADF)
+        DEALLOCATE(WORK,HADF)
+        CALL LCMSIX(IPMAC,' ',2)
+      ENDIF
+      DEALLOCATE(SURFLX,SURF)
+*----
+*  IDENTIFY SPECIAL FLUX EDITS
+*----
+      ALLOCATE(IHEDI(2*NREA))
+      NED=0
+      DO IREA=1,NREA
+        IF(.NOT.LXS(IREA)) CYCLE
+        IF(NOMREA(IREA).EQ.'TOTALE') CYCLE
+        IF(NOMREA(IREA).EQ.'TOTALE P1') CYCLE
+        IF(NOMREA(IREA).EQ.'EXCESS') CYCLE
+        IF(NOMREA(IREA).EQ.'FISSION') CYCLE
+        IF(NOMREA(IREA).EQ.'SPECTRE') CYCLE
+        IF(NOMREA(IREA).EQ.'NU*FISSION') CYCLE
+        IF(NOMREA(IREA)(:7).EQ.'ENERGIE') CYCLE
+        IF(NOMREA(IREA).EQ.'SELF') CYCLE
+        IF(NOMREA(IREA).EQ.'TRANSP-CORR') CYCLE
+        IF(NOMREA(IREA).EQ.'FUITES') CYCLE
+        IF(NOMREA(IREA).EQ.'DIFFUSION') CYCLE
+        IF(NOMREA(IREA).EQ.'TRANSFERT') CYCLE
+        NED=NED+1
+        READ(NOMREA(IREA),'(2A4)') IHEDI(2*NED-1),IHEDI(2*NED)
+      ENDDO
+*----
+*  STORE MACROLIB.
+*----
+      CALL LCMPUT(IPMAC,'VOLUME',NMIL,2,XVOLM)
+      IF(LMASL) CALL LCMPUT(IPMAC,'MASL',NMIL,2,FMASL)
+      IF(NPRC.GT.0) CALL LCMPUT(IPMAC,'LAMBDA-D',NPRC,2,LAMB)
+      IFISS=0
+      ITRANC=0
+      LDIFF=.FALSE.
+      NW=0
+      ALLOCATE(STR(NMIL),WRK(NMIL))
+      SIGS0(:NMIL,:NGROUP)=0.0
+      JPMAC=LCMLID(IPMAC,'GROUP',NGROUP)
+      DO IGR=1,NGROUP
+        STR(:NMIL)=0.0
+        KPMAC=LCMDIL(JPMAC,IGR)
+        CALL LCMPUT(KPMAC,'FLUX-INTG',NMIL,2,NWT0(1,IGR))
+        IF(NPRC.GT.0) THEN
+          DO IBM=1,NMIL
+            WRK(IBM)=INVELS(IGR,IBM)
+          ENDDO
+          CALL LCMPUT(KPMAC,'OVERV',NMIL,2,WRK)
+        ENDIF
+        DO IREA=1,NREA
+          IF(.NOT.LXS(IREA)) CYCLE
+          IF(NOMREA(IREA).EQ.'TOTALE') THEN
+            IF(LSTRD) THEN
+              DO IBM=1,NMIL
+                STR(IBM)=STR(IBM)+XS(IBM,IGR,IREA)
+              ENDDO
+            ENDIF
+            CALL LCMPUT(KPMAC,'NTOT0',NMIL,2,XS(1,IGR,IREA))
+          ELSE IF(NOMREA(IREA).EQ.'TOTALE P1') THEN
+            NW=1
+            CALL LCMPUT(KPMAC,'NTOT1',NMIL,2,XS(1,IGR,IREA))
+          ELSE IF(NOMREA(IREA).EQ.'EXCESS') THEN
+*           correct scattering XS with excess XS
+            DO IBM=1,NMIL
+              SIGS0(IBM,IGR)=SIGS0(IBM,IGR)+XS(IBM,IGR,IREA)
+            ENDDO
+            CALL LCMPUT(KPMAC,'N2N',NMIL,2,XS(1,IGR,IREA))
+          ELSE IF(NOMREA(IREA).EQ.'FISSION') THEN
+            CALL LCMPUT(KPMAC,'NFTOT',NMIL,2,XS(1,IGR,IREA))
+          ELSE IF(NOMREA(IREA).EQ.'SPECTRE') THEN
+            CALL LCMPUT(KPMAC,'CHI',NMIL,2,XS(1,IGR,IREA))
+            DO IPRC=1,NPRC
+              DO IBM=1,NMIL
+                WRK(IBM)=CHIRS(IGR,IPRC,IBM)
+              ENDDO
+              WRITE(TEXT12,'(A3,I2.2)') 'CHI',IPRC
+              CALL LCMPUT(KPMAC,TEXT12,NMIL,2,WRK)
+            ENDDO
+          ELSE IF(NOMREA(IREA).EQ.'NU*FISSION') THEN
+            IFISS=1
+            CALL LCMPUT(KPMAC,'NUSIGF',NMIL,2,XS(1,IGR,IREA))
+            DO IPRC=1,NPRC
+              DO IBM=1,NMIL
+                WRK(IBM)=XS(IBM,IGR,IREA)*BETAR(IPRC,IBM)
+              ENDDO
+              WRITE(TEXT12,'(A6,I2.2)') 'NUSIGF',IPRC
+              CALL LCMPUT(KPMAC,TEXT12,NMIL,2,WRK)
+            ENDDO
+          ELSE IF(NOMREA(IREA).EQ.'ENERGIE') THEN
+            CALL LCMPUT(KPMAC,'H-FACTOR',NMIL,2,XS(1,IGR,IREA))
+          ELSE IF(NOMREA(IREA).EQ.'SELF') THEN
+            CALL LCMPUT(KPMAC,'SIGW00',NMIL,2,XS(1,IGR,IREA))
+          ELSE IF(NOMREA(IREA).EQ.'TRANSP-CORR') THEN
+            ITRANC=2
+            IF(LSTRD) THEN
+              DO IBM=1,NMIL
+                STR(IBM)=STR(IBM)-XS(IBM,IGR,IREA)
+              ENDDO
+            ENDIF
+            CALL LCMPUT(KPMAC,'TRANC',NMIL,2,XS(1,IGR,IREA))
+          ELSE IF(NOMREA(IREA).EQ.'FUITES') THEN
+            LDIFF=LSTRD
+            IF(.NOT.LSTRD) THEN
+              DO IBM=1,NMIL
+                LDIFF=LDIFF.OR.(XS(IBM,IGR,IREA).NE.0.0)
+                STR(IBM)=XS(IBM,IGR,IREA)/B2
+              ENDDO
+            ENDIF
+          ELSE IF(NOMREA(IREA).EQ.'DIFFUSION') THEN
+            DO IL=1,NL
+              WRITE(CM,'(I2.2)') IL-1
+              IF(IL.EQ.1) THEN
+                DO IBM=1,NMIL
+                  SIGS0(IBM,IGR)=SIGS0(IBM,IGR)+SIGS(IBM,IGR,IL)
+                ENDDO
+              ELSE
+                CALL LCMPUT(KPMAC,'SIGS'//CM,NMIL,2,SIGS(1,IGR,IL))
+              ENDIF
+            ENDDO
+          ELSE IF(NOMREA(IREA).EQ.'TRANSFERT') THEN
+            ALLOCATE(SCAT(NGROUP*NMIL),GAR(NMIL))
+            DO IL=1,NL
+              WRITE(CM,'(I2.2)') IL-1
+              IPOSDE=0
+              DO IBM=1,NMIL
+                IPOS(IBM)=IPOSDE+1
+                IGMIN=IGR
+                IGMAX=IGR
+                DO JGR=NGROUP,1,-1
+                  IF(SS2D(IBM,IGR,JGR,IL).NE.0.0) THEN
+                    IGMIN=MIN(IGMIN,JGR)
+                    IGMAX=MAX(IGMAX,JGR)
+                  ENDIF
+                ENDDO
+                IJJM(IBM)=IGMAX
+                NJJM(IBM)=IGMAX-IGMIN+1
+                DO JGR=IGMAX,IGMIN,-1
+                  IPOSDE=IPOSDE+1
+                  SCAT(IPOSDE)=SS2D(IBM,IGR,JGR,IL)
+                ENDDO
+                GAR(IBM)=SCAT(IPOS(IBM)+IJJM(IBM)-IGR)
+              ENDDO
+              CALL LCMPUT(KPMAC,'SCAT'//CM,IPOSDE,2,SCAT)
+              CALL LCMPUT(KPMAC,'NJJS'//CM,NMIL,1,NJJM)
+              CALL LCMPUT(KPMAC,'IJJS'//CM,NMIL,1,IJJM)
+              CALL LCMPUT(KPMAC,'IPOS'//CM,NMIL,1,IPOS)
+              CALL LCMPUT(KPMAC,'SIGW'//CM,NMIL,2,GAR)
+            ENDDO
+            DEALLOCATE(GAR,SCAT)
+          ELSE
+            CALL LCMPUT(KPMAC,NOMREA(IREA),NMIL,2,XS(1,IGR,IREA))
+          ENDIF
+        ENDDO
+        IF(LSTRD) THEN
+          IF((ITRANC.EQ.0).AND.(NL.GT.1)) THEN
+*           Apollo-type transport correction
+            DO IBM=1,NMIL
+              STR(IBM)=STR(IBM)-SIGS(IBM,IGR,2)
+            ENDDO
+          ENDIF
+          DO IBM=1,NMIL
+            STR(IBM)=1.0/(3.0*STR(IBM))
+          ENDDO
+          LDIFF=.TRUE.
+        ENDIF
+        IF((ITRANC.EQ.0).AND.(NL.GT.1)) THEN
+*         Apollo-type transport correction
+          IF(IGR.EQ.NGROUP) ITRANC=2
+          CALL LCMPUT(KPMAC,'TRANC',NMIL,2,SIGS(1,IGR,2))
+        ENDIF
+        IF(LDIFF) CALL LCMPUT(KPMAC,'DIFF',NMIL,2,STR)
+      ENDDO
+      DEALLOCATE(WRK,STR)
+*----
+*  RELEASE MEMORY
+*----
+      DEALLOCATE(INVELS,BETAR,CHIRS,LAMB,LXS,XS,SS2D,SIGS,NWT0,LENGDP,
+     1 LENGDX,ISADRX,XVOLM)
+      IF(NISOTS.GT.0) DEALLOCATE(ISOTS)
+      IF(NADRX.GT.0) DEALLOCATE(IADRX)
+      IF(NISO.GT.0) DEALLOCATE(NOMISO)
+      DEALLOCATE(RESM,TOTM)
+*----
+*  SAVE SCATTERING P0 INFO
+*----
+      DO IGR=1,NGROUP
+        KPMAC=LCMDIL(JPMAC,IGR)
+        CALL LCMPUT(KPMAC,'SIGS00',NMIL,2,SIGS0(1,IGR))
+      ENDDO
+*----
+*  WRITE STATE VECTOR
+*----
+      TEXT12='L_MACROLIB'
+      CALL LCMPTC(IPMAC,'SIGNATURE',12,TEXT12)
+      ISTATE(:NSTATE)=0
+      ISTATE(1)=NGROUP
+      ISTATE(2)=NMIL
+      ISTATE(3)=NL ! 1+scattering anisotropy
+      ISTATE(4)=IFISS
+      ISTATE(5)=NED
+      ISTATE(6)=ITRANC
+      ISTATE(7)=NPRC
+      IF(LDIFF) ISTATE(9)=1
+      ISTATE(10)=NW
+      ISTATE(12)=IDF
+      CALL LCMPUT(IPMAC,'STATE-VECTOR',NSTATE,1,ISTATE)
+      IF(NED.GT.0) CALL LCMPUT(IPMAC,'ADDXSNAME-P0',2*NED,3,IHEDI)
+      DEALLOCATE(IHEDI)
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(FMASL,SIGS0)
+      DEALLOCATE(NOMMIL,IJJM,NJJM,IPOS)
+      RETURN
+      END
diff --git a/Donjon/src/SCRSXS.f b/Donjon/src/SCRSXS.f
new file mode 100644
index 0000000..ec98050
--- /dev/null
+++ b/Donjon/src/SCRSXS.f
@@ -0,0 +1,114 @@
+*DECK SCRSXS
+      SUBROUTINE SCRSXS(NGRP,NL,NREA,IREAF,NOMREA,LXS,B2SAP,FACT0,
+     1 WEIGHT,SPH,FLUXS,XSB,SIGSB,SS2DB,LPURE,XS,SIGS,SS2D,TAUXFI)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Weight microscopic cross section data in an interpolated microlib.
+*
+*Copyright:
+* Copyright (C) 2017 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* NGRP    number of energy groups
+* NL      maximum Legendre order (NL=1 is for isotropic scattering)
+* NREA    number of reactions in the Saphyb object
+* IREAF   position of 'NU*FISSION' reaction in NOMREA array
+* NOMREA  names of reactions in the Saphyb object
+* LXS     existence flag of each reaction
+* B2SAP   buckling as recovered from the Saphyb object
+* FACT0   number density ratio for the isotope
+* WEIGHT  interpolation weight
+* SPH     SPH factors
+* FLUXS   averaged flux
+* XSB     cross sections per reaction for a unique calculation
+* SIGSB   scattering cross sections for a unique calculation
+* SS2DB   scattering matrix for a unique calculation
+* LPURE   =.true. if the interpolation is a pure linear interpolation 
+*         with TERP factors.
+*
+*Parameters: input/output
+* XS      interpolated cross sections per reaction
+* SIGS    interpolated scattering cross sections
+* SS2D    interpolated scattering matrix
+* TAUXFI  interpolated fission rate
+*
+*-----------------------------------------------------------------------
+*
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER NGRP,NL,NREA,IREAF
+      INTEGER I, IGR, IL, IREA, IRF, J, JGR
+      REAL TAUXF, XSECT
+      REAL B2SAP,FACT0,WEIGHT,SPH(NGRP),FLUXS(NGRP),XSB(NGRP*NREA),
+     1 SIGSB(NGRP*NL),SS2DB(NL*NGRP*NGRP),XS(NGRP*NREA),SIGS(NGRP*NL),
+     2 SS2D(NGRP*NGRP*NL),TAUXFI
+      CHARACTER NOMREA(NREA)*12
+      LOGICAL LXS(NREA),LPURE
+*----
+*  COMPUTE FISSION RATE FOR AN ELEMENTARY CALCULATION
+*----
+      TAUXF=0.0
+      IF(.NOT.LPURE.AND.(IREAF.GT.0)) THEN
+        DO IGR=1,NGRP
+          IRF=(IREAF-1)*NGRP+IGR
+          TAUXF=TAUXF+XSB(IRF)*FLUXS(IGR)
+        ENDDO
+        TAUXFI=TAUXFI+WEIGHT*FACT0*TAUXF
+      ENDIF
+*----
+*  MICROLIB INTERPOLATION
+*----
+      DO IGR=1,NGRP
+        DO IREA=1,NREA
+          IF(.NOT.LXS(IREA)) CYCLE
+          I=(IREA-1)*NGRP+IGR
+          IF(LPURE.AND.NOMREA(IREA).EQ.'SPECTRE') THEN
+            XS(I)=XS(I)+WEIGHT*XSB(I)
+          ELSE IF(NOMREA(IREA).EQ.'SPECTRE') THEN
+            XS(I)=XS(I)+WEIGHT*FACT0*TAUXF*XSB(I)
+          ELSE IF(NOMREA(IREA).EQ.'FUITES') THEN
+            IF(B2SAP.NE.0.0) THEN
+              XSECT=XSB(I)/B2SAP
+              XS(I)=XS(I)+SPH(IGR)*FACT0*WEIGHT*XSECT
+            ENDIF
+          ELSE IF(NOMREA(IREA).EQ.'TOTALE P1') THEN
+            XS(I)=XS(I)+FACT0*WEIGHT*XSB(I)/SPH(IGR)
+          ELSE
+            XS(I)=XS(I)+FACT0*SPH(IGR)*WEIGHT*XSB(I)
+          ENDIF
+        ENDDO
+        DO IL=1,NL
+          I=(IL-1)*NGRP+IGR
+          IF(MOD(IL,2).EQ.1) THEN
+            SIGS(I)=SIGS(I)+FACT0*SPH(IGR)*WEIGHT*SIGSB(I)
+          ELSE
+            DO JGR=1,NGRP
+              J=(IL-1)*NGRP*NGRP+(IGR-1)*NGRP+JGR
+              SIGS(I)=SIGS(I)+FACT0*WEIGHT*SS2DB(J)/SPH(JGR)
+            ENDDO
+          ENDIF
+        ENDDO
+        DO JGR=1,NGRP
+          DO IL=1,NL
+            I=(IL-1)*NGRP*NGRP+(JGR-1)*NGRP+IGR
+            IF(MOD(IL,2).EQ.1) THEN
+              SS2D(I)=SS2D(I)+FACT0*SPH(JGR)*WEIGHT*SS2DB(I)
+            ELSE
+              SS2D(I)=SS2D(I)+FACT0*WEIGHT*SS2DB(I)/SPH(IGR)
+            ENDIF
+          ENDDO
+        ENDDO
+      ENDDO
+      RETURN
+      END
diff --git a/Donjon/src/SCRTOC.f b/Donjon/src/SCRTOC.f
new file mode 100644
index 0000000..f1cca53
--- /dev/null
+++ b/Donjon/src/SCRTOC.f
@@ -0,0 +1,167 @@
+*DECK SCRTOC
+      SUBROUTINE SCRTOC(IPSAP)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Print the table of content of a Saphyb.
+*
+*Copyright:
+* Copyright (C) 2012 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPSAP   address of the multidimensional Saphyb object.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPSAP
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXLAM=20
+      INTEGER, PARAMETER::MAXPAR=50
+      INTEGER, PARAMETER::MAXVAL=200
+      INTEGER I, ILENG,ILONG, IPAR, ITYLCM, 
+     & NADRX, NCALS, NGROUP, NISO, NISOTS, NLAM, NMAC, NMIL, NPAR, 
+     & NPARL, NPRC, NREA, NSURFD
+      INTEGER DIMSAP(50),NVALUE(MAXPAR),VINTE(MAXVAL)
+      REAL VREAL(MAXVAL)
+      CHARACTER PARKEY(MAXPAR)*4,PARTYP(MAXPAR)*4,PARFMT(MAXPAR)*8,
+     1 VCHAR(MAXVAL)*12,RECNAM*12,NAMLAM(MAXLAM)*8
+      CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: TEXT8
+      CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: TEXT12
+*----
+*  DIMSAP INFORMATION
+*----
+      CALL LCMLEN(IPSAP,'DIMSAP',ILENG,ITYLCM)
+      IF(ILENG.EQ.0) CALL XABORT('SCRTOC: INVALID SAPHYB.')
+      CALL LCMGET(IPSAP,'DIMSAP',DIMSAP)
+      NLAM=DIMSAP(3)   ! number of radioactive decay reactions
+      NREA=DIMSAP(4)   ! number of neutron-induced reactions
+      NISO=DIMSAP(5)   ! number of particularized isotopes
+      NMAC=DIMSAP(6)   ! number of macroscopic sets
+      NMIL=DIMSAP(7)   ! number of mixtures
+      NPAR=DIMSAP(8)   ! number of global parameters
+      NPARL=DIMSAP(11) ! number of local variables
+      NADRX=DIMSAP(18) ! number of address sets
+      NCALS=DIMSAP(19) ! number of elementary calculations in the Saphyb
+      NGROUP=DIMSAP(20) ! number of energy groups
+      NPRC=DIMSAP(31)   ! number of delayed neutron precursor groups
+      NISOTS=DIMSAP(32) ! maximum number of isotopes in output tables
+      WRITE(IOUT,'(/38H SCRTOC: table of content information:)')
+      WRITE(IOUT,'(42H   number of radioactive decay reactions =,I3)')
+     1 NLAM
+      WRITE(IOUT,'(40H   number of neutron-induced reactions =,I3)')
+     1 NREA
+      WRITE(IOUT,'(38H   number of particularized isotopes =,I4)') NISO
+      WRITE(IOUT,'(31H   number of macroscopic sets =,I2)') NMAC
+      WRITE(IOUT,'(23H   number of mixtures =,I5)') NMIL
+      WRITE(IOUT,'(32H   number of global parameters =,I4)') NPAR
+      WRITE(IOUT,'(30H   number of local variables =,I4)') NPARL
+      WRITE(IOUT,'(27H   number of address sets =,I4)') NADRX
+      WRITE(IOUT,'(27H   number of calculations =,I7)') NCALS
+      WRITE(IOUT,'(28H   number of energy groups =,I4)') NGROUP
+      WRITE(IOUT,'(31H   number of precursor groups =,I4)') NPRC
+      WRITE(IOUT,'(48H   maximum number of isotopes in output tables =,
+     1 I4/)') NISOTS
+      IF(NLAM.GT.0) THEN
+        CALL LCMSIX(IPSAP,'constphysiq',1)
+          IF(NLAM.GT.MAXLAM) CALL XABORT('SCRTOC: MAXLAM OVERFLOW')
+          CALL LCMGTC(IPSAP,'NOMLAM',8,NLAM,NAMLAM)
+          WRITE(IOUT,'(40H   names of radioactive decay reactions:/
+     1    (5X,5A10))') (NAMLAM(I),I=1,NLAM)
+        CALL LCMSIX(IPSAP,' ',2)
+      ENDIF
+      CALL LCMSIX(IPSAP,'contenu',1)
+        IF(NREA.GT.0) THEN
+          ALLOCATE(TEXT12(NREA))
+          CALL LCMGTC(IPSAP,'NOMREA',12,NREA,TEXT12)
+          WRITE(IOUT,'(38H   names of neutron-induced reactions:/
+     1    (5X,A12,2X,A12,2X,A12,2X,A12,2X,A12))') (TEXT12(I),I=1,NREA)
+          DEALLOCATE(TEXT12)
+        ENDIF
+        IF(NISO.GT.0) THEN
+          ALLOCATE(TEXT8(NISO))
+          CALL LCMGTC(IPSAP,'NOMISO',8,NISO,TEXT8)
+          WRITE(IOUT,'(36H   names of particularized isotopes:/
+     1    (5X,A8,2X,A8,2X,A8,2X,A8,2X,A8))') (TEXT8(I),I=1,NISO)
+          DEALLOCATE(TEXT8)
+        ENDIF
+        IF(NMAC.GT.0) THEN
+          ALLOCATE(TEXT8(NMAC))
+          CALL LCMGTC(IPSAP,'NOMMAC',8,NMAC,TEXT8)
+          WRITE(IOUT,'(29H   names of macroscopic sets:/
+     1    (5X,A8,2X,A8,2X,A8,2X,A8,2X,A8))') (TEXT8(I),I=1,NMAC)
+          DEALLOCATE(TEXT8)
+        ENDIF
+      CALL LCMSIX(IPSAP,' ',2)
+      CALL LCMSIX(IPSAP,'geom',1)
+      CALL LCMLEN(IPSAP,'outgeom',ILONG,ITYLCM)
+      IF(ILONG.NE.0) THEN
+        CALL LCMSIX(IPSAP,'outgeom',1)
+        CALL LCMLEN(IPSAP,'SURF',NSURFD,ITYLCM)
+        WRITE(IOUT,'(36H   number of discontinuity factors =,I4/)')
+     1  NSURFD
+        CALL LCMSIX(IPSAP,' ',2)
+      ENDIF
+      CALL LCMSIX(IPSAP,' ',2)
+*----
+*  GLOBAL PARAMETERS INFORMATION
+*----
+      IF(NPAR.GT.MAXPAR) CALL XABORT('SCRTOC: MAXPAR OVERFLOW')
+      CALL LCMSIX(IPSAP,'paramdescrip',1)
+        CALL LCMGET(IPSAP,'NVALUE',NVALUE)
+        CALL LCMGTC(IPSAP,'PARKEY',4,NPAR,PARKEY)
+        CALL LCMGTC(IPSAP,'PARTYP',4,NPAR,PARTYP)
+        CALL LCMGTC(IPSAP,'PARFMT',8,NPAR,PARFMT)
+      CALL LCMSIX(IPSAP,' ',2)
+      CALL LCMSIX(IPSAP,'paramvaleurs',1)
+        DO IPAR=1,NPAR
+          WRITE(IOUT,'(25H SCRTOC: global parameter,A5,8H of type,A5,
+     1    1H:)') PARKEY(IPAR),PARTYP(IPAR)
+          IF(NVALUE(IPAR).GT.MAXVAL) CALL XABORT('SCRTOC: MAXVAL OVERF'
+     1    //'LOW')
+          WRITE(RECNAM,'(''pval'',I8)') IPAR
+          IF(PARFMT(IPAR).EQ.'ENTIER') THEN
+            CALL LCMGET(IPSAP,RECNAM,VINTE)
+            WRITE(IOUT,'(20H   TABULATED POINTS=,1P,6I12/(20X,6I12))')
+     1      (VINTE(I),I=1,NVALUE(IPAR))
+          ELSE IF(PARFMT(IPAR).EQ.'FLOTTANT') THEN
+            CALL LCMGET(IPSAP,RECNAM,VREAL)
+            WRITE(IOUT,'(20H   TABULATED POINTS=,1P,6E12.4/(20X,
+     1      6E12.4))') (VREAL(I),I=1,NVALUE(IPAR))
+          ELSE IF(PARFMT(IPAR).EQ.'CHAINE') THEN
+            CALL LCMGTC(IPSAP,RECNAM,12,NVALUE(IPAR),VCHAR)
+            WRITE(IOUT,'(20H   TABULATED POINTS=,2X,6A12/(22X,6A12))')
+     1      (VCHAR(I),I=1,NVALUE(IPAR))
+          ENDIF
+        ENDDO
+      CALL LCMSIX(IPSAP,' ',2)
+*----
+*  LOCAL VARIABLES INFORMATION
+*----
+      IF(NPARL.GT.0) THEN
+        IF(NPARL.GT.MAXPAR) CALL XABORT('SCRTOC: MAXPAR OVERFLOW')
+        CALL LCMSIX(IPSAP,'varlocdescri',1)
+          CALL LCMGTC(IPSAP,'PARKEY',4,NPARL,PARKEY)
+          CALL LCMGTC(IPSAP,'PARTYP',4,NPARL,PARTYP)
+          CALL LCMGTC(IPSAP,'PARFMT',8,NPARL,PARFMT)
+          DO IPAR=1,NPARL
+            WRITE(IOUT,'(23H SCRTOC: local variable,A5,8H of type,A5,
+     1      11H and format,A9,1H:)') PARKEY(IPAR),PARTYP(IPAR),
+     2      PARFMT(IPAR)
+          ENDDO
+        CALL LCMSIX(IPSAP,' ',2)
+      ENDIF
+      WRITE(IOUT,'(/)')
+      RETURN
+      END
diff --git a/Donjon/src/SCRTRP.f b/Donjon/src/SCRTRP.f
new file mode 100644
index 0000000..53ef90d
--- /dev/null
+++ b/Donjon/src/SCRTRP.f
@@ -0,0 +1,214 @@
+*DECK SCRTRP
+      SUBROUTINE SCRTRP(IPSAP,LCUB2,IMPX,NVP,NPAR,NCAL,MUPLET,MUTYPE,
+     1 VALR,VARVAL,TERP)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute the TERP interpolation/derivation/integration factors using
+* table-of-content information of the Saphyb.
+*
+*Copyright:
+* Copyright (C) 2012 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPSAP   address of the multidimensional Saphyb object.
+* LCUB2   interpolation type for each parameter (=.TRUE.: cubic Ceschino
+*         interpolation; =.FALSE: linear Lagrange interpolation).
+* IMPX    print parameter (equal to zero for no print).
+* NVP     number of nodes in the global parameter tree.
+* NPAR    number of global parameters.
+* NCAL    number of elementary calculations in the Saphyb.
+* MUPLET  tuple used to identify an elementary calculation.
+* MUTYPE  type of interpolation (=1: interpolation; =2: delta-sigma).
+* VALR    real values of the interpolated point.
+* VARVAL  exit burnup used if MUTYPE(IPAR(ID))=3.
+*
+*Parameters: output
+* TERP    interpolation factors.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER, PARAMETER::MAXPAR=50
+      TYPE(C_PTR) IPSAP
+      INTEGER IMPX,NVP,NPAR,NCAL,MUPLET(NPAR),MUTYPE(NPAR)
+      REAL VALR(2*MAXPAR,2),VARVAL,TERP(NCAL)
+      LOGICAL LCUB2(NPAR)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, PARAMETER::IOUT=6
+      INTEGER, PARAMETER::MAXDIM=10
+      INTEGER, PARAMETER::MAXVAL=200
+      INTEGER IPAR(MAXDIM),NVALUE(MAXPAR),NVAL(MAXDIM),IDDIV(MAXDIM)
+      REAL BURN0, BURN1, DENOM, TERTMP
+      INTEGER I, ICAL, ID, IDTMP, IDTOT, ILONG, ITYLCM, JD, 
+     & MAXNVP, NDELTA, NDIM, NID, NTOT, NCRCAL
+      REAL VREAL(MAXVAL),T1D(MAXVAL,MAXDIM),WORK(MAXVAL)
+      CHARACTER HSMG*131,RECNAM*12,PARKEY(MAXPAR)*4
+      LOGICAL LCUBIC,LSINGL
+      TYPE(C_PTR) LPSAP
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: JDEBAR,JARBVA
+      REAL, ALLOCATABLE, DIMENSION(:) :: TERPA
+*----
+*  RECOVER TREE INFORMATION
+*----
+      LPSAP=LCMGID(IPSAP,'paramarbre')
+      CALL LCMLEN(LPSAP,'ARBVAL',MAXNVP,ITYLCM)
+      IF(NVP.GT.MAXNVP) CALL XABORT('SCRTRP: NVP OVERFLOW.')
+      ALLOCATE(JDEBAR(MAXNVP+1),JARBVA(MAXNVP))
+      CALL LCMGET(LPSAP,'DEBARB',JDEBAR)
+      CALL LCMGET(LPSAP,'ARBVAL',JARBVA)
+      LPSAP=LCMGID(IPSAP,'paramdescrip')
+      CALL LCMGET(LPSAP,'NVALUE',NVALUE)
+      CALL LCMGTC(LPSAP,'PARKEY',4,NPAR,PARKEY)
+*----
+*  COMPUTE TERP FACTORS
+*----
+      TERP(:NCAL)=0.0
+      IPAR(:MAXDIM)=0
+      NDIM=0
+      NDELTA=0
+      DO 10 I=1,NPAR
+        IF(MUPLET(I).EQ.-1) THEN
+          NDIM=NDIM+1
+          IF(MUTYPE(I).NE.1) NDELTA=NDELTA+1
+          IF(NDIM.GT.MAXDIM) THEN
+            WRITE(HSMG,'(7HSCRTRP:,I4,29H-DIMENSIONAL INTERPOLATION NO,
+     1      14HT IMPLEMENTED.)') NDIM
+            CALL XABORT(HSMG)
+          ENDIF
+          IPAR(NDIM)=I
+        ENDIF
+   10 CONTINUE
+      IF(IMPX.GT.2) THEN
+        WRITE(IOUT,'(16H SCRTRP: MUPLET=,10I4/(16X,10I4))')
+     1  (MUPLET(I),I=1,NPAR)
+        WRITE(IOUT,'(8H SCRTRP:,I4,27H-DIMENSIONAL INTERPOLATION.)')
+     1  NDIM
+      ENDIF
+      IF(NDIM.EQ.0) THEN
+        ICAL=NCRCAL(1,MAXNVP,NPAR,JDEBAR,JARBVA,MUPLET)
+        IF(ICAL.GT.NCAL) CALL XABORT('SCRTRP: TERP OVERFLOW(1).')
+        IF(ICAL.EQ.0) GO TO 200
+        IF(ICAL.EQ.-1) GO TO 210
+        TERP(ICAL)=1.0
+      ELSE
+        NTOT=1
+        IDDIV(:MAXDIM)=1
+        DO 70 ID=1,NDIM
+        IF(IPAR(ID).LE.NPAR) THEN
+          WRITE(RECNAM,'(''pval'',I8)') IPAR(ID)
+          NID=NVALUE(IPAR(ID))
+        ELSE
+          CALL XABORT('SCRTRP: PARAMETER INDEX OVERFLOW.')
+        ENDIF
+        NTOT=NTOT*NID
+        DO 15 IDTMP=1,NDIM-ID
+        IDDIV(IDTMP)=IDDIV(IDTMP)*NID
+   15   CONTINUE
+        LPSAP=LCMGID(IPSAP,'paramvaleurs')
+        CALL LCMLEN(LPSAP,RECNAM,ILONG,ITYLCM)
+        IF(ILONG.GT.MAXVAL) CALL XABORT('SCRTRP: MAXVAL OVERFLOW.')
+        CALL LCMGET(LPSAP,RECNAM,VREAL)
+        BURN0=VALR(IPAR(ID),1)
+        BURN1=VALR(IPAR(ID),2)
+        LSINGL=(BURN0.EQ.BURN1)
+        LCUBIC=LCUB2(IPAR(ID))
+        IF((MUTYPE(IPAR(ID)).EQ.1).AND.LSINGL) THEN
+          CALL ALTERP(LCUBIC,NID,VREAL,BURN0,.FALSE.,T1D(1,ID))
+        ELSE IF(MUTYPE(IPAR(ID)).EQ.1) THEN
+          IF(BURN0.GE.BURN1) CALL XABORT('@SCRTRP: INVALID BURNUP'
+     1     //' LIMITS(1).')
+          CALL ALTERI(LCUBIC,NID,VREAL,BURN0,BURN1,T1D(1,ID))
+          DO 20 I=1,NID
+          T1D(I,ID)=T1D(I,ID)/(BURN1-BURN0)
+   20     CONTINUE
+        ELSE IF((MUTYPE(IPAR(ID)).EQ.2).AND.(.NOT.LSINGL)) THEN
+          CALL ALTERP(LCUBIC,NID,VREAL,BURN0,.FALSE.,WORK(1))
+          CALL ALTERP(LCUBIC,NID,VREAL,BURN1,.FALSE.,T1D(1,ID))
+          DO 30 I=1,NID
+          T1D(I,ID)=T1D(I,ID)-WORK(I)
+   30     CONTINUE
+        ELSE IF((MUTYPE(IPAR(ID)).EQ.2).AND.(LSINGL)) THEN
+          T1D(:NID,ID)=0.0
+        ELSE IF(MUTYPE(IPAR(ID)).EQ.3) THEN
+*          DERIVATIVE WITH RESPECT TO A SINGLE EXIT BURNUP. USE
+*          EQ.(3.3) OF RICHARD CHAMBON'S THESIS.
+          IF(BURN0.GE.BURN1) CALL XABORT('@SCRTRP: INVALID BURNUP'
+     1    //' LIMITS(2).')
+          IF(PARKEY(IPAR(ID)).NE.'BURN') THEN
+            CALL XABORT('@SCRTRP: BURN EXPECTED.')
+          ENDIF
+          ALLOCATE(TERPA(NID))
+          CALL ALTERI(LCUBIC,NID,VREAL,BURN0,BURN1,TERPA(1))
+          DO 40 I=1,NID
+          T1D(I,ID)=-TERPA(I)
+   40     CONTINUE
+          CALL ALTERP(LCUBIC,NID,VREAL,BURN0,.FALSE.,TERPA(1))
+          DO 50 I=1,NID
+          T1D(I,ID)=T1D(I,ID)-TERPA(I)*BURN0
+   50     CONTINUE
+          CALL ALTERP(LCUBIC,NID,VREAL,BURN1,.FALSE.,TERPA(1))
+          DENOM=VARVAL*(BURN1-BURN0)
+          DO 60 I=1,NID
+          T1D(I,ID)=(T1D(I,ID)+TERPA(I)*BURN1)/DENOM
+   60     CONTINUE
+          DEALLOCATE(TERPA)
+        ELSE
+          CALL XABORT('SCRTRP: INVALID OPTION.')
+        ENDIF
+        NVAL(ID)=NID
+   70   CONTINUE
+        LPSAP=LCMGID(IPSAP,'paramarbre')
+
+* Example: NDIM=3, NVALUE=(3,2,2)
+* IDTOT 1  2  3  4  5  6  7  8  9 10 11 12
+* ID(1) 1  2  3  1  2  3  1  2  3  1  2  3
+* ID(2) 1  1  1  2  2  2  1  1  1  2  2  2
+* ID(3) 1  1  1  1  1  1  2  2  2  2  2  2
+* (NTOT=12, IDDIV=(6,3,1))
+        DO 100 IDTOT=1,NTOT               ! Ex.: IDTOT       = 9
+          TERTMP=1.0
+          IDTMP=IDTOT
+          DO 80 JD=1,NDIM                 ! Ex.: JD          = 1,2,3
+            ID=(IDTMP-1)/IDDIV(JD)+1      ! Ex.: ID(NDIM...1)= 2,1,3
+            IDTMP=IDTMP-(ID-1)*IDDIV(JD)  ! Ex.: IDTMP       = 3,3,1
+            MUPLET(IPAR(NDIM-JD+1))=ID
+            TERTMP=TERTMP*T1D(ID,NDIM-JD+1)
+   80     CONTINUE
+          ICAL=NCRCAL(1,MAXNVP,NPAR,JDEBAR,JARBVA,MUPLET)
+          IF(ICAL.GT.NCAL) CALL XABORT('SCRTRP: TERP OVERFLOW(2).')
+          IF(ICAL.EQ.0) GO TO 200
+          IF(ICAL.EQ.-1) GO TO 210
+          TERP(ICAL)=TERP(ICAL)+TERTMP
+  100   CONTINUE
+      ENDIF
+      IF(IMPX.GT.3) THEN
+        WRITE(IOUT,'(25H SCRTRP: TERP PARAMETERS:/(1X,1P,10E12.4))')
+     1  (TERP(I),I=1,NCAL)
+      ENDIF
+      DEALLOCATE(JARBVA,JDEBAR)
+      RETURN
+*----
+*  MISSING ELEMENTARY CALCULATION EXCEPTION.
+*----
+  200 WRITE(IOUT,'(16H SCRTRP: MUPLET=,10I4/(16X,10I4))')
+     1 (MUPLET(I),I=1,NPAR)
+      CALL XABORT('SCRTRP: MISSING ELEMENTARY CALCULATION.')
+  210 WRITE(IOUT,'(16H SCRTRP: MUPLET=,10I4/(16X,10I4))')
+     1 (MUPLET(I),I=1,NPAR)
+      WRITE(IOUT,'(9X,7HNVALUE=,10I4/(16X,10I4))') (NVALUE(I),I=1,NPAR)
+      CALL XABORT('SCRTRP: DEGENERATE ELEMENTARY CALCULATION.')
+      END
diff --git a/Donjon/src/SIM.f b/Donjon/src/SIM.f
new file mode 100644
index 0000000..4bb5e4d
--- /dev/null
+++ b/Donjon/src/SIM.f
@@ -0,0 +1,817 @@
+*DECK SIM
+      SUBROUTINE SIM(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* PWR fuelling simulator according to the time-linear model.
+*
+*Copyright:
+* Copyright (C) 2013 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert, V. Salino
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The SIM: module specification is:
+* FMAP [ MLIB ] := SIM: FMAP [ MLIB ] [ POWER ] :: (descsim) ;
+* where
+*   FMAP : name of a \emph{fmap} object, that will be updated by the SIM: 
+*     module. The FMAP object must contain the instantaneous burnups for each 
+*     assembly subdivision, a basic naval-coordinate assembly layout and the 
+*     weight of each assembly subdivision.
+*   MLIB : name of a \emph{microlib} (type L\_LIBRARY) containing 
+*     particularized isotope data. If this object also appears on the RHS, it 
+*     is open in modification mode and updated. Number densities of isotopes 
+*     present in list HISOT. 
+*   POWER : name of a \emph{power} object containing the channel and powers of 
+*     the assembly subdivisions, previously computed by the FLPOW: module. The 
+*     channel and powers of the assembly subdivisions are used by the SIM: 
+*     module to compute the new burn-up of each assembly subdivision. If the 
+*     powersof the assembly subdivisions are previously specified with the 
+*     module RESINI:, you can burn your core without a POWER object.
+*   (descsim) : structure describing the input data to the SIM: module.
+* ------------------------------------------------------------------------------
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(NSTATE=40,IOUT=6,MAXIAS=30,MAXHHX=30)
+      TYPE(C_PTR) IPMAP,IPPOW,JPMAP,KPMAP,LPMAP,MPMAP,IPLIB
+      CHARACTER TEXT*12,HSIGN*12,TEXT4*4,HCYCL*12,HOLD*12,HHX(MAXHHX)*1,
+     > TEXT4B*4,TEXT1*1,TEXT1B*1,HSMG*131,PNAME*12,ASMB1(MAXIAS)*4,
+     > HC1*12,HC2*12
+      INTEGER IMPX,IHY(MAXHHX),ISTATE(NSTATE),SIMIND
+      DOUBLE PRECISION DFLOT
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IFMIX,NAME,ONAME,OFMIX,
+     > INFMIX,LL
+      CHARACTER(LEN=4), ALLOCATABLE, DIMENSION(:) :: HZONE
+      CHARACTER(LEN=4), ALLOCATABLE, DIMENSION(:,:) :: CYCLE,CYCLE2
+      CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: HFOLLO
+      CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: HCHCLV
+      REAL, ALLOCATABLE, DIMENSION(:) :: RFCHAN,BURNUP,OBURNU,FORM,
+     > BUNDPOW,BURNINST,PERTMP
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: RFOLLO,OFOLLO
+*----
+*  PARAMETER VALIDATION
+*----
+      IPMAP=C_NULL_PTR
+      IPPOW=C_NULL_PTR
+      IPLIB=C_NULL_PTR
+      MLIB=-1
+      DO IEN=1,NENTRY
+        IF(IENTRY(IEN).GT.2) THEN
+          WRITE(HSMG,'(12H@SIM: ENTRY ,A12,19H IS NOT OF LCM TYPE)')
+     >    HENTRY(IEN)
+          CALL XABORT(HSMG)
+        ENDIF
+        CALL LCMGTC(KENTRY(IEN),'SIGNATURE',12,HSIGN)
+        IF(HSIGN.EQ.'L_MAP') THEN
+          IPMAP=KENTRY(IEN)
+          IF(JENTRY(IEN).NE.1) CALL XABORT('@SIM: MODIFICATION MODE '
+     >    //'FOR L_MAP EXPECTED')
+        ELSEIF(HSIGN.EQ.'L_LIBRARY') THEN
+          IPLIB=KENTRY(IEN)
+          MLIB=JENTRY(IEN)
+          IF(MLIB.EQ.0) CALL XABORT('@SIM: READ-ONLY OR MODIFICATION '
+     >    //'MODE FOR L_LIBRARY EXPECTED')
+        ELSEIF(HSIGN.EQ.'L_POWER') THEN
+          IPPOW=KENTRY(IEN)
+          IF(JENTRY(IEN).NE.2) CALL XABORT('@SIM: READ-ONLY MODE FOR'
+     >    //' L_POWER EXPECTED')
+        ELSE
+          CALL XABORT('@SIM: UNKNOWN SIGNATURE ('//HSIGN//')')
+        ENDIF
+      ENDDO
+      IF(.NOT.C_ASSOCIATED(IPMAP)) THEN
+        CALL XABORT('@SIM: NO FUEL MAP OBJECT FOUND.')
+      ENDIF
+*----
+*  RECOVER INFORMATION
+*----
+      ISTATE(:NSTATE)=0
+      CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+      NB=ISTATE(1)
+      NCH=ISTATE(2)
+      NCOMB=ISTATE(3)
+      IMOD=ISTATE(5)
+      NF=ISTATE(7)
+      NPARM=ISTATE(8)
+      NSIMS=ISTATE(13)
+      NIS=ISTATE(18)
+      NCYCLE=ISTATE(19)
+      LX=NSIMS/100
+      LY=MOD(NSIMS,100)
+      IF(NF.EQ.0)CALL XABORT('@SIM: NO FUEL IN MAP OBJECT.')
+      IF(NIS.GT.0) THEN
+        ALLOCATE(HFOLLO(NIS))
+        CALL LCMGTC(IPMAP,'HFOLLOW',8,NIS,HFOLLO)
+      ENDIF
+      NTOT=NCH*NB
+*----
+*  ONLY TIME INSTANTANEOUS CALCULATIONS IN SIM:
+*----
+      IF(IMOD.NE.2)CALL XABORT('@SIM: INST-BURN OPTION SHOULD BE '
+     + //'USED IN RESINI.')
+*----
+*  READ INPUT DATA
+*----
+      IMPX=0
+      TTIME=0.0
+      ALLOCATE(RFCHAN(NCH))
+      RFCHAN(:NCH)=0.0
+      TIME=0.0
+      BURNSTEP=0.0
+      HCYCL=' '
+      JNDCY=0
+*     READ KEYWORD
+  10  CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(1).')
+      IF(TEXT.EQ.'EDIT')THEN
+*       PRINTING INDEX
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@SIM: INTEGER DATA EXPECTED(1).')
+        IMPX=MAX(0,NITMA)
+        IF(IMPX.GT.0) WRITE(6,190) NB,NCH,LX,LY
+      ELSEIF(TEXT.EQ.'CYCLE')THEN
+        CALL REDGET(ITYP,NITMA,FLOT,HCYCL,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(2).')
+        IF(NSIMS.EQ.0)CALL XABORT('@SIM: SIM DATA NOT DEFINED IN RESIN'
+     >  //'I: MODULE.')
+        ALLOCATE(HZONE(NCH),IFMIX(NTOT),NAME(3*NCH),ONAME(3*NCH),
+     >  OFMIX(NTOT))
+        ALLOCATE(FORM(NB),BURNUP(NTOT),OBURNU(NTOT),RFOLLO(NTOT,NIS),
+     >  OFOLLO(NTOT,NIS),LL(LY))
+        BURNUP(:NTOT)=-999.0
+        RFOLLO(:NTOT,:NIS)=0.0
+        OFOLLO(:NTOT,:NIS)=0.0
+        CALL LCMGTC(IPMAP,'S-ZONE',4,NCH,HZONE)
+        TEXT4=HZONE(1)
+        READ(TEXT4,'(A1,I2)') TEXT1,INTG2
+        L=0
+        LL(:LY)=0
+        DO K=1,NCH
+          TEXT4=HZONE(K)
+          READ(TEXT4,'(A1,I2)') TEXT1B,INTG2B
+          IF(TEXT1B.EQ.TEXT1) THEN
+            L=L+1
+            IF(L.GT.LY)CALL XABORT('@SIM: INCOHERENCE IN BASIC ASSEMB'
+     >      //'LY LAYOUT GIVEN IN RESINI: (1).')
+            IF(L.GT.MAXHHX)CALL XABORT('@SIM: MAXHHX OVERFLOW(1).')
+            IHY(L)=INTG2B
+          ENDIF
+        ENDDO
+        JMAX=0
+        DO K=1,NCH
+          TEXT4=HZONE(K)
+          READ(TEXT4,'(A1,I2)') TEXT1B,INTG2B
+          DO J=1,L
+            IF(INTG2B.EQ.IHY(J)) THEN
+              LL(J)=LL(J)+1
+              IF(LL(J).EQ.LX) JMAX=J
+              IF(LL(J).GT.LX)CALL XABORT('@SIM: INCOHERENCE IN BASIC '
+     >        //'ASSEMBLY LAYOUT GIVEN IN RESINI: (2).')
+            ENDIF
+          ENDDO
+        ENDDO
+        IF(JMAX.EQ.0)CALL XABORT('@SIM: INCOHERENCE IN BASIC ASSEMBLY'
+     >  //' LAYOUT GIVEN IN RESINI: (3).')
+        L=0
+        DO K=1,NCH
+          TEXT4=HZONE(K)
+          READ(TEXT4,'(A1,I2)') TEXT1B,INTG2B
+            IF(INTG2B.EQ.IHY(JMAX)) THEN
+              L=L+1
+              IF(L.GT.MAXHHX)CALL XABORT('@SIM: MAXHHX OVERFLOW(2).')
+              HHX(L)=TEXT1B
+            ENDIF
+        ENDDO
+        DEALLOCATE(LL)
+        HOLD=' '
+        INDCY=-1
+        BURNCY=-999.0
+  30    CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(3).')
+  40    IF(TEXT.EQ.'FROM') THEN
+          CALL REDGET(ITYP,NITMA,FLOT,HOLD,DFLOT)
+          IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(4).')
+          GO TO 30
+        ELSE IF(TEXT.EQ.'BURN') THEN
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+          IF(ITYP.EQ.1) THEN
+            INDCY=NITMA
+          ELSE IF(ITYP.EQ.2) THEN
+            BURNCY=FLOT
+          ELSE
+            CALL XABORT('@SIM: INTEGER OR REAL DATA EXPECTED.')
+          ENDIF
+          GO TO 30
+        ELSE IF((TEXT.EQ.'MAP').OR.(TEXT.EQ.'QMAP')) THEN
+          CALL LCMLEN(IPMAP,HCYCL,ILONG,ITYLCM)
+          IF(ILONG.NE.0) THEN
+            WRITE(HSMG,'(12H@SIM: CYCLE ,A12,8H EXISTS.)') HCYCL
+            CALL XABORT(HSMG)
+          ENDIF
+          ALLOCATE(HCHCLV(NCYCLE+1))
+          IF(NCYCLE.GT.0) CALL LCMGTC(IPMAP,'CYCLE-NAMES',12,NCYCLE,
+     >    HCHCLV)
+          HCHCLV(NCYCLE+1)=HCYCL
+          NCYCLE=NCYCLE+1
+          CALL LCMPTC(IPMAP,'CYCLE-NAMES',12,NCYCLE,HCHCLV)
+          DEALLOCATE(HCHCLV)
+          ALLOCATE(CYCLE(LX,LY))
+          IF(TEXT.EQ.'MAP') THEN
+            DO 45 I=1,LX
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+            IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED'
+     >      //'(5).')
+   45       CONTINUE
+            DO 51 J=1,LY
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+            IF(ITYP.NE.1)CALL XABORT('@SIM: INTEGER DATA EXPECTED(2).')
+            DO 50 I=1,LX
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT4,DFLOT)
+            IF(ITYP.EQ.1) THEN
+              IF(NITMA.LE.0) CALL XABORT('@SIM: FUEL INDEX .LE.0.')
+              IF(NITMA.GT.999) CALL XABORT('@SIM: FUEL INDEX .GT.999.')
+              WRITE(CYCLE(I,J),'(I3.3,1H@)') NITMA
+            ELSE IF(ITYP.EQ.3) THEN
+              CYCLE(I,J)=TEXT4
+            ELSE
+              CALL XABORT('@SIM: INTEGER/CHARACTER DATA EXPECTED(1).')
+            ENDIF
+            WRITE(TEXT4B,'(A1,I2.2)') HHX(I),IHY(J)
+   50       CONTINUE
+   51       CONTINUE
+          ELSE IF(TEXT.EQ.'QMAP') THEN
+            LXMIN=LX/2+1
+            LYMIN=LY/2+1
+            DO 55 I=LXMIN,LX
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+            IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED'
+     >      //'(7).')
+   55       CONTINUE
+            DO 61 J=LYMIN,LY
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+            IF(ITYP.NE.1)CALL XABORT('@SIM: INTEGER DATA EXPECTED(3).')
+            DO 60 I=LXMIN,LX
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT4,DFLOT)
+            IF(ITYP.EQ.1) THEN
+              IF(NITMA.LE.0) CALL XABORT('@SIM: FUEL INDEX .LE.0.')
+              IF(NITMA.GT.999) CALL XABORT('@SIM: FUEL INDEX .GT.999.')
+              WRITE(CYCLE(I,J),'(I3.3,1H@)') NITMA
+            ELSE IF(ITYP.EQ.3) THEN
+              CYCLE(I,J)=TEXT4
+            ELSE
+              CALL XABORT('@SIM: INTEGER/CHARACTER DATA EXPECTED(2).')
+            ENDIF
+            WRITE(TEXT4B,'(A1,I2.2)') HHX(I),IHY(J)
+   60       CONTINUE
+   61       CONTINUE
+            CALL SIMQMP(LX,LY,LXMIN,LYMIN,HHX,IHY,CYCLE)
+          ENDIF
+          IF(IMPX.GE.2) THEN
+            ALLOCATE(CYCLE2(LX,LY))
+            DO I=1,LX
+              DO J=1,LY
+                CYCLE2(I,J)=CYCLE(I,J)
+                IF(CYCLE2(I,J).EQ.'|')CYCLE2(I,J)=' |'
+                IF(CYCLE2(I,J).EQ.'-')CYCLE2(I,J)=' -'
+              ENDDO
+            ENDDO
+            WRITE (6,'(25H SIM: RELOADING PATTERN :)')
+            WRITE (6,'(2X,32A4)') (HHX(I),I=1,LX)
+            DO J=1,LY
+              WRITE (6,'(I3,1X,32(A3,1X))') IHY(J),(CYCLE2(I,J),I=1,LX)
+            ENDDO
+            DEALLOCATE(CYCLE2)
+          ENDIF
+          OBURNU(:NTOT)=-999.0
+          IF(HOLD.NE.' ') THEN
+            JNDCY=SIMIND(IPMAP,IMPX,HOLD,INDCY,BURNCY)
+            JPMAP=LCMGID(IPMAP,HOLD)
+            KPMAP=LCMGIL(JPMAP,JNDCY)
+            CALL LCMGET(KPMAP,'NAME',ONAME)
+            CALL LCMGET(KPMAP,'BURN-INST',OBURNU)
+            CALL LCMGET(KPMAP,'FLMIX',OFMIX)
+            IF((MLIB.EQ.1).AND.(NIS.GT.0)) THEN
+*             KPMAP(HOLD) --> IPLIB
+              CALL SIMLIB(IMPX,1,KPMAP,IPLIB,NTOT,NIS,OFMIX,HFOLLO,
+     >        OFOLLO)
+            ENDIF
+          ENDIF
+          ALLOCATE(INFMIX(NTOT))
+          CALL LCMGET(IPMAP,'FLMIX-INI',INFMIX)
+          IF(IMPX.GT.0) WRITE(6,210) HCYCL,'SIMPOS'
+          CALL SIMPOS(LX,LY,NCH,NB,HCYCL,HOLD,HHX,IHY,HZONE,INFMIX,
+     >    NIS,CYCLE,NAME,BURNUP,IFMIX,RFOLLO,ONAME,OBURNU,OFMIX,OFOLLO)
+          DEALLOCATE(INFMIX)
+          JNDCY=1
+          JPMAP=LCMLID(IPMAP,HCYCL,1)
+          KPMAP=LCMDIL(JPMAP,JNDCY)
+          CALL LCMPTC(KPMAP,'ALIAS',12,HCYCL)
+          CALL LCMPTC(KPMAP,'CYCLE',4,LX*LY,CYCLE)
+          CALL LCMPUT(KPMAP,'NAME',3*NCH,3,NAME)
+          CALL LCMPUT(KPMAP,'BURN-INST',NTOT,2,BURNUP)
+          CALL LCMPUT(KPMAP,'FLMIX',NTOT,1,IFMIX)
+          IF(NIS.GT.0) CALL LCMPUT(KPMAP,'FOLLOW',NTOT*NIS,2,RFOLLO)
+          IF((MLIB.EQ.1).AND.(NIS.GT.0)) THEN
+*           KPMAP(HCYCL) --> IPLIB
+            CALL SIMLIB(IMPX,1,KPMAP,IPLIB,NTOT,NIS,IFMIX,HFOLLO,RFOLLO)
+          ENDIF
+          DEALLOCATE(CYCLE)
+          GO TO 30
+        ELSE IF(TEXT.EQ.'SPEC') THEN
+          JNDCY=1
+          JPMAP=LCMGID(IPMAP,HCYCL)
+          KPMAP=LCMGIL(JPMAP,JNDCY)
+          CALL LCMGET(KPMAP,'NAME',NAME)
+          CALL LCMGET(KPMAP,'BURN-INST',BURNUP)
+          CALL LCMGET(KPMAP,'FLMIX',IFMIX)
+          IASMB1=0
+          INDCY=-1
+          BURNCY=-999.0
+   70     CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+          IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(9).')
+   80     IF(TEXT.EQ.'ENDCYCLE') THEN
+            GO TO 120
+          ELSE IF((TEXT.EQ.'DIST-AX').OR.(TEXT.EQ.'BURN-STEP')) THEN
+            JNDCY=1
+            JPMAP=LCMGID(IPMAP,HCYCL)
+            KPMAP=LCMGIL(JPMAP,JNDCY)
+            CALL LCMPUT(KPMAP,'NAME',3*NCH,3,NAME)
+            CALL LCMPUT(KPMAP,'BURN-INST',NTOT,2,BURNUP)
+            CALL LCMPUT(KPMAP,'FLMIX',NTOT,1,IFMIX)
+            GO TO 40
+          ELSE IF(TEXT.EQ.'SET') THEN
+            BURN=-999.0
+            IFUEL=0
+            IF(IASMB1.EQ.0) CALL XABORT('@SIM: ASMB1 NOT SET.')
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+            IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED'
+     >      //'(10).')
+            IF(TEXT.EQ.'AVGB') THEN
+              CALL REDGET(ITYP,NITMA,BURN,TEXT,DFLOT)
+              IF(ITYP.NE.2)CALL XABORT('@SIM: REAL DATA EXPECTED(3).')
+            ELSE IF(TEXT.EQ.'FUEL') THEN
+              CALL REDGET(ITYP,IFUEL,FLOT,TEXT,DFLOT)
+              IF(ITYP.NE.1)CALL XABORT('@SIM: INTEGER DATA EXPECTED(4)')
+            ELSE
+              CALL XABORT('@SIM: AVGB OR FUEL KEYWORD EXPECTED')
+            ENDIF
+            IF(IMPX.GT.0) WRITE(6,210) HCYCL,'SIMSET'
+            CALL SIMSET(NCH,NB,HCYCL,IASMB1,ASMB1,BURN,IFUEL,HZONE,
+     >      NAME,BURNUP,IFMIX)
+            IASMB1=0
+          ELSE IF(TEXT.EQ.'FROM') THEN
+            IF(IASMB1.EQ.0) CALL XABORT('@SIM: ASMB1 NOT SET.')
+            CALL REDGET(ITYP,NITMA,FLOT,HOLD,DFLOT)
+            IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED'
+     >      //'(11).')
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+            IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED'
+     >      //'(12).')
+            IF(TEXT.NE.'AT')CALL XABORT('@SIM: AT KEYWORD EXPECTED')
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT4B,DFLOT)
+            IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED'
+     >      //'(13).')
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+            IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED'
+     >      //'(14).')
+            IF(TEXT.EQ.'BURN') THEN
+              CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+              IF(ITYP.EQ.1) THEN
+                INDCY=NITMA
+              ELSE IF(ITYP.EQ.2) THEN
+                BURNCY=FLOT
+              ELSE
+                CALL XABORT('@SIM: INTEGER OR REAL DATA EXPECTED.')
+              ENDIF
+            ELSE
+              JNDCY=SIMIND(IPMAP,IMPX,HOLD,INDCY,BURNCY)
+              JPMAP=LCMGID(IPMAP,HOLD)
+              KPMAP=LCMGIL(JPMAP,JNDCY)
+              CALL LCMGET(KPMAP,'NAME',ONAME)
+              CALL LCMGET(KPMAP,'BURN-INST',OBURNU)
+              CALL LCMGET(KPMAP,'FLMIX',OFMIX)
+              IF((MLIB.EQ.1).AND.(NIS.GT.0)) THEN
+*               KPMAP(HOLD) --> IPLIB
+                CALL SIMLIB(IMPX,1,KPMAP,IPLIB,NTOT,NIS,OFMIX,HFOLLO,
+     >          OFOLLO)
+              ENDIF
+              IF(IMPX.GT.0) WRITE(6,210) HCYCL,'SIMCPY'
+              CALL SIMCPY(NCH,NB,HCYCL,IASMB1,ASMB1,TEXT4B,HZONE,NIS,
+     >        NAME,BURNUP,IFMIX,RFOLLO,ONAME,OBURNU,OFMIX,OFOLLO)
+              IASMB1=0
+              JNDCY=1
+              JPMAP=LCMGID(IPMAP,HCYCL)
+              KPMAP=LCMGIL(JPMAP,JNDCY)
+              IF(NIS.GT.0) CALL LCMPUT(KPMAP,'FOLLOW',NTOT*NIS,2,RFOLLO)
+              IF((MLIB.EQ.1).AND.(NIS.GT.0)) THEN
+*               KPMAP(HCYCL) --> IPLIB
+                CALL SIMLIB(IMPX,1,KPMAP,IPLIB,NTOT,NIS,IFMIX,HFOLLO,
+     >          RFOLLO)
+              ENDIF
+              GO TO 80
+            ENDIF
+          ELSE
+            IASMB1=IASMB1+1
+            IF(IASMB1.GT.MAXIAS) CALL XABORT('@SIM: MAXIAS OVERFLOW.')
+            ASMB1(IASMB1)=TEXT(:4)
+          ENDIF
+          GO TO 70
+        ELSE IF(TEXT.EQ.'DIST-AX') THEN
+          IF(HCYCL.EQ.' ') CALL XABORT('@SIM: HCNEW NOT DEFINED.')
+          JNDCY=1
+          JPMAP=LCMGID(IPMAP,HCYCL)
+          KPMAP=LCMGIL(JPMAP,JNDCY)
+          CALL LCMGET(KPMAP,'BURN-INST',BURNUP)
+          IASMB1=0
+          INDCY=-1
+          BURNCY=-999.0
+   90     CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+          IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(15).')
+  100     IF(TEXT.EQ.'ENDCYCLE') THEN
+            GO TO 120
+          ELSE IF((TEXT.EQ.'SPEC').OR.(TEXT.EQ.'BURN-STEP')) THEN
+            JNDCY=1
+            JPMAP=LCMGID(IPMAP,HCYCL)
+            KPMAP=LCMGIL(JPMAP,JNDCY)
+            CALL LCMPUT(KPMAP,'BURN-INST',NTOT,2,BURNUP)
+            GO TO 40
+          ELSE IF(TEXT.EQ.'SET') THEN
+            DO IB=1,NB
+              CALL REDGET(ITYP,NITMA,FORM(IB),TEXT,DFLOT)
+              IF(ITYP.NE.2) CALL XABORT('@SIM: REAL AXN EXPECTED.')
+            ENDDO
+            IF(IMPX.GT.0) WRITE(6,210) HCYCL,'SIMDIS'
+            CALL SIMDIS(.TRUE.,NCH,NB,HCYCL,IASMB1,ASMB1,FORM,TEXT4B,
+     >      HZONE,BURNUP,BURNUP)
+            IASMB1=0
+          ELSE IF(TEXT.EQ.'FROM') THEN
+            IF(IASMB1.EQ.0) CALL XABORT('@SIM: ASMB1 NOT SET.')
+            CALL REDGET(ITYP,NITMA,FLOT,HOLD,DFLOT)
+            IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED'
+     >      //'(16).')
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+            IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED'
+     >      //'(17).')
+            IF(TEXT.NE.'AT')CALL XABORT('@SIM: AT KEYWORD EXPECTED')
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT4B,DFLOT)
+            IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED'
+     >      //'(18).')
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+            IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED'
+     >      //'(19).')
+            IF(TEXT.EQ.'BURN') THEN
+              CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+              IF(ITYP.EQ.1) THEN
+                INDCY=NITMA
+              ELSE IF(ITYP.EQ.2) THEN
+                BURNCY=FLOT
+              ELSE
+                CALL XABORT('@SIM: INTEGER OR REAL DATA EXPECTED.')
+              ENDIF
+            ELSE
+              JNDCY=SIMIND(IPMAP,IMPX,HOLD,INDCY,BURNCY)
+              JPMAP=LCMGID(IPMAP,HOLD)
+              KPMAP=LCMGIL(JPMAP,JNDCY)
+              CALL LCMGET(KPMAP,'BURN-INST',OBURNU)
+              IF(IMPX.GT.0) WRITE(6,210) HCYCL,'SIMDIS'
+              CALL SIMDIS(.FALSE.,NCH,NB,HCYCL,IASMB1,ASMB1,FORM,TEXT4B,
+     >        HZONE,BURNUP,OBURNU)
+              JNDCY=1
+              JPMAP=LCMGID(IPMAP,HCYCL)
+              KPMAP=LCMGIL(JPMAP,JNDCY)
+              IASMB1=0
+              GO TO 100
+            ENDIF
+          ELSE
+            IASMB1=IASMB1+1
+            IF(IASMB1.GT.MAXIAS) CALL XABORT('@SIM: MAXIAS OVERFLOW.')
+            ASMB1(IASMB1)=TEXT(:4)
+          ENDIF
+          GO TO 90
+        ELSEIF(TEXT.EQ.'ENDCYCLE')THEN
+          GO TO 120
+        ELSEIF(TEXT.EQ.'TIME')THEN
+*         TIME VALUE
+          IF(TIME.NE.0.0)CALL XABORT('@SIM: TIME ALREADY SPECIFIED(1).')
+          IF(BURNSTEP.NE.0.0)CALL XABORT('@SIM: BURNSTEP ALREADY //
+     >    //SPECIFIED(1).')
+          CALL REDGET(ITYP,NITMA,TIME,TEXT,DFLOT)
+          IF(ITYP.NE.2)CALL XABORT('@SIM: REAL DATA EXPECTED(1).')
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+          IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(20).')
+          IF(TIME.LT.0.)CALL XABORT('@SIM: EXPECTING REAL>0 (1).')
+          IF(TEXT.EQ.'DAY')THEN
+            TIME=TIME
+          ELSEIF(TEXT.EQ.'HOUR')THEN
+            TIME=TIME/24.
+          ELSEIF(TEXT.EQ.'MINUTE')THEN
+            TIME=TIME/(24.*60.)
+          ELSEIF(TEXT.EQ.'SECOND')THEN
+            TIME=TIME/(24.*60.*60.)
+          ELSE
+            CALL XABORT('@SIM: EXPECTING DAY|HOUR|MINUTE|SECOND.')
+          ENDIF
+          GOTO 130
+        ELSEIF(TEXT.EQ.'BURN-STEP')THEN
+*         BURN-STEP
+          IF(TIME.NE.0.)CALL XABORT('@SIM: TIME ALREADY SPECIFIED(2).')
+          IF(BURNSTEP.NE.0.)CALL XABORT('@SIM: BURNSTEP ALREADY '
+     >    //'SPECIFIED(2).')
+          CALL REDGET(ITYP,NITMA,BURNSTEP,TEXT,DFLOT)
+          IF(ITYP.NE.2)CALL XABORT('@SIM: REAL DATA EXPECTED(2).')
+          IF(BURNSTEP.LE.0.)CALL XABORT('@SIM: EXPECTING REAL>0 (2).')
+          GO TO 130
+        ELSE IF(TEXT.EQ.'SET-FOLLOW') THEN
+*         Reset the number densities of particularized isotopes
+          IF(IMPX.GT.0) WRITE(6,210) HCYCL,'SET-FOLLOW'
+          IF(HCYCL.EQ.' ') CALL XABORT('@SIM: HCNEW NOT DEFINED.')
+          INDCY=-1
+          BURNCY=-999.0
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+          IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED'
+     >    //'(21).')
+          IF(TEXT.EQ.'BURN') THEN
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+            IF(ITYP.EQ.1) THEN
+              INDCY=NITMA
+            ELSE IF(ITYP.EQ.2) THEN
+              BURNCY=FLOT
+            ELSE
+              CALL XABORT('@SIM: INTEGER OR REAL DATA EXPECTED.')
+            ENDIF
+            CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+            IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED'
+     >      //'(22).')
+          ENDIF
+          JNDCY=SIMIND(IPMAP,IMPX,HCYCL,INDCY,BURNCY)
+          JPMAP=LCMGID(IPMAP,HCYCL)
+          KPMAP=LCMGIL(JPMAP,JNDCY)
+          CALL LCMGET(KPMAP,'NAME',NAME)
+          CALL LCMGET(KPMAP,'BURN-INST',BURNUP)
+          CALL LCMGET(KPMAP,'FLMIX',IFMIX)
+          IF(C_ASSOCIATED(IPPOW)) THEN
+            ALLOCATE(BUNDPOW(NTOT))
+            CALL LCMGET(IPPOW,'POWER-BUND',BUNDPOW)
+            CALL LCMPUT(KPMAP,'POWER-BUND',NTOT,2,BUNDPOW)
+            DEALLOCATE(BUNDPOW)
+          ENDIF
+          GO TO 40
+        ELSE
+          CALL XABORT('@SIM: WRONG KEYWORD: '//TEXT//' (1).')
+        ENDIF
+      ELSE IF(TEXT.EQ.'COMPARE') THEN
+*       Compare two fields of values
+        IF(HCYCL.NE.' ') CALL XABORT('@SIM: HCNEW STILL ACTIVE.')
+        INDCY1=-1
+        BURNCY1=-999.0
+        INDCY2=-1
+        BURNCY2=-999.0
+        IMODE=0
+        CALL REDGET(ITYP,NITMA,FLOT,HC1,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(23).')
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(24).')
+        IF(TEXT.EQ.'BURN') THEN
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+          IF(ITYP.EQ.1) THEN
+            INDCY1=NITMA
+          ELSE IF(ITYP.EQ.2) THEN
+            BURNCY1=FLOT
+          ELSE
+            CALL XABORT('@SIM: INTEGER OR REAL DATA EXPECTED.')
+          ENDIF
+          CALL REDGET(ITYP,NITMA,FLOT,HC2,DFLOT)
+          IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(25).')
+        ELSE
+          HC2=TEXT
+        ENDIF
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(26).')
+        IF(TEXT.EQ.'BURN') THEN
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+          IF(ITYP.EQ.1) THEN
+            INDCY2=NITMA
+          ELSE IF(ITYP.EQ.2) THEN
+            BURNCY2=FLOT
+          ELSE
+            CALL XABORT('@SIM: INTEGER OR REAL DATA EXPECTED.')
+          ENDIF
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+          IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(27).')
+        ENDIF
+        IF(TEXT.EQ.'DIST-BURN') THEN
+          IMODE=1
+        ELSE IF(TEXT.EQ.'DIST-POWR') THEN
+          IMODE=2
+        ELSE
+          CALL XABORT('@SIM: DIST-BURN OR DIST-POWR KEYWORD EXPECTED.')
+        ENDIF
+        CALL SIMCOM(IPMAP,IMPX,IMODE,NCH,NB,HC1,HC2,INDCY1,INDCY2,
+     >  BURNCY1,BURNCY2,ERROR)
+        CALL REDGET(ITYP,NITMA,ERROR,TEXT,DFLOT)
+        IF(ITYP.NE.-2) CALL XABORT('SIM: OUTPUT REAL EXPECTED')
+        ITYP=2
+        CALL REDPUT(ITYP,NITMA,ERROR,TEXT,DFLOT)
+      ELSE IF(TEXT.EQ.'SET-PARAM') THEN
+*       Reset a global parameter
+        IF(HCYCL.NE.' ') CALL XABORT('@SIM: HCNEW STILL ACTIVE.')
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(28).')
+        CALL REDGET(ITYP,NITMA,VALUE,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@SIM: REAL VALUE EXPECTED FOR'
+     >                         //' pvalue.')
+        JPMAP=LCMGID(IPMAP,'PARAM')
+        DO IPAR=1,NPARM
+          KPMAP=LCMGIL(JPMAP,IPAR)
+          CALL LCMGTC(KPMAP,'P-NAME',12,PNAME)
+          CALL LCMGET(KPMAP,'P-TYPE',ITYPE)
+          IF(PNAME.EQ.TEXT) THEN
+            IF(ITYPE.EQ.1) THEN
+              CALL LCMPUT(KPMAP,'P-VALUE',1,2,VALUE)
+              IF(IMPX.GT.0) WRITE(6,200) PNAME,VALUE
+            ELSE 
+              ALLOCATE(PERTMP(NTOT))
+              PERTMP(:NTOT)=VALUE
+              CALL LCMPUT(KPMAP,'P-VALUE',NTOT,2,PERTMP)     
+              IF(IMPX.GT.0) WRITE(6,201) PNAME,VALUE
+              DEALLOCATE(PERTMP)
+            ENDIF
+            GO TO 10
+          ENDIF
+        ENDDO
+        CALL XABORT('@SIM: GLOBAL OR LOCAL PARAMETER NAME NOT FOUND: '
+     >              //TEXT)
+      ELSEIF(TEXT.EQ.';')THEN
+        GO TO 140
+      ELSE
+*       KEYWORD DOES NOT MATCH
+        CALL XABORT('@SIM: WRONG KEYWORD: '//TEXT//' (2).')
+      ENDIF
+      GO TO 10
+*----
+*  COMPUTE THE AVERAGE BURNUP
+*----
+  120 IF(HCYCL.EQ.' ') CALL XABORT('@SIM: HCNEW NOT DEFINED.')
+      BURNAVG=0.0
+      DO ICH=1,NCH
+        DO IB=1,NB
+          IOF=(IB-1)*NCH+ICH
+          IF(IFMIX(IOF).EQ.0) CYCLE
+          IF(BURNUP(IOF).EQ.-999.0) THEN
+            WRITE(HSMG,'(30HSIM: BURNUP NOT SET IN CHANNEL,I4,
+     >      11H AND BUNDLE,I4,1H.)') ICH,IB
+            CALL XABORT(HSMG)
+          ENDIF
+          BURNAVG=BURNAVG+BURNUP(IOF)
+        ENDDO
+      ENDDO
+      BURNAVG=BURNAVG/REAL(NTOT)
+*----
+*  SAVE INFORMATION IN DIRECTORY HCYCL AFTER REFUELLING
+*----
+      IF(JNDCY.EQ.0) CALL XABORT('@SIM: JNDCY NOT DEFINED.')
+      IF(IMPX.GT.0) WRITE(6,220) JNDCY,HCYCL,BURNAVG
+      CALL LCMPTC(KPMAP,'ALIAS',12,HCYCL)
+      CALL LCMPUT(KPMAP,'NAME',3*NCH,3,NAME)
+      CALL LCMPUT(KPMAP,'BURNAVG',1,2,BURNAVG)
+      CALL LCMPUT(KPMAP,'BURN-INST',NTOT,2,BURNUP)
+      CALL LCMPUT(KPMAP,'FLMIX',NTOT,1,IFMIX)
+      IF(NPARM.GT.0) THEN
+        LPMAP=LCMGID(IPMAP,'PARAM')
+        MPMAP=LCMLID(KPMAP,'PARAM',NPARM)
+        CALL LCMEQU(LPMAP,MPMAP)
+      ENDIF
+      IF((MLIB.GE.1).AND.(NIS.GT.0)) THEN
+*       IPLIB --> KPMAP(HCYCL)
+        CALL SIMLIB(IMPX,2,KPMAP,IPLIB,NTOT,NIS,IFMIX,HFOLLO,RFOLLO)
+      ENDIF
+*----
+*  SAVE THE INFORMATION IN THE FUELMAP AFTER REFUELLING.
+*----
+      CALL LCMPUT(IPMAP,'BURN-INST',NTOT,2,BURNUP)
+      CALL LCMPUT(IPMAP,'FLMIX',NTOT,1,IFMIX)
+      DEALLOCATE(OFOLLO,RFOLLO,OBURNU,BURNUP,FORM)
+      DEALLOCATE(OFMIX,ONAME,NAME,IFMIX,HZONE)
+      HCYCL=' '
+      GO TO 10
+*----
+*  PERFORM CALCULATION
+*----
+  130 IF(HCYCL.EQ.' ') CALL XABORT('@SIM: HCNEW NOT DEFINED.')
+      ALLOCATE(BUNDPOW(NTOT))
+      IF(.NOT.C_ASSOCIATED(IPPOW)) THEN
+        CALL LCMLEN(IPMAP,'BUND-PW',LENGT,ITYP)
+        IF(LENGT.EQ.0)CALL XABORT('@SIM: MISSING BUND-PW DATA IN '
+     >  //'L_MAP OBJECT.')
+        CALL LCMGET(IPMAP,'BUND-PW',BUNDPOW)
+      ELSE 
+        CALL LCMLEN(IPPOW,'POWER-CHAN',LENGT,ITYP)
+        IF(LENGT.EQ.0)CALL XABORT('@SIM: MISSING POWER-CHAN DATA I'
+     >  //'N L_POWER OBJECT.')
+        CALL LCMGET(IPPOW,'POWER-BUND',BUNDPOW)
+        CALL LCMGET(IPPOW,'K-EFFECTIVE',FKEFF)
+      ENDIF
+      TTIME=TTIME+TIME
+      ALLOCATE(BURNINST(NTOT))
+      IF(IMPX.GE.8) THEN
+        CALL SIMOUT(IPMAP,IMPX,BURNINST,HZONE,NCH,NB,LX,LY,HHX,IHY,
+     >  'BEGIN')
+      ENDIF
+      CALL TINSTB(IPMAP,TIME,BURNSTEP,NCH,NB,NF,BUNDPOW,BURNAVG,
+     > BURNINST,IMPX)
+*----
+*  SAVE LOCAL PARAMETERS FOR HISTORICAL FOLLOW-UP
+*----
+      CALL LCMLEN(IPMAP,HCYCL,ILONG,ITYLCM)
+      IF(ILONG.EQ.0) THEN
+        WRITE(HSMG,'(24HSIM: MISSING CYCLE NAME=,A12)') HCYCL
+        CALL XABORT(HSMG)
+      ENDIF
+      IF(IMPX.GT.0) WRITE(6,220) ILONG+1,HCYCL,BURNAVG
+      JPMAP=LCMLID(IPMAP,HCYCL,ILONG+1)
+      KPMAP=LCMGIL(JPMAP,1)
+      CALL LCMGET(KPMAP,'NAME',NAME)
+      CALL LCMGET(KPMAP,'FLMIX',IFMIX)
+      KPMAP=LCMDIL(JPMAP,ILONG+1)
+      CALL LCMPTC(KPMAP,'ALIAS',12,HCYCL)
+      CALL LCMPUT(KPMAP,'TIME',1,2,TTIME)
+      CALL LCMPUT(KPMAP,'BURNAVG',1,2,BURNAVG)
+      CALL LCMPUT(KPMAP,'BURN-INST',NTOT,2,BURNINST)
+      CALL LCMPUT(KPMAP,'POWER-BUND',NTOT,2,BUNDPOW)
+      CALL LCMPUT(KPMAP,'NAME',3*NCH,3,NAME)
+      CALL LCMPUT(KPMAP,'FLMIX',NTOT,1,IFMIX)
+      CALL LCMPUT(IPMAP,'BURN-INST',NTOT,2,BURNINST)
+      IF(C_ASSOCIATED(IPPOW)) CALL LCMPUT(KPMAP,'K-EFFECTIVE',1,2,FKEFF)
+      IF(NPARM.GT.0) THEN
+        LPMAP=LCMGID(IPMAP,'PARAM')
+        MPMAP=LCMLID(KPMAP,'PARAM',NPARM)
+        CALL LCMEQU(LPMAP,MPMAP)
+      ENDIF
+      IF((MLIB.GE.1).AND.(NIS.GT.0)) THEN
+*       IPLIB --> KPMAP(HCYCL)
+        CALL SIMLIB(IMPX,2,KPMAP,IPLIB,NTOT,NIS,IFMIX,HFOLLO,RFOLLO)
+      ENDIF
+      CALL SIMOUT(IPMAP,IMPX,BURNINST,HZONE,NCH,NB,LX,LY,HHX,IHY,
+     > 'END  ')
+      DEALLOCATE(BUNDPOW,BURNINST)
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('@SIM: CHARACTER DATA EXPECTED(29).')
+      IF(TEXT.NE.'ENDCYCLE')CALL XABORT('@SIM: ENDCYCLE KEYWORD EXPECT'
+     > //'ED.')
+      DEALLOCATE(OFOLLO,RFOLLO,OBURNU,BURNUP,FORM)
+      DEALLOCATE(OFMIX,ONAME,NAME,IFMIX,HZONE)
+      HCYCL=' '
+      GOTO 10
+*
+  140 IF(HCYCL.NE.' ') CALL XABORT('@SIM: HCNEW STILL ACTIVE.')
+      CALL LCMSIX(IPMAP,' ',0)
+      ISTATE(:NSTATE)=0
+      CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+      ISTATE(19)=NCYCLE
+      CALL LCMPUT(IPMAP,'STATE-VECTOR',NSTATE,1,ISTATE)
+      CALL LCMPUT(IPMAP,'DEPL-TIME',1,2,TTIME)
+      CALL LCMPUT(IPMAP,'REF-CHAN',NCH,2,RFCHAN)
+      DEALLOCATE(RFCHAN)
+      IF(NIS.GT.0) DEALLOCATE(HFOLLO)
+      RETURN
+*
+  190 FORMAT(/38H SIM: NUMBER OF ASSEMBLY SUBDIVISIONS=,I4/
+     1 6X,25HNUMBER OF FUEL CHANNELS =,I4/
+     2 6X,34HNUMBER OF ASSEMBLIES ALONG X AXIS=,I3/
+     3 6X,34HNUMBER OF ASSEMBLIES ALONG Y AXIS=,I3/)
+  200 FORMAT(/' SET GLOBAL PARAMETER          ',A,' TO =',1P,E14.6)
+  201 FORMAT(/' SET LOCAL PARAMETER (UNIFORM) ',A,' TO =',1P,E14.6)
+  210 FORMAT(/20H SIM: PROCESS CYCLE ,A12,16H WITH PROCEDURE ,A,1H.)
+  220 FORMAT(/36H SIM: STORE INFORMATION IN LIST ITEM,I3,10H OF CYCLE ,
+     > A12,10H AT BURNUP,1P,E14.6,8H MW-D/T./)
+      END
diff --git a/Donjon/src/SIMCOM.f b/Donjon/src/SIMCOM.f
new file mode 100644
index 0000000..6da5f9a
--- /dev/null
+++ b/Donjon/src/SIMCOM.f
@@ -0,0 +1,119 @@
+*DECK SIMCOM
+      SUBROUTINE SIMCOM(IPMAP,IMPX,IMODE,NCH,NB,HC1,HC2,INDCY1,INDCY2,
+     1 BURNCY1,BURNCY2,ERROR)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compare two fields of values, corresponding to two cycles.
+*
+*Copyright:
+* Copyright (C) 2013 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPMAP   fuel map
+* IMPX    print parameter
+* IMODE   type of field (1: burnup distribution; 2: power distribution)
+* NCH     number of assemblies or number of quart-of-assemblies.
+* NB      number of axial burnup subdivisions in an assembly.
+* HC1     first cycle list directory in IPMAP
+* HC2     first cycle list directory in IPMAP
+* INDCY1  integer index in directory HCY1. INDCY1=-1 if undefined at
+*         input.
+* INDCY2  integer index in directory HCY2. INDCY2=-1 if undefined at
+*         input.
+* BURNCY1 average burnup in directory HCY1. BURNCY1=-999.0 if undefined
+*         at input.
+* BURNCY2 average burnup in directory HCY2. BURNCY2=-999.0 if undefined
+*         at input.
+*
+*Parameters: output
+* ERROR   discrepancy between the two distributions
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAP
+      INTEGER IMPX,IMODE,NCH,NB,INDCY1,INDCY2
+      REAL BURNCY1,BURNCY2,ERROR
+      CHARACTER HC1*12,HC2*12
+*----
+*  LOCAL VARIABLES
+*----
+      TYPE(C_PTR) JPMAP,KPMAP
+      INTEGER SIMIND
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: DIST1,DIST2
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(DIST1(NCH,NB),DIST2(NCH,NB))
+*----
+*  RECOVER INFORMATION FROM THE FIRST CYCLE
+*----
+      JNDCY=SIMIND(IPMAP,IMPX,HC1,INDCY1,BURNCY1)
+      JPMAP=LCMGID(IPMAP,HC1)
+      KPMAP=LCMGIL(JPMAP,JNDCY)
+      IF(IMODE.EQ.1) THEN
+        CALL LCMGET(KPMAP,'BURN-INST',DIST1)
+      ELSE IF(IMODE.EQ.2) THEN
+        CALL LCMGET(KPMAP,'POWER-BUND',DIST1)
+      ENDIF
+*----
+*  RECOVER INFORMATION FROM THE SECOND CYCLE
+*----
+      JNDCY=SIMIND(IPMAP,IMPX,HC2,INDCY2,BURNCY2)
+      JPMAP=LCMGID(IPMAP,HC2)
+      KPMAP=LCMGIL(JPMAP,JNDCY)
+      IF(IMODE.EQ.1) THEN
+        CALL LCMGET(KPMAP,'BURN-INST',DIST2)
+      ELSE IF(IMODE.EQ.2) THEN
+        CALL LCMGET(KPMAP,'POWER-BUND',DIST2)
+      ENDIF
+*----
+*  COMPUTE DISCREPANCY
+*----
+      ERROR=0.0
+      ICHMAX=0
+      IBMAX=0
+      IF(IMODE.EQ.1) THEN
+        DO ICH=1,NCH
+          DO IB=1,NB
+            FLOT=ABS(DIST1(ICH,IB)-DIST2(ICH,IB))
+            IF(FLOT.GE.ERROR) THEN
+              ERROR=FLOT
+              ICHMAX=ICH
+              IBMAX=IB
+            ENDIF
+          ENDDO
+        ENDDO
+        IF(IMPX.GT.1) WRITE(6,100) ERROR,ICHMAX,IBMAX
+      ELSE IF(IMODE.EQ.2) THEN
+        DO ICH=1,NCH
+          DO IB=1,NB
+            FLOT=ABS(DIST1(ICH,IB)-DIST2(ICH,IB))/ABS(DIST2(ICH,IB))
+            IF(FLOT.GE.ERROR) THEN
+              ERROR=FLOT
+              ICHMAX=ICH
+              IBMAX=IB
+            ENDIF
+          ENDDO
+        ENDDO
+        IF(IMPX.GT.1) WRITE(6,110) ERROR,ICHMAX,IBMAX
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(DIST2,DIST1)
+      RETURN
+*
+  100 FORMAT(/49H SIM: MAXIMUM DISCREPANCY ON BURNUP DISTRIBUTION=,1P,
+     > E11.4,18H MW-D/T IN CHANNEL,I4,22H AND AXIAL SUBDIVISION,I4,1H./)
+  110 FORMAT(/51H SIM: MAXIMUM RELATIVE ERROR ON POWER DISTRIBUTION=,1P,
+     > E11.4,18H MW-D/T IN CHANNEL,I4,22H AND AXIAL SUBDIVISION,I4,1H./)
+      END
diff --git a/Donjon/src/SIMCPY.f b/Donjon/src/SIMCPY.f
new file mode 100644
index 0000000..2522d32
--- /dev/null
+++ b/Donjon/src/SIMCPY.f
@@ -0,0 +1,102 @@
+*DECK SIMCPY
+      SUBROUTINE SIMCPY(NCH,NB,HCYC,NASMB1,ASMB1,ASMB1B,ZONE,NIS,NAME,
+     > BURNUP,FMIX,RFOLLO,ONAME,OBURNU,OFMIX,OFOLLO)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover the burnup of an assembly in another cycle.
+*
+*Copyright:
+* Copyright (C) 2013 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input/output
+* NCH     number of assemblies or number of quart-of-assemblies.
+* NB      number of axial burnup subdivisions in an assembly.
+* HCYC    name of cycle.
+* NASMB1  number of assemblies to set.
+* ASMB1   group of assembly names, as defined in the fuel map, to set
+*         at specific burnup.
+* ASMB1B  assembly name, as defined in the fuel map, to which we
+*         want to copy burnup.
+* ZONE    default assembly or quart-of-assembly names as defined in
+*         the fuel map.
+* NIS     number of particularized isotopes.
+* NAME    names of each assembly or of each quart-of assembly during
+*         a refuelling cycle. All quart-of-assembly belonging to the
+*         same assembly have the same name.
+* BURNUP  burnups during a refuelling cycle. A value of -999.0 means
+*         a non-initialized value.
+* FMIX    assembly mixtures after refuelling.
+* RFOLLO  number densities of the particularized isotopes after
+*         refuelling.
+* ONAME   names of each assembly or of each quart-of assembly during
+*         a previous refuelling cycle.
+* OBURNU  burnups at the end of a previous refuelling cycle.
+* OFMIX   assembly types in a previous refuelling cycle.
+* OFOLLO  number densities of the particularized isotopes at the end
+*         of a previous refuelling cycle.
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER NCH,NB,NASMB1,NIS,FMIX(NCH,NB),OFMIX(NCH,NB)
+      CHARACTER HCYC*12,ASMB1(NASMB1)*4,ASMB1B*4,ZONE(NCH)*4,
+     > NAME(NCH)*12,ONAME(NCH)*12
+      REAL BURNUP(NCH,NB),RFOLLO(NCH,NB,NIS),OBURNU(NCH,NB),
+     > OFOLLO(NCH,NB,NIS)
+*----
+*  LOCAL VARIABLES
+*----
+      CHARACTER HSMG*131
+      CHARACTER(LEN=4), ALLOCATABLE, DIMENSION(:) :: ZONE2
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(ZONE2(NCH))
+*
+      DO IASMB1=1,NASMB1
+        DO 10 ICH=1,NCH
+        ZONE2(ICH)=ZONE(ICH)
+   10   CONTINUE
+        DO ICH=1,NCH
+          IF(ZONE(ICH).EQ.ASMB1(IASMB1)) THEN
+            IOLD=0
+            DO ICH2=1,NCH
+              IF(ZONE2(ICH2).EQ.ASMB1B) THEN
+                IOLD=ICH2
+                ZONE2(ICH2)=' '
+                GO TO 20
+              ENDIF
+            ENDDO
+            WRITE(HSMG,'(33H@SIMCPY: UNABLE TO FIND ASSEMBLY ,A4,
+     >      25HIN THE FUEL MAP AT CYCLE ,A12,1H.)') ASMB1B,HCYC
+            CALL XABORT(HSMG)
+   20       DO IB=1,NB
+              IF(BURNUP(ICH,IB).NE.-999.0) THEN
+                WRITE(HSMG,'(38H@SIMCPY: BURNUP ALREADY DEFINED IN CHA,
+     >          4HNNEL,I4,10HAND BUNDLE,I4,10H AT CYCLE ,A12,1H.)')
+     >          ICH,IB,HCYC
+              ENDIF
+              BURNUP(ICH,IB)=OBURNU(IOLD,IB)
+              FMIX(ICH,IB)=OFMIX(ICH,IB)
+              DO ISO=1,NIS
+                RFOLLO(ICH,IB,ISO)=OFOLLO(IOLD,IB,ISO)
+              ENDDO
+            ENDDO
+            NAME(ICH)=ONAME(IOLD)
+            CYCLE
+          ENDIF
+        ENDDO
+      ENDDO
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(ZONE2)
+      RETURN
+      END
diff --git a/Donjon/src/SIMDIS.f b/Donjon/src/SIMDIS.f
new file mode 100644
index 0000000..8357b60
--- /dev/null
+++ b/Donjon/src/SIMDIS.f
@@ -0,0 +1,103 @@
+*DECK SIMDIS
+      SUBROUTINE SIMDIS(LSET,NCH,NB,HCYC,NASMB1,ASMB1,FORM,ASMB1B,ZONE,
+     > BURNUP,OBURNU)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Axial normalization of the burnup distribution using information from
+* another cycle.
+*
+*Copyright:
+* Copyright (C) 2013 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input/output
+* LSET    type of normalization (=.true.: use FORM info; =.false: use
+*         an existing assembly).
+* NCH     number of assemblies or number of quart-of-assemblies.
+* NB      number of axial burnup subdivisions in an assembly.
+* HCYC    name of cycle.
+* NASMB1  number of assemblies to set.
+* ASMB1   group of assembly names, as defined in the fuel map, to set
+*         at specific burnup.
+* FORM    axial form factor used if LSET=.true.
+* ASMB1B  assembly name, as defined in the fuel map, to which we
+*         want to use the burnup distribution if LSET=.false.
+* ZONE    default assembly or quart-of-assembly names as defined in
+*         the fuel map.
+* BURNUP  burnups during a refuelling cycle.
+* OBURNU  burnups during a previous refuelling cycle.
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      LOGICAL LSET
+      INTEGER NCH,NB,NASMB1
+      CHARACTER HCYC*12,ASMB1(NASMB1)*4,ASMB1B*4,ZONE(NCH)*4
+      REAL FORM(NB),BURNUP(NCH,NB),OBURNU(NCH,NB)
+*----
+*  LOCAL VARIABLES
+*----
+      CHARACTER HSMG*131
+      CHARACTER(LEN=4), ALLOCATABLE, DIMENSION(:) :: ZONE2
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(ZONE2(NCH))
+*
+      ZNUM=0.0
+      ZDEN=0.0
+      DO IASMB1=1,NASMB1
+        DO 10 ICH=1,NCH
+        ZONE2(ICH)=ZONE(ICH)
+   10   CONTINUE
+        DO ICH=1,NCH
+          IF(ZONE(ICH).EQ.ASMB1(IASMB1)) THEN
+            IF(LSET) THEN
+              ZNUM=0.0
+              ZDEN=0.0
+              DO IB=1,NB
+                ZNUM=ZNUM+BURNUP(ICH,IB)
+                ZDEN=ZDEN+FORM(IB)
+              ENDDO
+              DO IB=1,NB
+                BURNUP(ICH,IB)=FORM(IB)*ZNUM/ZDEN
+              ENDDO
+            ELSE
+              IOLD=0
+              DO ICH2=1,NCH
+                IF(ZONE2(ICH2).EQ.ASMB1B) THEN
+                  IOLD=ICH2
+                  ZONE2(ICH2)=' '
+                  GO TO 20
+                ENDIF
+              ENDDO
+              WRITE(HSMG,'(33H@SIMDIS: UNABLE TO FIND ASSEMBLY ,A4,
+     >        25HIN THE FUEL MAP AT CYCLE ,A12,1H.)') ASMB1(IASMB1),
+     >        HCYC
+              CALL XABORT(HSMG)
+   20         ZNUM=0.0
+              ZDEN=0.0
+              DO IB=1,NB
+                ZNUM=ZNUM+BURNUP(ICH,IB)
+                ZDEN=ZDEN+OBURNU(IOLD,IB)
+              ENDDO
+              DO IB=1,NB
+                BURNUP(ICH,IB)=OBURNU(IOLD,IB)*ZNUM/ZDEN
+              ENDDO
+            ENDIF
+            CYCLE
+          ENDIF
+        ENDDO
+      ENDDO
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(ZONE2)
+      RETURN
+      END
diff --git a/Donjon/src/SIMIND.f b/Donjon/src/SIMIND.f
new file mode 100644
index 0000000..070bb4c
--- /dev/null
+++ b/Donjon/src/SIMIND.f
@@ -0,0 +1,95 @@
+*DECK SIMIND
+      INTEGER FUNCTION SIMIND(IPMAP,IMPX,HCYCLE,INDCY,BURNCY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Return the list index of an existing fuel cycle.
+*
+*Copyright:
+* Copyright (C) 2013 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPMAP   fuel map object
+* IMPX    print parameter
+* HCYCLE  cycle list directory in IPMAP
+* INDCY   integer index in directory HCYCLE. INDCY=-1 if undefined at
+*         input.
+* BURNCY  average burnup in directory HCYCLE. BURNCY=-999.0 if undefined
+*         at input.
+*
+*Parameters: output
+* SIMIND  list index in HCYCLE
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAP
+      INTEGER IMPX,INDCY
+      CHARACTER HCYCLE*12,HSMG*131
+      REAL BURNCY
+*----
+*  LOCAL VARIABLES
+*----
+      TYPE(C_PTR) JPMAP,KPMAP
+*
+      SIMIND=0
+      CALL LCMLEN(IPMAP,HCYCLE,ILONG,ITYLCM)
+      IF(ILONG.EQ.0) THEN
+        CALL LCMLIB(IPMAP)
+        WRITE(HSMG,'(24H@SIMIND: NO CYCLE NAMED ,A12,1H.)') HCYCLE
+        CALL XABORT(HSMG)
+      ENDIF
+      IF(INDCY.NE.-1) THEN
+        IF(INDCY.GT.ILONG) CALL XABORT('@SIMIND: INDCY.GT.ILONG')
+        IF(BURNCY.NE.-999.0) CALL XABORT('@SIMIND: BURNCY.NE.-999.0')
+        SIMIND=INDCY
+        IF(IMPX.GT.0) THEN
+          JPMAP=LCMGID(IPMAP,HCYCLE)
+          KPMAP=LCMGIL(JPMAP,INDCY)
+          CALL LCMGET(KPMAP,'BURNAVG',BURNAVG)
+          WRITE(6,100) INDCY,HCYCLE,BURNAVG
+        ENDIF
+        RETURN
+      ELSE IF((INDCY.EQ.-1).AND.(BURNCY.EQ.-999.0)) THEN
+        SIMIND=ILONG
+        IF(IMPX.GT.0) THEN
+          JPMAP=LCMGID(IPMAP,HCYCLE)
+          KPMAP=LCMGIL(JPMAP,ILONG)
+          CALL LCMGET(KPMAP,'BURNAVG',BURNAVG)
+          WRITE(6,100) ILONG,HCYCLE,BURNAVG
+        ENDIF
+        RETURN
+      ENDIF
+*
+      DELTA=1.0E10
+      BURNK=0.0
+      JPMAP=LCMGID(IPMAP,HCYCLE)
+      DO I=1,ILONG
+        KPMAP=LCMGIL(JPMAP,I)
+        CALL LCMLEN(KPMAP,'BURNAVG',ILONG,ITYLCM)
+        IF(ILONG.EQ.0) CYCLE
+        CALL LCMGET(KPMAP,'BURNAVG',BURNAVG)
+        IF(ABS(BURNAVG-BURNCY).LT.DELTA) THEN
+          SIMIND=I
+          DELTA=ABS(BURNAVG-BURNCY)
+          BURNK=BURNAVG
+        ENDIF
+      ENDDO
+      IF(DELTA.GT.2.0) THEN
+        WRITE(HSMG,'(47H@SIMIND: UNABLE TO FIND AN EXISTING AVERAGE BUR,
+     >  12HNUP EQUAL TO,1P,E12.4,10H IN CYCLE ,A12,1H.)') BURNCY,HCYCLE
+        CALL XABORT(HSMG)
+      ENDIF
+      IF(IMPX.GT.0) WRITE(6,100) SIMIND,HCYCLE,BURNK
+      RETURN
+*
+  100 FORMAT(/40H SIMIND: RECOVER LIST INDEX IN LIST ITEM,I3,7H OF CYC,
+     > 3HLE ,A12,10H AT BURNUP,1P,E12.4,8H MW-D/T./)
+      END
diff --git a/Donjon/src/SIMLIB.f b/Donjon/src/SIMLIB.f
new file mode 100644
index 0000000..1cda07e
--- /dev/null
+++ b/Donjon/src/SIMLIB.f
@@ -0,0 +1,112 @@
+*DECK SIMLIB
+      SUBROUTINE SIMLIB(IMPX,MODE,KPMAP,IPLIB,NTOT,NIS,IFMIX,HFOLLO,
+     > RFOLLO)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Put/get number densities of particularized isotopes in the microlib
+*
+*Copyright:
+* Copyright (C) 2017 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IMPX    print parameter.
+* MODE    transfert mode (=1: get from KPMAP; =2: put to KPMAP).
+* KPMAP   HCYCLE subdirectory in the fuelmap.
+* IPLIB   pointer to the microlib.
+* NTOT    number of fuel bundles.
+* NIS     number of particularized isotopes.
+* IFMIX   fuel mixture assigned to each fuel bundle.
+* HFOLLO  character*8 names of the particularized isotopes.
+*
+*Parameters: input/output
+* RFOLLO  number densities of the particularized isotopes.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) KPMAP,IPLIB
+      INTEGER IMPX,MODE,NIS,NTOT,IFMIX(NTOT)
+      REAL RFOLLO(NTOT,NIS)
+      CHARACTER*8 HFOLLO(NIS)
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(NSTATE=40)
+      INTEGER ISTATE(NSTATE)
+      CHARACTER*12 HCYCL
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IMIX,IVB
+      REAL, ALLOCATABLE, DIMENSION(:) :: DENS
+      CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: HUSE
+*
+      IF(.NOT.C_ASSOCIATED(IPLIB)) THEN
+        CALL XABORT('SIMLIB: MICROLIB LCM OBJECT MISSING AT RHS.')
+      ENDIF
+      CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+      NBMIX=ISTATE(1)
+      NBISO=ISTATE(2)
+      IF(NTOT.GT.NBMIX) CALL XABORT('SIMLIB: NBMIX OVERFLOW.')
+      ALLOCATE(HUSE(NBISO),DENS(NBISO),IMIX(NBISO),IVB(NBMIX))
+      CALL LCMGTC(IPLIB,'ISOTOPESUSED',12,NBISO,HUSE)
+      CALL LCMGET(IPLIB,'ISOTOPESMIX',IMIX)
+      CALL LCMGET(IPLIB,'ISOTOPESDENS',DENS)
+      IVB(:NBMIX)=0
+      IBM=0
+      DO ITOT=1,NTOT
+        IF(IFMIX(ITOT).EQ.0) CYCLE
+        IBM=IBM+1
+        IVB(IBM)=ITOT
+      ENDDO
+      CALL LCMGTC(KPMAP,'ALIAS',12,HCYCL)
+      IF(MODE.EQ.1) THEN
+*       recover number densities from KCYCLE directory
+        IF(IMPX.GE.0) WRITE(6,'(/34H SIMLIB: recover number densities ,
+     >  5Hfrom ,A,11H directory.)') HCYCL
+        CALL LCMGET(KPMAP,'FOLLOW',RFOLLO)
+        DO ISO=1,NBISO
+          IBM=IMIX(ISO)
+          ITOT=IVB(IBM)
+          IF(ITOT.EQ.0) CALL XABORT('SIMLIB: MISSING FUEL BUNDLE(1).')
+          DO JSO=1,NIS
+            IF(HUSE(ISO)(:8).EQ.HFOLLO(JSO)) THEN
+              DENS(ISO)=RFOLLO(ITOT,JSO)
+              GO TO 10
+            ENDIF
+          ENDDO
+   10     CONTINUE
+        ENDDO
+        CALL LCMPUT(IPLIB,'ISOTOPESDENS',NBISO,2,DENS)
+      ELSE IF(MODE.EQ.2) THEN
+*       put number densities in KCYCLE directory
+        IF(IMPX.GE.0) WRITE(6,'(/33H SIMLIB: put number densities in ,
+     >  A,11H directory.)') HCYCL
+        RFOLLO(:NTOT,:NIS)=0.0
+        DO ISO=1,NBISO
+          IBM=IMIX(ISO)
+          ITOT=IVB(IBM)
+          IF(ITOT.EQ.0) CALL XABORT('SIMLIB: MISSING FUEL BUNDLE(2).')
+          DO JSO=1,NIS
+            IF(HUSE(ISO)(:8).EQ.HFOLLO(JSO)) THEN
+              RFOLLO(ITOT,JSO)=DENS(ISO)
+              GO TO 20
+            ENDIF
+          ENDDO
+   20     CONTINUE
+        ENDDO
+        CALL LCMPUT(KPMAP,'FOLLOW',NTOT*NIS,2,RFOLLO)
+      ELSE
+        CALL XABORT('SIMLIB: INVALID VALUE OF MODE.')
+      ENDIF
+      DEALLOCATE(IVB,IMIX,DENS,HUSE)
+      RETURN
+      END
diff --git a/Donjon/src/SIMOUT.f b/Donjon/src/SIMOUT.f
new file mode 100644
index 0000000..abff32b
--- /dev/null
+++ b/Donjon/src/SIMOUT.f
@@ -0,0 +1,155 @@
+*DECK SIMOUT
+      SUBROUTINE SIMOUT(IPMAP,IMPX,BURNINS,IZONE,NCH,NB,LX,LY,HHX,IHY,
+     > STATE)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Print burnup distribution (3D), radial averages or axial averages
+*
+*Copyright:
+* Copyright (C) 2013 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* V. Salino
+*
+*Parameters: input
+* IPMAP   fuel map object.
+* IMPX    print parameter.
+* BURNINS instantaneous burnups.
+* IZONE   default assembly or quart-of-assembly names as defined in
+*         the fuel map.
+* NCH     number of assemblies or number of quart-of-assemblies.
+* NB      number of axial burnup subdivisions in an assembly.
+* LX      number of assemblies along the X axis.
+* LY      number of assemblies along the Y axis.
+* LXMIN   coordinates on X axis of the first assembly.
+* LYMIN   coordinates on Y axis of the first assembly.
+* HHX     naval battle indices along X axis.
+* IHY     naval battle indices along Y axis.
+* STATE   flag indicating whether it is a beginning-of-stage print
+*         or a end-of-stage print.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAP
+      INTEGER IMPX,IHY(LY),NCH,NB,LX,LY
+      CHARACTER HHX(LX)*1,IZONE(NCH)*4,STATE*5
+      REAL BURNINS(NCH,NB)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER INTG2,INTG2B
+      REAL MEANR
+      CHARACTER TEXT4*4,TEXT1*1,TEXT1B*1
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      REAL, ALLOCATABLE, DIMENSION(:) :: MEAN
+*
+      IF(STATE.EQ.'BEGIN')THEN
+        CALL LCMGET(IPMAP,'BURN-INST',BURNINS)
+      ENDIF
+*----
+*  RADIALLY-AVERAGED BURNUP MAP
+*----
+      IF((STATE.EQ.'BEGIN'.AND.IMPX.GE.8).OR.
+     >   (STATE.EQ.'END  '.AND.IMPX.GE.3)) THEN
+        IF(STATE.EQ.'BEGIN')THEN
+          WRITE(6,100)
+        ELSE
+          WRITE(6,105)
+        ENDIF
+        WRITE(6,110) (HHX(I),I=1,LX)
+        ICH=1
+        DO I=1,LY
+          TEXT4=IZONE(ICH)
+          READ(TEXT4,'(A1,I2)') TEXT1,INTG2
+          NFULL=0
+          DO J=1,LX+1
+            NFULL=J
+            IF(ICH.EQ.(NCH+1))GO TO 10
+            TEXT4=IZONE(ICH)
+            READ(TEXT4,'(A1,I2)') TEXT1B,INTG2B
+            IF(INTG2.NE.INTG2B)GO TO 10
+            ICH=ICH+1
+          ENDDO
+          CALL XABORT('@SIMOUT: INCOHERENCE IN BASIC ASSEMBLY '
+     >    //'LAYOUT GIVEN IN RESINI:.')
+  10      CONTINUE
+          NFULL=NFULL-1
+          NEMPTY=(LX-NFULL)/2
+          ALLOCATE(MEAN(NFULL))
+          MEAN(:NFULL)=0.0
+          DO K=1,NFULL
+            DO IB=1,NB
+              MEAN(K)=MEAN(K)+BURNINS(ICH-1-NFULL+K,IB)/NB
+            ENDDO
+          ENDDO
+          WRITE(6,115,ADVANCE='NO') IHY(I)
+          DO K=1,NEMPTY
+            WRITE(6,120,ADVANCE='NO')
+          ENDDO
+          WRITE(6,125) (NINT(MEAN(K)),K=1,NFULL)
+          DEALLOCATE(MEAN)
+        ENDDO
+      ENDIF
+*----
+*  AXIALLY-AVERAGED BURNUP MAP
+*----
+      IF((STATE.EQ.'BEGIN'.AND.IMPX.GE.9).OR.
+     >   (STATE.EQ.'END  '.AND.IMPX.GE.4))THEN
+        IF(STATE.EQ.'BEGIN')THEN
+          WRITE(6,130)
+        ELSE
+          WRITE(6,135)
+        ENDIF
+        DO IB=1,NB
+          MEANR=0.0
+          DO ICH=1,NCH
+            MEANR=MEANR+BURNINS(ICH,IB)/NCH
+          ENDDO
+          WRITE(6,140) NINT(MEANR)
+        ENDDO
+      ENDIF
+*----
+*  PER-ASSEMBLY 3D BURNUP MAP
+*----
+      IF((STATE.EQ.'BEGIN'.AND.IMPX.GE.10).OR.
+     >   (STATE.EQ.'END  '.AND.IMPX.GE.5))THEN
+        IF(STATE.EQ.'BEGIN')THEN
+          WRITE(6,150)
+        ELSE
+          WRITE(6,155)
+        ENDIF
+        DO ICH=1,NCH
+          WRITE(6,160) IZONE(ICH)
+          WRITE(6,170) (BURNINS(ICH,IB),IB=1,NB)
+        ENDDO
+      ENDIF
+*
+      IF(STATE.EQ.'BEGIN') BURNINS(:NCH,:NB)=0.0
+      RETURN
+*
+  100 FORMAT(' SIM: BEGINNING-OF-STAGE BURNUP MAP (MW*D/TONNE), ',
+     > 'RADIAL VIEW :')
+  105 FORMAT(' SIM: END-OF-STAGE BURNUP MAP (MW*D/TONNE), ',
+     > 'RADIAL VIEW :')
+  110 FORMAT(1X,20(5X,1A1))
+  115 FORMAT(1X,I2)
+  120 FORMAT(6X)
+  125 FORMAT(21I6)
+  130 FORMAT(/,' SIM: BEGINNING-OF-STAGE BURNUP MAP (MW*D/TONNE), ',
+     > 'AXIAL VIEW :')
+  135 FORMAT(/,' SIM: END-OF-STAGE BURNUP MAP (MW*D/TONNE), ',
+     > 'AXIAL VIEW :')
+  140 FORMAT(1X,I5.1)
+  150 FORMAT(/,' SIM: BEGINNING-OF-STAGE 3D BURNUP MAP (MW*D/TONNE) :')
+  155 FORMAT(/,' SIM: END-OF-STAGE 3D BURNUP MAP (MW*D/TONNE) :')
+  160 FORMAT('   Assembly ',A)
+  170 FORMAT(3X,16(1X,F7.1))
+      END
diff --git a/Donjon/src/SIMPOS.f b/Donjon/src/SIMPOS.f
new file mode 100644
index 0000000..b01d1f0
--- /dev/null
+++ b/Donjon/src/SIMPOS.f
@@ -0,0 +1,149 @@
+*DECK SIMPOS
+      SUBROUTINE SIMPOS(LX,LY,NCH,NB,HCYC,HOLD,HHX,IHY,ZONE,INFMIX,
+     > NIS,CYCLE,NAME,BURNUP,FMIX,RFOLLO,ONAME,OBURNU,OFMIX,OFOLLO)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Set the correspondance between assembly indices during refuelling.
+*
+*Copyright:
+* Copyright (C) 2013 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input/output
+* LX      number of assemblies along the X axis.
+* LY      number of assemblies along the Y axis.
+* NCH     number of assemblies or number of quart-of-assemblies.
+* NB      number of axial burnup subdivisions in an assembly.
+* HCYC    name of cycle.
+* HOLD    name of previous cycle.
+* HHX     naval battle indices along X axis.
+* IHY     naval battle indices along Y axis.
+* ZONE    default assembly or quart-of-assembly names as defined in
+*         the fuel map.
+* INFMIX  assembly types as defined in the fuel map.
+* NIS     number of particularized isotopes.
+* CYCLE   shuffling matrix for refuelling as provided by the plant
+*         operator. The name "|" is reserved for empty locations. 
+* NAME    names of each assembly or of each quart-of assembly during
+*         a refuelling cycle. All quart-of-assembly belonging to the
+*         same assembly have the same name.
+* BURNUP  burnups during a refuelling cycle. A value of -999.0 means
+*         a non-initialized value.
+* FMIX    assembly mixtures after refuelling.
+* RFOLLO  number densities of the particularized isotopes after
+*         refuelling.
+* ONAME   names of each assembly or of each quart-of assembly during
+*         a previous refuelling cycle.
+* OBURNU  burnups during a previous refuelling cycle.
+* OFMIX   assembly types in a previous refuelling cycle.
+* OFOLLO  number densities of the particularized isotopes at the end
+*         of a previous refuelling cycle.
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER LX,LY,NCH,NB,IHY(LY),INFMIX(NCH,NB),NIS,FMIX(NCH,NB),
+     > OFMIX(NCH,NB)
+      CHARACTER HCYC*12,HOLD*12,HHX(LX)*1,ZONE(NCH)*4,CYCLE(LX,LY)*4,
+     > NAME(NCH)*12,ONAME(NCH)*12
+      REAL BURNUP(NCH,NB),RFOLLO(NCH,NB,NIS),OBURNU(NCH,NB),
+     > OFOLLO(NCH,NB,NIS)
+*----
+*  LOCAL VARIABLES
+*----
+      CHARACTER TEXT4*4,TEXT1*1,HSMG*131
+      CHARACTER(LEN=4), ALLOCATABLE, DIMENSION(:) :: ZONE2
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(ZONE2(NCH))
+*
+      MAXINF=0
+      DO 10 ICH=1,NCH
+      MAXINF=MAX(MAXINF,MAXVAL(INFMIX(ICH,:NB)))
+      ZONE2(ICH)=ZONE(ICH)
+   10 CONTINUE
+      DO ICH=1,NCH
+        TEXT4=ZONE(ICH)
+        READ(TEXT4,'(A1,I2)') TEXT1,INTG2
+        INDX=0
+        DO IX=1,LX
+          IF(TEXT1.EQ.HHX(IX)) INDX=IX
+        ENDDO
+        IF(INDX.EQ.0) CALL XABORT('@SIMPOS: UNABLE TO FIND INDX.')
+        INDY=0
+        DO IY=1,LY
+          IF(INTG2.EQ.IHY(IY)) INDY=IY
+        ENDDO
+        IF(INDY.EQ.0) CALL XABORT('@SIMPOS: UNABLE TO FIND INDY.')
+        TEXT4=CYCLE(INDX,INDY)
+        IF((TEXT4.EQ.'|').OR.(TEXT4.EQ.'-').OR.(TEXT4.EQ.'-|-')) THEN
+          WRITE(HSMG,'(16H@SIMPOS: CHANNEL,I4,21H REFERS TO LOCATION (,
+     >    I4,1H,,I4,37H) WHICH IS OUTSIDE THE CORE AT CYCLE ,A12,1H.)')
+     >    ICH,INDX,INDY,HCYC
+          CALL XABORT(HSMG)
+        ELSE IF(TEXT4.EQ.'SPC') THEN
+          DO IB=1,NB
+            BURNUP(ICH,IB)=-999.0
+            FMIX(ICH,IB)=INFMIX(ICH,IB)
+            DO ISO=1,NIS
+              RFOLLO(ICH,IB,ISO)=0.0
+            ENDDO
+          ENDDO
+          WRITE(NAME(ICH),'(A3,1H/,A8)') TEXT4(:3),HCYC(:8)
+        ELSE IF(TEXT4.EQ.'NEW') THEN
+          DO IB=1,NB
+            BURNUP(ICH,IB)=0.0
+            FMIX(ICH,IB)=INFMIX(ICH,IB)
+            DO ISO=1,NIS
+              RFOLLO(ICH,IB,ISO)=0.0
+            ENDDO
+          ENDDO
+          WRITE(NAME(ICH),'(A3,1H/,A8)') TEXT4(:3),HCYC(:8)
+        ELSE IF(TEXT4(4:).EQ.'@') THEN
+          READ(TEXT4,'(I3,1X)') NITMA
+          IF(NITMA.GT.MAXINF) CALL XABORT('@SIMPOS: MAXINF OVERFLOW.')
+          DO IB=1,NB
+            BURNUP(ICH,IB)=0.0
+            FMIX(ICH,IB)=INFMIX(ICH,IB)
+            IF(INFMIX(ICH,IB).NE.0) FMIX(ICH,IB)=NITMA
+            DO ISO=1,NIS
+              RFOLLO(ICH,IB,ISO)=0.0
+            ENDDO
+          ENDDO
+          WRITE(NAME(ICH),'(A3,1H/,A8)') 'NEW',HCYC(:8)
+        ELSE
+          IF(HOLD.EQ.' ') CALL XABORT('@SIMPOS: NO PREVIOUS CYCLE.')
+          IOLD=0
+          DO ICH2=1,NCH
+            IF(ZONE2(ICH2).EQ.TEXT4) THEN
+              IOLD=ICH2
+              ZONE2(ICH2)=' '
+              GO TO 20
+            ENDIF
+          ENDDO
+          WRITE(HSMG,'(33H@SIMPOS: UNABLE TO FIND ASSEMBLY ,A4,
+     >    25HIN THE FUEL MAP AT CYCLE ,A12,1H.)') TEXT4,HCYC
+          CALL XABORT(HSMG)
+   20     DO IB=1,NB
+            BURNUP(ICH,IB)=OBURNU(IOLD,IB)
+            FMIX(ICH,IB)=OFMIX(IOLD,IB)
+            DO ISO=1,NIS
+              RFOLLO(ICH,IB,ISO)=OFOLLO(IOLD,IB,ISO)
+            ENDDO
+          ENDDO
+          NAME(ICH)=ONAME(IOLD)
+        ENDIF
+      ENDDO
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(ZONE2)
+      RETURN
+      END
diff --git a/Donjon/src/SIMQMP.f b/Donjon/src/SIMQMP.f
new file mode 100644
index 0000000..9143a89
--- /dev/null
+++ b/Donjon/src/SIMQMP.f
@@ -0,0 +1,135 @@
+*DECK SIMQMP
+      SUBROUTINE SIMQMP(LX,LY,LXMIN,LYMIN,HHX,IHY,CYCLE)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Unfold the quarter shuffling map to full shuffling map, using
+* rotations around the center.
+*
+*Copyright:
+* Copyright (C) 2013 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* V. Salino
+*
+*Parameters: input
+* LX      number of assemblies along the X axis.
+* LY      number of assemblies along the Y axis.
+* LXMIN   coordinates on X axis of the first assembly.
+* LYMIN   coordinates on Y axis of the first assembly.
+* HHX     naval battle indices along X axis.
+* IHY     naval battle indices along Y axis.
+*
+*Parameters: input/output
+* CYCLE   shuffling matrix for refuelling given as a quarter map,
+*         and returned as a full reconstructed matrix
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER LX,LY,LXMIN,LYMIN,IHY(LY)
+      CHARACTER HHX(LX)*1,CYCLE(LX,LY)*4
+*----
+*  LOCAL VARIABLES
+*   ROTMAT  counter-clockwise rotation matrices, with an Y-axis directed
+*           downward.
+*           ROTMAT(x,x,1) <  90 degrees rotation matrix
+*           ROTMAT(x,x,2) < 180 degrees rotation matrix
+*           ROTMAT(x,x,3) < 270 degrees rotation matrix
+*----
+      INTEGER INTG2,XPOS,YPOS,Q
+      REAL XCENTER,YCENTER,ROTX(3),ROTY(3),IROT(3),JROT(3),
+     >     ROTMAT(2,2,3)
+      CHARACTER TEXT4*4,TEXT1*1,RECONS(3)*4
+*
+      DATA ROTMAT(1,1,1), ROTMAT(1,2,1)/+0.0, +1.0/
+      DATA ROTMAT(2,1,1), ROTMAT(2,2,1)/-1.0, +0.0/
+*
+      DATA ROTMAT(1,1,2), ROTMAT(1,2,2)/-1.0, +0.0/
+      DATA ROTMAT(2,1,2), ROTMAT(2,2,2)/+0.0, -1.0/
+*
+      DATA ROTMAT(1,1,3), ROTMAT(1,2,3)/+0.0, -1.0/
+      DATA ROTMAT(2,1,3), ROTMAT(2,2,3)/+1.0, +0.0/
+*
+      IF(LX.NE.LY) CALL XABORT('@SIMQMP: QMAP KEYWORD IS NOT
+     > COMPATIBLE WITH A NON-SQUARE REFUELLING SCHEME.')
+      XCENTER=(REAL(LX)+1)/2
+      YCENTER=(REAL(LY)+1)/2
+      DO J=LYMIN,LY
+        DO I=LXMIN,LX
+*         Excluding potential central assembly from reconstruction
+          IF(.NOT.(MOD(LX,2).EQ.1.AND.I.EQ.LXMIN.AND.J.EQ.LYMIN)) THEN
+            TEXT4=CYCLE(I,J)
+            DO Q=1,3
+              IF((TEXT4.NE.'NEW').AND.(TEXT4.NE.'|').AND.(TEXT4.NE.'-')
+     >        .AND.(TEXT4.NE.'-|-').AND.(TEXT4.NE.'SPC').AND.
+     >        (TEXT4(4:).NE.'@')) THEN
+                READ(TEXT4,'(A1,I2)') TEXT1,INTG2
+                XPOS=0
+                DO K=1,LX
+                  IF(HHX(K).EQ.TEXT1) THEN
+                    IF(XPOS.NE.0)CALL XABORT('@SIMQMP: X-AXIS HAS '
+     >              //'MULTIPLE TIMES THE SAME COORDINATES. CHECK '
+     >              //'YOUR RESINI: CALL.')
+                    XPOS=K
+                  ENDIF
+                ENDDO
+                IF(XPOS.EQ.0) CALL XABORT('@SIMQMP: UNABLE TO FIND XPO'
+     >          //'S(1).')
+                YPOS=0
+                DO K=1,LY
+                  IF(IHY(K).EQ.INTG2) THEN
+                    IF(YPOS.NE.0)CALL XABORT('@SIMQMP: Y-AXIS HAS '
+     >              //'MULTIPLE TIMES THE SAME COORDINATES. CHECK '
+     >              //'YOUR RESINI: CALL.')
+                    YPOS=K
+                  ENDIF
+                ENDDO
+                IF(YPOS.EQ.0) CALL XABORT('@SIMQMP: UNABLE TO FIND YPO'
+     >          //'S(2).')
+*               Reconstruction of an element of the matrix
+                ROTX(Q)=ROTMAT(1,1,Q)*(REAL(XPOS)-XCENTER)
+     >                 +ROTMAT(1,2,Q)*(REAL(YPOS)-YCENTER)+XCENTER
+                ROTY(Q)=ROTMAT(2,1,Q)*(REAL(XPOS)-XCENTER)
+     >                 +ROTMAT(2,2,Q)*(REAL(YPOS)-YCENTER)+YCENTER
+                WRITE(RECONS(Q),'(A1,I2.2)') HHX(INT(ROTX(Q))),
+     >                                       IHY(INT(ROTY(Q)))
+              ELSE
+                RECONS(Q)=TEXT4
+              ENDIF
+*             Coordinates of the assembly to be filled with
+*             reconstructed information
+              IROT(Q)=ROTMAT(1,1,Q)*(REAL(I)-XCENTER)
+     >               +ROTMAT(1,2,Q)*(REAL(J)-YCENTER)+XCENTER
+              JROT(Q)=ROTMAT(2,1,Q)*(REAL(I)-XCENTER)
+     >               +ROTMAT(2,2,Q)*(REAL(J)-YCENTER)+YCENTER
+            ENDDO
+*         
+            IF((J.EQ.LYMIN).AND.(MOD(LX,2).EQ.1)) THEN
+              IF(RECONS(3).NE.CYCLE(INT(IROT(3)),INT(JROT(3)))) THEN
+                WRITE(6,10)
+                WRITE(6,20) HHX(I),IHY(J),CYCLE(I,J),RECONS(3),
+     >          HHX(INT(IROT(3))),IHY(INT(JROT(3))),
+     >          CYCLE(INT(IROT(3)),INT(JROT(3)))
+                CALL XABORT('@SIMQMP: CHECK FOR AN ERROR IN THE QUARTE'
+     >          //'R-MAP RELOADING PATTERN OR SWITCH TO MAP KEYWORD.')
+              ENDIF
+            ENDIF
+*         
+            DO Q=1,3
+              CYCLE(INT(IROT(Q)),INT(JROT(Q)))=RECONS(Q)
+            ENDDO
+          ENDIF
+        ENDDO
+      ENDDO
+      RETURN
+*
+  10  FORMAT('@SIMQMP: INCONSISTENCY IN REDUNDANT DATA. THE ',
+     > 'QUARTER-MAP RELOADING PATTERN IS NOT QUARTER-SYMETRIC.')
+  20  FORMAT('CONTENT OF ',A1,I2.2,' (',A4,') IS SUPPOSED TO LEAD TO "'
+     > ,A4,'" IN ',A1,I2.2,', BUT "',A4,'" HAS BEEN SPECIFIED ',
+     > 'INSTEAD.')
+      END
diff --git a/Donjon/src/SIMSET.f b/Donjon/src/SIMSET.f
new file mode 100644
index 0000000..2ed6bec
--- /dev/null
+++ b/Donjon/src/SIMSET.f
@@ -0,0 +1,69 @@
+*DECK SIMSET
+      SUBROUTINE SIMSET(NCH,NB,HCYC,NASMB1,ASMB1,BURN,IFUEL,ZONE,NAME,
+     > BURNUP,FMIX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Set the burnup and fuel type of a group of assemblies at positions
+* ASMB1.
+*
+*Copyright:
+* Copyright (C) 2013 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input/output
+* NCH     number of assemblies or number of quart-of-assemblies.
+* NB      number of axial burnup subdivisions in an assembly.
+* HCYC    name of cycle.
+* NASMB1  number of assemblies to set.
+* ASMB1   group of assembly names, as defined in the fuel map, to set
+*         at specific burnup or fuel type.
+* BURN    burnup in MW-day/tonne. Burnup must be set if .ne.-999.0.
+* IFUEL   fuel type. Fuel type must be set if .ne.0.
+* ZONE    default assembly or quart-of-assembly names as defined in
+*         the fuel map.
+* NAME    names of each assembly or of each quart-of assembly during
+*         a refuelling cycle. All quart-of-assembly belonging to the
+*         same assembly have the same name.
+* BURNUP  burnups during a refuelling cycle. A value of -999.0 means
+*         a non-initialized value.
+* FMIX    assembly types after refuelling.
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER NCH,NB,NASMB1,FMIX(NCH,NB)
+      CHARACTER HCYC*12,ZONE(NCH)*4,ASMB1(NASMB1)*4,NAME(NCH)*12
+      REAL BURN,BURNUP(NCH,NB)
+*----
+*  LOCAL VARIABLES
+*----
+      CHARACTER HSMG*131
+*
+      DO IASMB1=1,NASMB1
+        DO ICH=1,NCH
+          IF(ASMB1(IASMB1).EQ.ZONE(ICH)) THEN
+            DO IB=1,NB
+              IF(BURN.NE.-999.0) THEN
+                IF(BURNUP(ICH,IB).NE.-999.0) THEN
+                  WRITE(HSMG,'(36H@SIMSET: BURNUP ALREADY DEFINED IN C,
+     >            6HHANNEL,I4,10HAND BUNDLE,I4,10H AT CYCLE ,A12,1H.)')
+     >            ICH,IB,HCYC
+                ENDIF
+                BURNUP(ICH,IB)=BURN
+              ENDIF
+              IF(IFUEL.NE.0) THEN
+                FMIX(ICH,IB)=IFUEL
+              ENDIF
+            ENDDO
+            NAME(ICH)=ASMB1(IASMB1)(:3)//HCYC(:9)
+          ENDIF
+        ENDDO
+      ENDDO
+      RETURN
+      END
diff --git a/Donjon/src/T16CPO.f b/Donjon/src/T16CPO.f
new file mode 100644
index 0000000..58fedc5
--- /dev/null
+++ b/Donjon/src/T16CPO.f
@@ -0,0 +1,320 @@
+*DECK T16CPO
+      SUBROUTINE T16CPO(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*----
+*
+*Purpose:
+*  Transfer a WIMS-AECL 3.1 tape16 file to a Donjon/Dragon CPO data
+*  structure.
+*
+*Author(s): 
+* G. Marleau
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The T16CPO: module specifications  are:
+*   DONCPO :=  T16CPO: [ DONCPO ] WIMS16 :: (desct16cpo)  ; 
+* where
+*   DONCPO       : name of data structure where the output COP is 
+*                  stored. This can be a new data structure or an old 
+*                  data structure that will be updated. 
+*   (desct16cpo] : input specifications for the execution
+*                  of the T16CPO: module.  
+*
+*----
+*
+      USE GANLIB
+      IMPLICIT         NONE
+      INTEGER          NENTRY
+      CHARACTER        HENTRY(NENTRY)*12
+      INTEGER          IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)      KENTRY(NENTRY)
+*----
+*  MEMORY ALLOCATION
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IFGCND,IFGMTR,IFGEDI,
+     >                                      NAMMIX,MIXRCI,MIXPER,MIXREG
+      REAL, ALLOCATABLE, DIMENSION(:) :: ENET16,ENECPO,VELMTR,
+     >                                   PARRCI,PARPER
+*----
+*  READ VARIABLES
+*----
+      CHARACTER        TEXT12*12
+      INTEGER          ITYPE,NITMA
+      REAL             FLOTT
+      DOUBLE PRECISION DFLOTT
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER          IFT16,IOUT,NSTATE,MXGRP,MNLOCP,MNCPLP,MNPERT
+      CHARACTER        NAMSBR*6,NAMVER*12,NAMDAT*12,NAMMOD*12
+      PARAMETER       (IOUT=6,NSTATE=40,MXGRP=89,MNLOCP=11,
+     >                 MNCPLP=1,MNPERT=10,NAMSBR='T16CPO',
+     >                 NAMVER='VERSION 2.0 ',NAMDAT='2012/07/09  ',
+     >                 NAMMOD='T16CPO:     ')
+      CHARACTER        TEXT4*4,HSIGN*12,TITLE*72,SUBTIT*240
+      INTEGER          ISTATE(NSTATE),
+     >                 MAXMIX,MNBURN,
+     >                 ITEXT4,ITCPO,NCMIXS,
+     >                 IPRINT,ILIST,IMIXT,NMIXT,NEL,NG,NGMTR,
+     >                 NMATZ,MTRMSH,NZONE,NGREAC,
+     >                 NRCELA,NRREGI,NGCOND,NGCCPO,IGC,ILASTG
+      TYPE(C_PTR)      IPCPO
+*----
+*  DATA
+*----
+      CHARACTER        NALOCP(MNLOCP+MNCPLP)*4
+      INTEGER          IDLCPL(2,MNLOCP+MNCPLP)
+      SAVE             NALOCP,IDLCPL
+      DATA             NALOCP /'FT  ','MT  ','MD  ','MP  ',
+     >                         'MB  ','CT  ','CD  ','CP  ',
+     >                         'RT  ','RD  ','RP  ','MTMD'/
+      DATA             IDLCPL /  1, 0,  2, 0,  3, 0,  4, 0,
+     >                           5, 0,  6, 0,  7, 0,  8, 0,
+     >                           9, 0, 10, 0, 11, 0,  2, 3/
+*----
+*  PRINT CREDITS
+*----
+      WRITE(IOUT,6900) NAMMOD
+      WRITE(IOUT,6910)
+*----
+*  SET TITLE
+*----
+      TEXT4='    '
+      READ(TEXT4,'(A4)') ITEXT4
+      TITLE=' '
+      TITLE(1:6)=NAMSBR
+      TITLE(9:20)=NAMVER
+      TITLE(21:32)=NAMDAT
+*----
+*  ALLOCATE MEMORY FOR ENERGY
+*----
+      ALLOCATE(IFGCND(MXGRP),IFGMTR(MXGRP),IFGEDI(MXGRP))
+      ALLOCATE(ENET16(MXGRP+1),ENECPO(MXGRP+1),VELMTR(MXGRP))
+*----
+*  NUMBER OF DATA STRUCTURES
+*----
+      IF(NENTRY .LT. 2) THEN
+        CALL XABORT(NAMSBR//
+     >  ': AT LEAST TWO DATA STRUCTURES EXPECTED.')
+      ENDIF
+*----
+*  FIRST DATA STRUCTURE IS CPO
+*----
+      IF(IENTRY(1) .NE. 1 .AND. IENTRY(1) .NE. 2 ) THEN
+        CALL XABORT(NAMSBR//
+     >  ': LINKED LIST OR XSM FILE EXPECTED FOR CPO.')
+      ENDIF
+      IPCPO=KENTRY(1)
+      ITCPO=0
+      IF(JENTRY(1) .EQ. 0) THEN
+*----
+* New CPO
+*----
+        HSIGN='L_COMPO'
+        CALL LCMPTC(IPCPO,'SIGNATURE',12,HSIGN)
+        ISTATE(:NSTATE)=0
+        ISTATE(3)=1
+        ISTATE(4)=2
+        ISTATE(6)=1
+        ISTATE(7)=MNLOCP+MNCPLP
+        ISTATE(8)=MNLOCP
+        ISTATE(9)=72
+      ELSE IF(JENTRY(1) .EQ. 1) THEN
+*----
+* Update CPO
+*----
+        CALL LCMGTC(IPCPO,'SIGNATURE',12,HSIGN)
+        IF(HSIGN .NE. 'L_COMPO') THEN
+          CALL XABORT(NAMSBR//': SIGNATURE OF '//HENTRY(1)//
+     >      ' IS '//HSIGN//'. L_COMPO EXPECTED.')
+        ENDIF
+        CALL LCMGET(IPCPO,'STATE-VECTOR',ISTATE)
+        IF(ISTATE(3) .NE. 1) CALL XABORT(NAMSBR//
+     >  ': INVALID NUMBER OF ISOTOPES ON UPDATE CPO')
+        IF(ISTATE(4) .NE. 2) CALL XABORT(NAMSBR//
+     >  ': INVALID SCATTERING ANISOTROPY ON UPDATE CPO')
+        IF(ISTATE(5) .LE. 1) CALL XABORT(NAMSBR//
+     >  ': INVALID NUMBER OF BURNUP STEP ON UPDATE CPO')
+        IF(ISTATE(6) .NE. 1) CALL XABORT(NAMSBR//
+     >  ': UPDATE CPO DOES NOT MATCH TAPE16 FORMAT')
+        IF(ISTATE(7) .NE. MNLOCP+MNCPLP) CALL XABORT(NAMSBR//
+     >  ': INVALID NUMBER OF PERTURBATION TYPES ON UPDATE CPO')
+        IF(ISTATE(8) .NE. MNLOCP) CALL XABORT(NAMSBR//
+     >  ': INVALID NUMBER OF LOCAL PARAMETERS ON UPDATE CPO')
+        IF(ISTATE(9) .NE. 72 ) CALL XABORT(NAMSBR//
+     >  ': INVALID LENGTH OF SUBTITLE ON UPDATE CPO')
+        ITCPO=1
+        IF(ISTATE(2) .GT. 0) THEN
+          CALL LCMGET(IPCPO,'T16CPOENERGY',ENECPO)
+        ENDIF
+      ELSE
+*----
+* Read-only CPO
+*----
+        CALL XABORT(NAMSBR//': READONLY MODE FOR '//HENTRY(1)//
+     >      ' IS ILLEGAL.')
+      ENDIF
+      NCMIXS=ISTATE(1)
+      NGCCPO=ISTATE(2)
+*----
+*  SECOND DATA STRUCTURE IS TAPE16 FILE
+*----
+      IF(IENTRY(2) .NE. 3) THEN
+        CALL XABORT(NAMSBR//
+     >  ': SEQUENTIAL BINARY FILE EXPECTED FOR TAPE16.')
+      ENDIF
+      IF(JENTRY(2) .NE. 2) THEN
+        CALL XABORT(NAMSBR//': READONLY MODE FOR '//HENTRY(2)//
+     >      ' IS REQUIRED.')
+      ENDIF
+      IFT16=FILUNIT(KENTRY(2))
+*----
+*  INITIALIZE DEFAULT INPUT OPTIONS
+*  AND READ DATA UNTIL KEYWORD MIX IS REACHED
+*----
+      IPRINT=1
+      ILIST=0
+      IMIXT=0
+      NMIXT=1
+      NGCOND=0
+ 100  CONTINUE
+      CALL REDGET(ITYPE,NITMA,FLOTT,TEXT12,DFLOTT)
+      IF(ITYPE.NE.3) CALL XABORT(NAMSBR//
+     >  ' KEYWORD EXPECTED')
+      IF(TEXT12.EQ.';') THEN
+        GO TO 105
+      ELSE IF(TEXT12.EQ.'EDIT') THEN      
+        CALL REDGET(ITYPE,IPRINT,FLOTT,TEXT12,DFLOTT)
+        IF(ITYPE.NE.1) CALL XABORT(NAMSBR//
+     >    ': EDIT LEVEL EXPECTED')
+      ELSE IF(TEXT12.EQ.'NMIX') THEN
+        CALL REDGET(ITYPE,NMIXT,FLOTT,TEXT12,DFLOTT)
+        IF(ITYPE.NE.1) CALL XABORT(NAMSBR//
+     >    ': NUMBER OF MIXTURE EXPECTED')
+      ELSE IF(TEXT12.EQ.'CONDG') THEN
+        CALL REDGET(ITYPE,NGCOND,FLOTT,TEXT12,DFLOTT)
+        IF(ITYPE.NE.1) CALL XABORT(NAMSBR//
+     >    ': NUMBER OF CONDENSATION GROUP EXPECTED')
+        ILASTG=0
+        DO 101 IGC=1,NGCOND
+          CALL REDGET(ITYPE,NITMA,FLOTT,TEXT12,DFLOTT)
+          IF(ITYPE.NE.1) CALL XABORT(NAMSBR//
+     >      ': GROUP NUMBER REQUIRED')
+          IF( NITMA .GT. MXGRP .OR. NITMA .LT. ILASTG) THEN
+            CALL XABORT(NAMSBR//
+     >      ': INVALID GROUP SEQUENCE PROVIDED')
+          ENDIF
+          IFGCND(IGC)=NITMA
+ 101    CONTINUE
+      ELSE IF(TEXT12.EQ.'LIST') THEN
+        ILIST=1
+      ELSE IF(TEXT12.EQ.'MIX') THEN
+        IMIXT=1
+        GO TO 105
+      ENDIF
+      GO TO 100
+105   CONTINUE
+      IF(ILIST .EQ. 1) THEN
+        CALL T16LST(IFT16)
+      ENDIF
+*----
+*  SCAN T16 FOR DIMENSIONING DATA
+*----
+      CALL T16DIM(IFT16 ,IPRINT,MXGRP ,SUBTIT,NEL   ,NG    ,
+     >            NGMTR ,NMATZ ,MTRMSH,NZONE ,NGREAC,NRCELA,
+     >            NRREGI,IFGMTR,IFGEDI)
+*----
+*  ANALYZE CONDENSED GROUP STRUCTURE
+*----
+      CALL T16ENE(IPRINT,MXGRP ,NG    ,NGCOND,NGMTR ,NGREAC,
+     >            NGCCPO,IFGCND,IFGMTR,IFGEDI,ENECPO,ENET16,
+     >            VELMTR)
+      MNBURN=ISTATE(5)
+*----
+*  DEFINE DIMENSIONS ADEQUATELY, ALLOCATE MEMORY AND
+*  INITIALIZE
+*----
+      MAXMIX=NCMIXS+NMIXT
+      ALLOCATE(NAMMIX(2*MAXMIX),MIXRCI((2+MNLOCP+MNCPLP)*MAXMIX),
+     > MIXPER(MNPERT*(MNLOCP+MNCPLP)*MAXMIX),MIXREG(MAXMIX))
+      ALLOCATE(PARRCI(MNLOCP*MAXMIX),
+     > PARPER(MNPERT*2*(MNLOCP+MNCPLP)*MAXMIX))
+      NAMMIX(:2*MAXMIX)=ITEXT4
+      MIXRCI(:(2+MNLOCP+MNCPLP)*MAXMIX)=0
+      MIXPER(:MNPERT*(MNLOCP+MNCPLP)*MAXMIX)=0
+      MIXREG(:MAXMIX)=0
+      PARRCI(:MNLOCP*MAXMIX)=0.0
+      PARPER(:MNPERT*2*(MNLOCP+MNCPLP)*MAXMIX)=0.0
+*----
+*  INITIALIZE DEFAULT VALUES FOR ABOVE MIXTURE PARAMETERS
+*  VECTORS
+*----
+      IF(ITCPO .EQ. 1) THEN
+        CALL T16MPI(IPCPO ,IPRINT,MAXMIX,MNLOCP,MNCPLP,MNPERT,
+     >              NALOCP,IDLCPL,NCMIXS,NGCCPO,ENECPO,NAMMIX,
+     >              MIXRCI,PARRCI,PARPER)
+      ENDIF
+*----
+*  MODIFIFY VALUES FOR ABOVE VECTORS AS SPECIFIED ON INPUT FILE
+*----
+      IF(IMIXT .EQ. 1) THEN
+        CALL T16GET(MAXMIX,MNLOCP,MNCPLP,MNPERT,NALOCP,IDLCPL,
+     >              NCMIXS,MNBURN,NAMMIX,MIXRCI,PARRCI,MIXPER,
+     >              PARPER,MIXREG)
+*----
+*  SAVE MODIFIED VALUES FOR ABOVE MIXTURE PARAMETERS
+*  VECTORS
+*----
+        CALL T16MPS(IPCPO ,IPRINT,MAXMIX,MNLOCP,MNCPLP,MNPERT,
+     >              NALOCP,IDLCPL,NCMIXS,NGCCPO,TITLE ,SUBTIT ,
+     >              ENECPO,NAMMIX,MIXRCI,PARRCI,PARPER)
+      ENDIF
+      DEALLOCATE(PARPER,PARRCI)
+*----
+*  SAVE UPDATED STATE-VECTOR
+*----
+      ISTATE(1)=NCMIXS
+      ISTATE(2)=NGCCPO
+      ISTATE(5)=MNBURN
+      CALL LCMPUT(IPCPO,'T16CPOENERGY',NGCCPO+1,2,ENECPO)
+      CALL LCMPUT(IPCPO,'STATE-VECTOR',NSTATE,1,ISTATE)
+*----
+*  CALL MAIN T16 CROSS SECTION DRIVER
+*----
+      CALL T16DRV(IPCPO ,IFT16 ,IPRINT,MNLOCP,MNCPLP,MNPERT,
+     >            NALOCP,NCMIXS,NGCCPO,MNBURN,NG    ,NGMTR ,
+     >            NMATZ ,MTRMSH,NZONE ,IFGMTR,VELMTR,NAMMIX,
+     >            MIXRCI,MIXPER,MIXREG)
+*----
+*  RELEASE MEMORY
+*----
+      DEALLOCATE(MIXREG,MIXPER,MIXRCI,NAMMIX)
+      DEALLOCATE(VELMTR,ENECPO,ENET16)
+      DEALLOCATE(IFGEDI,IFGMTR,IFGCND)
+      WRITE(IOUT,6901) NAMMOD
+      RETURN
+*----
+*  PRINT FORMAT
+*----
+ 6900 FORMAT('->@BEGIN MODULE : ',A12)
+ 6901 FORMAT('->@END MODULE   : ',A12)
+ 6910 FORMAT('->@DESCRIPTION  : CONVERT WIMS-TAPE16 TO DRAGON-CPO'/
+     >       '->@CREDITS      : G. MARLEAU'/
+     >       '->@COPYRIGHTS   : ECOLE POLYTECHNIQUE DE MONTREAL'/
+     >       '                  ATOMIC ENERGY OF CANADA LIMITED')
+      
+      END
diff --git a/Donjon/src/T16DIM.f b/Donjon/src/T16DIM.f
new file mode 100644
index 0000000..f206b5e
--- /dev/null
+++ b/Donjon/src/T16DIM.f
@@ -0,0 +1,326 @@
+*DECK T16DIM
+      SUBROUTINE T16DIM(IFT16 ,IPRINT,MXGRP ,SUBTIT,NEL   ,NG    ,
+     >                  NGMTR ,NMATZ ,MTRMSH,NZONE ,NGREAC,NRCELA,
+     >                  NRREGI,IFGMTR,IFGEDI)
+*
+*----
+*
+*Purpose:
+*  Scan WIMS-AECL tape16 file for general dimensioning information.
+*
+*Author(s):
+* G. Marleau
+*
+*Parameters: input
+* IFT16   tape16 file unit.
+* IPRINT  print level where:
+*         =0 for no print; >=  1 print record to read;
+*         >= 10 print all record read.
+* MXGRP   maximum number or groups.
+*
+*Parameters: output
+* SUBTIT  subtitle.
+* NEL     number of isotopes on X-S library.
+* NG      number of groups on X-S library.
+* NGMTR   number of main transport groups.
+* NMATZ   number of mixtures.
+* MTRMSH  number of main transport mesh points.
+* NZONE   number of zones.
+* NGREAC  number of edit groups.
+* NRCELA  number of CELLAV sets of records.
+* NRREGI  number of REGION sets of records.
+* IFGMTR  fewgroups for main transport.
+* IFGEDI  fewgroups for edit.
+*
+*----
+*
+      IMPLICIT         NONE
+      INTEGER          IFT16,IPRINT,MXGRP,NEL,NG,
+     >                 NGMTR,NMATZ,MTRMSH,NZONE,
+     >                 NGREAC,NRCELA,NRREGI
+      INTEGER          IFGMTR(MXGRP),IFGEDI(MXGRP)
+      CHARACTER        SUBTIT*240
+*----
+*  T16 KEYS
+*----
+      CHARACTER        CWVER*80,CLIBN*16,CASETL*128,
+     >                 TKEY1*10,TKEY2*10,RKEY1*10,RKEY2*10,
+     >                 WLEAK*10, WDIFF*10,WEDIT*10,BLANK*2
+      INTEGER          NKEY,IOPT,NBE,NID,NJD,IR,JR
+      REAL             RID
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER          IOUT,NFPR,NREGON,NM
+      CHARACTER        NAMSBR*6
+      PARAMETER       (IOUT=6,NAMSBR='T16DIM')
+*----
+*  READ GENERAL TAPE16 INFORMATION
+*----
+      IOPT=0
+      NKEY=1
+      SUBTIT=' '
+      REWIND(IFT16)
+*----
+*  1) WIMS-AECL VERSION
+*----
+      TKEY1='PROCESSING'
+      TKEY2='PROCESSING'
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1  ,TKEY2  ,
+     >            NBE   )
+      IF(NBE .GT. 0) THEN
+        READ(IFT16) RKEY1,RKEY2,NBE,CWVER
+      ELSE
+        CALL XABORT(NAMSBR//': KEYS '//TKEY1//','//
+     >              TKEY2//' NOT FOUND ON TAPE16')
+      ENDIF
+      SUBTIT(1:80)=CWVER
+*----
+*  2) LIBRARY NAME
+*----
+      TKEY1='PROCESSING'
+      TKEY2='NDASTITLE '
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1  ,TKEY2  ,
+     >            NBE   )
+      IF(NBE .GT. 0) THEN
+        READ(IFT16) RKEY1,RKEY2,NBE, CLIBN
+      ELSE
+        CALL XABORT(NAMSBR//': KEYS '//TKEY1//','//
+     >              TKEY2//' NOT FOUND ON TAPE16')
+      ENDIF
+      SUBTIT(81:104)=' ------ '//CLIBN
+*----
+*  3) CASE TITLE
+*----
+      TKEY1='TITLE     '
+      TKEY2='CARD      '
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1  ,TKEY2  ,
+     >            NBE   )
+      IF(NBE .GT. 0) THEN
+        READ(IFT16) RKEY1,RKEY2,NBE,CASETL
+      ELSE
+        CALL XABORT(NAMSBR//': KEYS '//TKEY1//','//
+     >              TKEY2//' NOT FOUND ON TAPE16')
+      ENDIF
+      SUBTIT(105:240)=' ------ '//CASETL
+*----
+*  4) WIMS CONSTANTS
+*----
+      TKEY1='WIMS      '
+      TKEY2='CONSTANTS '
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1  ,TKEY2  ,
+     >            NBE   )
+      IF(NBE .GT. 0) THEN
+        READ(IFT16) RKEY1,RKEY2,NBE,NEL,NG,(NID,IR=1,8),NGMTR,
+     >              (NID,IR=1,6),NMATZ,NM
+      ELSE
+        CALL XABORT(NAMSBR//': KEYS '//TKEY1//','//
+     >              TKEY2//' NOT FOUND ON TAPE16')
+      ENDIF
+*----
+*  5) MAIN TRANSPORT GROUPS
+*----
+      TKEY1='MTR       '
+      TKEY2='FEWGROUPS '
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1  ,TKEY2  ,
+     >            NBE   )
+      IF(NBE .GT. 0) THEN
+        READ(IFT16) RKEY1,RKEY2,NBE,(IFGMTR(IR),IR=1,NGMTR)
+      ELSE
+        CALL XABORT(NAMSBR//': KEYS '//TKEY1//','//
+     >              TKEY2//' NOT FOUND ON TAPE16')
+      ENDIF
+*----
+*  6) DIMENSION OF TRANSPORT MESH
+*     PRESENT ONLY IF MTRFLX KEY ACTIVATED
+*----
+      TKEY1='MTRFLX    '
+      TKEY2='FLUX      '
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1  ,TKEY2  ,
+     >            NBE   )
+      IF(NBE .GT. 0) THEN
+        READ(IFT16) RKEY1,RKEY2,NBE,NID,MTRMSH
+      ELSE
+        REWIND(IFT16)
+        MTRMSH=0
+        IF(IPRINT .GE. 10)
+     >  WRITE(IOUT,8000) NAMSBR,TKEY1,TKEY2,'MTRMSH',MTRMSH
+      ENDIF
+*----
+*  7) NUMBER OF FUEL PIN RINGS
+*     PRESENT ONLY FOR BURNUP CASES WITH CLUSTER GEOMETRY
+*----
+*----- A.ZH. THIS RECORD CAN HAVE A DIFFERENT INTERPRETATION-----
+      TKEY1='CELLAV    '
+      TKEY2='PINBURNUP '
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1  ,TKEY2  ,
+     >            NBE   )
+      IF(NBE .GT. 0) THEN
+        READ(IFT16) RKEY1,RKEY2,NBE
+        NFPR=(NBE-1)/3
+      ELSE
+        REWIND(IFT16)
+        NFPR=0
+        IF(IPRINT .GE. 10)
+     >  WRITE(IOUT,8000) NAMSBR,TKEY1,TKEY2,'NFPR  ',NFPR
+      ENDIF   
+*----
+*  8) NUMBER OF ZONES
+*----     
+      REWIND(IFT16) 
+      TKEY1='REGION    '
+      TKEY2='DESCRIPTON'
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1  ,TKEY2  ,
+     >            NBE   )      
+      IF(NBE .GT. 0) THEN       
+        READ(IFT16) RKEY1,RKEY2,NBE,NZONE
+      ELSE       
+        CALL XABORT(NAMSBR//': KEYS '//TKEY1//','//
+     >              TKEY2//' NOT FOUND ON TAPE16')
+      ENDIF      
+*----
+*  9) NUMBER OF EDIT REGIONS
+*----
+      TKEY1='REGION    '
+      TKEY2='DIMENSIONS'
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1  ,TKEY2  ,
+     >            NBE   )
+      IF(NBE .GT. 0) THEN
+        READ(IFT16) RKEY1,RKEY2,NBE,NREGON
+      ELSE
+        CALL XABORT(NAMSBR//': KEYS '//TKEY1//','//
+     >              TKEY2//' NOT FOUND ON TAPE16')
+      ENDIF
+*----
+* 10) NUMBER OF EDIT GROUPS
+*     PRESENT ONLY IF REACTION KEY ACTIVATED
+*----
+      TKEY1='REACTION  '
+      TKEY2='FLUX      '
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1  ,TKEY2  ,
+     >            NBE   )
+      IF(NBE .GT. 0) THEN
+         READ(IFT16) RKEY1,RKEY2,NBE,WLEAK,WDIFF,WEDIT,BLANK,
+     >               (NID,IR=1,2),NGREAC,
+     >               ((RID,IR=1,NZONE),JR=1,NG),
+     >               (IFGEDI(IR),IR=1,NGREAC)
+      ELSE
+        NGREAC=0
+        IF(IPRINT .GE. 10)
+     >  WRITE(IOUT,8000) NAMSBR,TKEY1,TKEY2,'NGREAC',NGREAC
+      ENDIF
+*----
+*  FIND THE NUMBER OF SETS OF CELLAV RECORDS
+*  BASED ON THE PRESENCE OF CELLAV,NGROUP KEYS
+*  ALSO TEST FOR NGMTR CONSISTENCY
+*----  
+      REWIND(IFT16)
+      NRCELA=0
+      TKEY1='CELLAV    '
+      TKEY2='NGROUPS   '
+ 100  CONTINUE
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1  ,TKEY2  ,
+     >            NBE   )
+      IF(NBE .EQ. 1) THEN
+        NRCELA=NRCELA+1
+        READ(IFT16) RKEY1,RKEY2,NBE,NID
+        IF(NID .NE. NGMTR) THEN
+          WRITE(IOUT,9000) NAMSBR,NGMTR,NRCELA,NID
+          CALL XABORT(NAMSBR//': INVALID CELLAV STRUCTURE')
+        ENDIF
+        GO TO 100
+      ELSE IF(NBE .EQ. -1) THEN
+        GO TO 105
+      ELSE
+        WRITE(IOUT,9001) NAMSBR,1,NBE
+        CALL XABORT(NAMSBR//': INVALID CELLAV STRUCTURE')
+      ENDIF
+ 105  CONTINUE
+*----
+*  FIND THE NUMBER OF SETS OF REGION RECORD NRREGI
+*  BASED ON THE PRESENCE OF REGION,DESCRIPTON KEYS
+*  ALSO TEST FOR NZONE, NGMTR AND NREGON CONSISTENCY
+*----
+      REWIND(IFT16)
+      NRREGI=0
+      TKEY1='REGION    '
+      TKEY2='DESCRIPTON'
+ 110  CONTINUE
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1  ,TKEY2  ,
+     >            NBE   )
+      IF(NBE .GT. 0) THEN
+        NRREGI=NRREGI+1
+        READ(IFT16) RKEY1,RKEY2,NBE,NID
+        IF(NID .NE. NZONE ) THEN
+          WRITE(IOUT,9010) NAMSBR,NZONE,NRREGI,NID
+          CALL XABORT(NAMSBR//': INVALID REGION STRUCTURE')
+        ENDIF
+        READ(IFT16) RKEY1,RKEY2,NBE,NID,NJD
+        IF(NID .NE. NREGON ) THEN
+          WRITE(IOUT,9010) NAMSBR,NREGON,NRREGI,NID
+          CALL XABORT(NAMSBR//': INVALID REGION STRUCTURE')
+        ENDIF
+        IF(NJD .NE. NGMTR ) THEN
+          WRITE(IOUT,9010) NAMSBR,NGMTR,NRREGI,NJD
+          CALL XABORT(NAMSBR//': INVALID REGION STRUCTURE')
+        ENDIF
+        GO TO 110
+      ELSE
+        GO TO 115
+      ENDIF
+ 115  CONTINUE
+*----
+*  PROCESS PRINT LEVEL
+*----
+      IF(IPRINT .GE. 10) THEN
+        WRITE(IOUT,6000) NAMSBR,
+     >  SUBTIT(113:240),SUBTIT(1:80),SUBTIT(89:104)
+        WRITE(IOUT,6010) NEL,NG,NGMTR,NMATZ,NM,MTRMSH,
+     >                   NFPR,NZONE,NREGON,NGREAC,NRCELA,NRREGI
+        WRITE(IOUT,6001)
+      ENDIF
+      RETURN
+*----
+*  PRINT FORMAT
+*----
+ 6000 FORMAT(1X,5('*'),' OUTPUT FROM ',A6,1X,5('*')/
+     >       6X,'CONTENTS OF TAPE16 FILE :'/A128/
+     >       6X,'WIMS-AECL VERSION = ',A80/
+     >       6X,'LIBRARY VERSION   = ',A16)
+ 6001 FORMAT(1X,30('*'))
+ 6010 FORMAT(6X,'DIMENSIONING DATA '/
+     >       6X,'NEL    : NB. ISOTOPES             = ',I10/
+     >       6X,'NG     : NB. GROUPS               = ',I10/
+     >       6X,'NGMTR  : NB. MAIN TRANSPORT GROUP = ',I10/
+     >       6X,'NMATZ  : NB. MIXTURES             = ',I10/
+     >       6X,'NM     : NB. BURNABLE MATERIALS   = ',I10/
+     >       6X,'MTRMSH : NB. TRANSPORT MESH POINTS= ',I10/
+     >       6X,'NFPR   : NB. FUEL PIN RINGS       = ',I10/
+     >       6X,'NZONE  : NB. ZONES                = ',I10/
+     >       6X,'NREGON : NB. EDIT REGIONS         = ',I10/
+     >       6X,'NGREAC : NB. EDIT GROUPS          = ',I10/
+     >       6X,'NRCELA : NB. CELLAV  RECORDS      = ',I10/
+     >       6X,'NRREGI : NB. REGION  RECORDS      = ',I10)
+*----
+*  WARNING FORMAT
+*----
+ 8000 FORMAT(1X,A6,1X,6('*'),' WARNING ',6('*')/
+     >       8X,'RECORD WITH KEYS ',2(A10,2X),'NOT FOUND'/
+     >       8X,'USE DEFAULT VALUE FOR ',A6,' = ',I10/
+     >       8X,21('*'))
+*----
+*  ABORT FORMAT
+*----
+ 9000 FORMAT(1X,A6,1X,7('*'),' ERROR ',7('*')/
+     >       8X,6X,' NUMBER OF MAIN TRANSPORT GROUP ',I10/
+     >       8X,I6,' CELLAV NGROUPS RECORD GIVES    ',I10/
+     >       8X,21('*'))
+ 9001 FORMAT(1X,A6,1X,7('*'),' ERROR ',7('*')/
+     >       8X,' NB ELEMENT ALLOWED ON CELLAV NGROUPS  ',I10/
+     >       8X,' NB ELEMENT READ ON CELLAV NGROUPS      ',I10/
+     >       8X,21('*'))
+ 9010 FORMAT(1X,A6,1X,7('*'),' ERROR ',7('*')/
+     >       8X,6X,' NUMBER OF ZONES     ',I10/
+     >       8X,I6,' REGION RECORD ',I10,' GIVES ',I10/
+     >       8X,21('*'))
+      END
diff --git a/Donjon/src/T16DRV.f b/Donjon/src/T16DRV.f
new file mode 100644
index 0000000..c9ff36f
--- /dev/null
+++ b/Donjon/src/T16DRV.f
@@ -0,0 +1,230 @@
+*DECK T16DRV
+      SUBROUTINE T16DRV(IPCPO ,IFT16 ,IPRINT,MNLOCP,MNCPLP,MNPERT,
+     >                  NALOCP,NCMIXS,NGCCPO,MNBURN,NG    ,NGMTR ,
+     >                  NMATZ ,MTRMSH,NZONE ,IFGMTR,VELMTR,NAMMIX,
+     >                  MIXRCI,MIXPER,MIXREG)
+*
+*----
+*
+*Purpose:
+*  Main driver for the transfer of cross sections from tape16 to CPO.
+*
+*Author(s):
+* G. Marleau
+*
+*Parameters: input
+* IPCPO   pointer to CPO data structure.
+* IFT16   tape16 file unit.
+* IPRINT  print level where:
+*         =0 for no print; >=  1 print processing option.
+* MNLOCP  maximum number of local parameters.
+* MNCPLP  maximum number of coupled parameters.
+* MNPERT  maximum number of perturbations per local parameter.
+* NALOCP  local parameter names allowed.
+* NCMIXS  number of current mixtures.
+* NGCCPO  number of edit groups.
+* MNBURN  maximum number or burnup steps.
+* NG      number of groups on X-S library.
+* NGMTR   number of main transport groups.
+* NMATZ   number of mixtures.
+* MTRMSH  number of main transport mesh points.
+* NZONE   number of zones.
+* IFGMTR  fewgroups for main transport.
+* VELMTR  velocity for main transport.
+* NAMMIX  names of mixtures.
+* MIXRCI  reference information for mixtures where:
+*         =0 no information for mixture;
+*         >0 information not updated; 
+*         <0 information to be updated. 
+* MIXPER  perturbation information for mixtures.
+*         =0 no information for mixture;
+*         >0 information not updated; 
+*         <0 information to be updated. 
+* MIXREG  mixture update identifier where:
+*          =0 do not update;
+*          =-1 update using CELLAV information;
+*          > 0 update using specified region number.
+*
+*----
+*
+      USE GANLIB
+      IMPLICIT         NONE
+      TYPE(C_PTR)      IPCPO
+      INTEGER          IFT16,IPRINT,MNLOCP,MNCPLP,MNPERT,
+     >                 NCMIXS,NGCCPO,MNBURN,NG,NGMTR,NMATZ,
+     >                 MTRMSH,NZONE
+      CHARACTER        NALOCP(MNLOCP+MNCPLP)*4
+      INTEGER          IFGMTR(NGCCPO),NAMMIX(2,NCMIXS),
+     >                 MIXRCI(2+MNLOCP+MNCPLP,NCMIXS),
+     >                 MIXPER(MNPERT,MNLOCP+MNCPLP,NCMIXS),
+     >                 MIXREG(NCMIXS)
+      REAL             VELMTR(NGMTR)
+*----
+*  MEMORY ALLOCATION
+*----
+      REAL, ALLOCATABLE, DIMENSION(:) :: BURNUP,WNKB
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: KMSPEC,MATMSH,IDRXSM
+      REAL, ALLOCATABLE, DIMENSION(:) :: VQLE,FLXINT,FLXDIS,
+     >                                   OVERV,RECXSV,RECXSM,
+     >                                   RECTMP,RECSCA,ZONVOL,ZONRAD
+*----
+*  T16 PARAMETERS
+*----
+      INTEGER          MAXKEY
+      PARAMETER       (MAXKEY=2)
+      CHARACTER        TKEY1(MAXKEY)*10,TKEY2(MAXKEY)*10,
+     >                 RKEY1*10,RKEY2*10
+      INTEGER          NKEY,IOPT,NBE,IR,ZONNUM
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER          IOUT,ILCMUP,ILCMDN,NVXSR,NMXSR
+      CHARACTER        NAMSBR*6
+      PARAMETER       (IOUT=6,ILCMUP=1,ILCMDN=2,NVXSR=20,NMXSR=2,
+     >                 NAMSBR='T16DRV')
+      CHARACTER        NAMDIR*12
+      INTEGER          IMIX,ILOCP,NBPERP,IPER,NBURN,IBURN,NPERTN,
+     >                 INEXTR,ITYXS(NVXSR+NMXSR),IMIREG,
+     >                 MMXM
+      REAL             VOLUME,B2CRI(3),BRNIRR(3),EFJ
+*----
+*  DATA
+*----
+      CHARACTER        NAMDXS(NVXSR+NMXSR)*12
+      SAVE             NAMDXS
+      DATA             NAMDXS
+     > /'TOTAL       ','TRANC       ','NUSIGF      ','NFTOT       ',
+     >  'CHI         ','NU          ','NG          ','NHEAT       ',
+     >  'N2N         ','N3N         ','N4N         ','NP          ',
+     >  'NA          ','GOLD        ','ABS         ','NWT0        ',
+     >  'STRD        ','STRD X      ','STRD Y      ','STRD Z      ',
+     >  'SIGS 0      ','SIGS 1      '/
+*----
+*  ALLOCATE MEMORY
+*----
+      MMXM=MAX(NZONE,MTRMSH)
+      NPERTN=MNLOCP+MNCPLP
+      ALLOCATE(BURNUP(MNBURN),WNKB(MNBURN))
+      ALLOCATE(KMSPEC(NMATZ),MATMSH(MMXM),IDRXSM(NGCCPO*2))
+      ALLOCATE(VQLE(MMXM),FLXINT(NGCCPO),FLXDIS(NGCCPO),
+     >         OVERV(NGCCPO),RECXSV(NGCCPO*(NVXSR+NMXSR)),
+     >         RECXSM(NGCCPO*NGCCPO*NMXSR),RECTMP(4*NGMTR),
+     >         RECSCA(NGMTR*NGMTR))
+      ALLOCATE(ZONVOL(NZONE),ZONRAD(NZONE))
+*----
+*  FIND MATERIAL SPECTRUM
+*  REQUIRED FOR FLUX DISADVANTAGE FACTOR
+*----     
+      IOPT=1
+      TKEY1(1)='MATERIAL  '
+      TKEY2(1)='SPECTRUM  '
+      NKEY=1
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1 ,TKEY2 ,
+     >            NBE   )
+      IF( NBE .NE. NMATZ ) THEN
+        WRITE(6,'(128A1)') 'PLEASE RE-RUN WIMS-AECL BECAUSE '//
+     > 'T16CPO UTILITY NEEDS A RECORD: '//TKEY1(1)//TKEY1(2)
+        CALL XABORT(NAMSBR//
+     >  ': CANNOT FIND '//TKEY1(1)//' '//TKEY2(1))
+      ELSE
+        READ(IFT16) RKEY1,RKEY2,NBE,(KMSPEC(IR),IR=1,NMATZ)
+      ENDIF
+*----
+*  SCAN OVER MIXTURES
+*----
+      DO IMIX=1,NCMIXS
+*----
+*  MIXTURE TO UPDATE
+*----
+        BRNIRR(:3)=0.0
+        IMIREG=MIXREG(IMIX)
+        WRITE(NAMDIR,'(A4,A2,A6)') 
+     >  NAMMIX(1,IMIX),NAMMIX(2,IMIX),'RC    '
+        NBURN=ABS(MIXRCI(2,IMIX))
+        IF(MIXRCI(2,IMIX) .LT. 0) THEN
+          CALL LCMSIX(IPCPO,NAMDIR,ILCMUP)
+          INEXTR=MIXRCI(1,IMIX)
+          DO IBURN=1,NBURN
+*----
+*  BURNUP STEP TO UPDATE
+*----
+            CALL T16REC(IFT16 ,IPRINT,INEXTR)
+            CALL T16FLX(IFT16 ,IPRINT,NGCCPO,NG    ,NGMTR ,NMATZ ,
+     >                  MMXM  ,MTRMSH,NZONE ,IFGMTR,VELMTR,IMIREG,
+     >                  VOLUME,B2CRI ,FLXINT,FLXDIS,OVERV ,KMSPEC,
+     >                  MATMSH,VQLE  ,ZONNUM, ZONRAD,ZONVOL)
+            IF(IMIREG .GT. 0) THEN
+              CALL T16REC(IFT16 ,IPRINT,INEXTR)
+              CALL T16RRE(IFT16 ,IPRINT,NGCCPO,NGMTR ,IFGMTR,NVXSR ,
+     >                    NMXSR ,IMIREG,VELMTR,B2CRI ,BRNIRR,FLXINT,
+     >                    OVERV ,RECXSV,RECXSM,RECTMP,RECSCA)
+            ELSE
+              CALL T16REC(IFT16 ,IPRINT,INEXTR)
+              CALL T16RCA(IFT16 ,IPRINT,NGCCPO,NGMTR ,IFGMTR,NVXSR ,
+     >                    NMXSR ,B2CRI ,BRNIRR,NZONE ,RECXSV,RECXSM,
+     >                    RECTMP,RECSCA,ZONVOL)
+            ENDIF
+            BURNUP(IBURN)=BRNIRR(1)
+            WNKB(IBURN)=BRNIRR(2)
+            EFJ=BRNIRR(3)
+            CALL T16WDS(IPCPO ,NGCCPO,NVXSR ,NMXSR ,IBURN ,EFJ   ,
+     >                  NAMDXS,ITYXS ,FLXINT,FLXDIS,OVERV ,RECXSV,
+     >                  IDRXSM,RECXSM,RECSCA)
+            INEXTR=INEXTR+1
+          ENDDO
+          CALL LCMPUT(IPCPO ,'BURNUP      ',NBURN,2,BURNUP)
+          CALL LCMPUT(IPCPO ,'N/KB        ',NBURN,2,WNKB)
+          CALL LCMSIX(IPCPO,NAMDIR,ILCMDN)
+        ENDIF
+*----
+*  PERTURBATIONS TO UPDATE
+*----
+        DO ILOCP=1,NPERTN
+          NBPERP=ABS(MIXRCI(2+ILOCP,IMIX))
+          IF(MIXRCI(2+ILOCP,IMIX) .LT. 0) THEN
+            DO IPER=1,NBPERP
+              INEXTR=MIXPER(IPER,ILOCP,IMIX)
+              WRITE(NAMDIR,'(A4,A2,A4,I2)')
+     >        NAMMIX(1,IMIX),NAMMIX(2,IMIX),NALOCP(ILOCP),IPER
+              CALL LCMSIX(IPCPO,NAMDIR,ILCMUP)
+              DO IBURN=1,NBURN
+                 CALL T16REC(IFT16 ,IPRINT,INEXTR)
+                 CALL T16FLX(IFT16 ,IPRINT,NGCCPO,NG    ,NGMTR ,NMATZ ,
+     >                       MMXM  ,MTRMSH,NZONE ,IFGMTR,VELMTR,IMIREG,
+     >                       VOLUME,B2CRI ,FLXINT,FLXDIS,OVERV ,KMSPEC,
+     >                       MATMSH,VQLE  ,ZONNUM, ZONRAD,ZONVOL)
+                IF(IMIREG .GT. 0) THEN
+                  CALL T16REC(IFT16 ,IPRINT,INEXTR)
+                  CALL T16RRE(IFT16 ,IPRINT,NGCCPO,NGMTR ,IFGMTR,NVXSR ,
+     >                        NMXSR ,IMIREG,VELMTR,B2CRI ,BRNIRR,FLXINT,
+     >                        OVERV,RECXSV,RECXSM,RECTMP,RECSCA)
+                ELSE
+                  CALL T16REC(IFT16 ,IPRINT,INEXTR)
+                  CALL T16RCA(IFT16 ,IPRINT,NGCCPO,NGMTR ,IFGMTR,NVXSR ,
+     >                        NMXSR ,B2CRI ,BRNIRR,NZONE ,RECXSV,RECXSM,
+     >                        RECTMP,RECSCA,ZONVOL)
+                ENDIF
+                BURNUP(IBURN)=BRNIRR(1)
+                WNKB(IBURN)=BRNIRR(2)
+                EFJ=BRNIRR(3)
+                CALL T16WDS(IPCPO ,NGCCPO,NVXSR ,NMXSR ,IBURN ,EFJ   ,
+     >                      NAMDXS,ITYXS ,FLXINT,FLXDIS,OVERV ,RECXSV,
+     >                      IDRXSM,RECXSM,RECSCA)
+                INEXTR=INEXTR+1
+              ENDDO
+              CALL LCMPUT(IPCPO ,'BURNUP      ',NBURN,2,BURNUP)
+              CALL LCMPUT(IPCPO ,'N/KB        ',NBURN,2,WNKB)
+              CALL LCMSIX(IPCPO,NAMDIR,ILCMDN)
+            ENDDO
+          ENDIF
+        ENDDO
+      ENDDO
+*----
+*  RELEASE MEMORY
+*----
+      DEALLOCATE(ZONRAD,ZONVOL)
+      DEALLOCATE(RECSCA,RECTMP,RECXSM,RECXSV,OVERV,FLXDIS,FLXINT,VQLE)
+      DEALLOCATE(IDRXSM,MATMSH,KMSPEC)
+      DEALLOCATE(WNKB,BURNUP)
+      RETURN
+      END
diff --git a/Donjon/src/T16ENE.f b/Donjon/src/T16ENE.f
new file mode 100644
index 0000000..b505bf1
--- /dev/null
+++ b/Donjon/src/T16ENE.f
@@ -0,0 +1,322 @@
+*DECK T16ENE
+      SUBROUTINE T16ENE(IPRINT,MXGRP ,NG    ,NGCOND,NGMTR ,NGREAC,
+     >                  NGCCPO,IFGCND,IFGMTR,IFGEDI,ENECPO,ENET16,
+     >                  VELMTR)
+*
+*----
+*
+*Purpose:
+*  Generate and analyse energy structure.
+*
+*Author(s): 
+* G. Marleau
+*
+*Parameters: input
+* IPRINT  print level.
+* MXGRP   maximum number of groups.
+* NG      number of groups in library.
+* NGCOND  number of condensed groups.
+* NGMTR   numbre of main transport groups.
+* NGREAC  numbre of edit groups.
+*
+*Parameters: input/output
+* NGCCPO  numbre of edit groups.
+* IFGCND  reference/exit condensation few groups.
+* IFGMTR  reference/exit main transport few groups.
+* IFGEDI  reference/exit edit few groups.
+* ENECPO  final energy group structure for CPO.
+*
+*Parameters: output
+* ENET16  energy group structure for tape16.
+* VELMTR  velocity for main transport.
+*
+*----
+*
+      IMPLICIT         NONE
+      INTEGER          IPRINT,MXGRP,NG,NGCOND,NGMTR,NGREAC,NGCCPO
+      INTEGER          IFGCND(MXGRP),IFGMTR(MXGRP),
+     >                 IFGEDI(MXGRP)
+      REAL             ENECPO(MXGRP+1),ENET16(MXGRP+1),
+     >                 VELMTR(MXGRP)
+*----
+*  LOCAL VARIABLES
+*  FOR AVERAGED NEUTRON VELOCITY
+*  V=SQRT(2*ENER/M)=SQRT(2/M)*SQRT(ENER)
+*  SQFMAS=SQRT(2/M) IN CM/S/SQRT(EV) FOR V IN CM/S AND E IN EV
+*        =SQRT(2*1.602189E-19(J/EV)* 1.0E4(CM2/M2) /1.67495E-27 (KG))
+*        =1383155.30602 CM/S/SQRT(EV)
+*----
+      INTEGER          IOUT,MGELIB,MGWLIB
+      CHARACTER        NAMSBR*6
+      REAL             SQFMAS,PRECIS
+      PARAMETER       (IOUT=6,MGELIB=89,MGWLIB=69,
+     >                 NAMSBR='T16ENE',SQFMAS=1383155.30602,
+     >                 PRECIS=1.0E-5)
+      INTEGER          IGR,IGC,IGD,IGF
+      REAL             EAVG
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IFGCPO
+      REAL, ALLOCATABLE, DIMENSION(:) :: VELEDI,VELT16
+*----
+*  DATA
+*----
+      REAL             ENEELB(MGELIB+1),ENEWLB(MGWLIB+1)
+      SAVE             ENEELB,ENEWLB
+      DATA             ENEELB
+     >/1.0000E+7,7.7880E+6,6.0653E+6,4.7237E+6,3.6788E+6,2.8650E+6,
+     > 2.2313E+6,1.7377E+6,1.3534E+6,1.0540E+6,8.2085E+5,6.3928E+5,
+     > 4.9787E+5,3.8774E+5,3.0197E+5,2.3518E+5,1.8316E+5,1.4264E+5,
+     > 1.1109E+5,8.6517E+4,6.7379E+4,4.0868E+4,2.4788E+4,1.5034E+4,
+     > 9.1188E+3,5.5308E+3,3.3546E+3,2.0347E+3,1.2341E+3,7.4852E+2,
+     > 4.5400E+2,2.7536E+2,1.6702E+2,1.3007E+2,1.0130E+2,7.8893E+1,
+     > 6.1442E+1,4.7851E+1,3.7267E+1,2.9023E+1,2.2603E+1,1.7603E+1,
+     > 1.3710E+1,1.0677E+1,8.3153E+0,6.4760E+0,5.0435E+0,4.0000E+0,
+     > 3.3000E+0,2.6000E+0,2.1000E+0,1.5000E+0,1.3000E+0,1.1500E+0,
+     > 1.1230E+0,1.0970E+0,1.0710E+0,1.0450E+0,1.0200E+0,9.9600E-1,
+     > 9.7200E-1,9.5000E-1,9.1000E-1,8.5000E-1,7.8000E-1,6.2500E-1,
+     > 5.0000E-1,4.0000E-1,3.5000E-1,3.2000E-1,3.0000E-1,2.8000E-1,
+     > 2.5000E-1,2.2000E-1,1.8000E-1,1.4000E-1,1.0000E-1,8.0000E-2,
+     > 6.7000E-2,5.8000E-2,5.0000E-2,4.2000E-2,3.5000E-2,3.0000E-2,
+     > 2.5000E-2,2.0000E-2,1.5000E-2,1.0000E-2,5.0000E-3,2.0000E-4/
+      DATA             ENEWLB
+     >/1.0000E+7,6.0655E+6,3.6790E+6,2.2310E+6,1.3530E+6,8.2100E+5,
+     > 5.0000E+5,3.0250E+5,1.8300E+5,1.1100E+5,6.7340E+4,4.0850E+4,
+     > 2.4780E+4,1.5030E+4,9.1180E+3,5.5300E+3,3.5191E+3,2.2394E+3,
+     > 1.4251E+3,9.0690E+2,3.6726E+2,1.4873E+2,7.5501E+1,4.8052E+1,
+     > 2.7700E+1,1.5968E+1,9.8770E+0,4.0000E+0,3.3000E+0,2.6000E+0,
+     > 2.1000E+0,1.5000E+0,1.3000E+0,1.1500E+0,1.1230E+0,1.0970E+0,
+     > 1.0710E+0,1.0450E+0,1.0200E+0,9.9600E-1,9.7200E-1,9.5000E-1,
+     > 9.1000E-1,8.5000E-1,7.8000E-1,6.2500E-1,5.0000E-1,4.0000E-1,
+     > 3.5000E-1,3.2000E-1,3.0000E-1,2.8000E-1,2.5000E-1,2.2000E-1,
+     > 1.8000E-1,1.4000E-1,1.0000E-1,8.0000E-2,6.7000E-2,5.8000E-2,
+     > 5.0000E-2,4.2000E-2,3.5000E-2,3.0000E-2,2.5000E-2,2.0000E-2,
+     > 1.5000E-2,1.0000E-2,5.0000E-3,1.0000E-5/
+*----
+*  STORE ORIGINAL GROUP STRUCTURE IN ENET16
+*----
+      ALLOCATE(IFGCPO(MXGRP),VELEDI(MXGRP),VELT16(MXGRP))
+      IF(NG .EQ. MGELIB) THEN
+        ENET16(1)=ENEELB(1)
+        DO IGR=2,MGELIB+1
+          ENET16(IGR)=ENEELB(IGR)
+          EAVG=SQRT(ENET16(IGR)*ENET16(IGR-1))
+          VELT16(IGR-1)=SQFMAS*SQRT(EAVG)
+        ENDDO
+      ELSE IF(NG .EQ. MGWLIB) THEN
+        ENET16(1)=ENEWLB(1)
+        DO IGR=2,MGWLIB+1
+          ENET16(IGR)=ENEWLB(IGR)
+          EAVG=SQRT(ENET16(IGR)*ENET16(IGR-1))
+          VELT16(IGR-1)=SQFMAS*SQRT(EAVG)
+        ENDDO
+      ELSE
+        CALL XABORT(NAMSBR//
+     >  ': INVALID TAPE16 GROUP STRUCTURE')
+      ENDIF
+      IF(IPRINT .GE. 10) THEN
+        WRITE(IOUT,6000) NAMSBR
+        WRITE(IOUT,6010) NG,NGMTR,NGREAC,NGCOND,NGCCPO
+        WRITE(IOUT,6030) (ENET16(IGC),IGC=1,NG+1)
+        WRITE(IOUT,6040) (VELT16(IGC),IGC=1,NG)
+      ENDIF
+*----
+*  COMPUTE AVERAGED NEUTRON GROUP VELOCITY
+*  AVERAGED NEUTRON ENERGY ENER=SQRT(E(G+1)*E(G))
+*  V=SQRT(2*ENER/M)=SQRT(2/M)*SQRT(ENER)
+*   =SQFMAS*SQRT(ENER)
+*----
+      IF(NGMTR .GT. 0) THEN
+        IGF=1
+        DO IGR=1,NGMTR
+          IGD=IGF
+          IGF=IFGMTR(IGR)+1
+          EAVG=SQRT(ENET16(IGD)*ENET16(IGF))
+          VELMTR(IGR)=SQFMAS*SQRT(EAVG)
+        ENDDO
+      ENDIF
+      IF(IPRINT .GE. 10 .AND. NGMTR .GT. 0) THEN
+        WRITE(IOUT,6020) (IFGMTR(IGC),IGC=1,NGMTR)
+        WRITE(IOUT,6031) ENET16(1),
+     >  (ENET16(IFGMTR(IGC)+1),IGC=1,NGMTR)
+        WRITE(IOUT,6041) (VELMTR(IGC),IGC=1,NGMTR)
+      ENDIF
+      IF(NGREAC .GT. 0) THEN
+        IGF=1
+        DO IGR=1,NGREAC
+          IGD=IGF
+          IGF=IFGEDI(IGR)+1
+          EAVG=SQRT(ENET16(IGD)*ENET16(IGF))
+          VELEDI(IGR)=SQFMAS*SQRT(EAVG)
+        ENDDO
+*----
+*    TEST IF CONDENSATION STRUCTURE PROVIDED BY IFGEDI
+*    COMPATIBLE WITH IFGMTR
+*----
+        IF(NGMTR .GT. 0) THEN
+          DO IGC=1,NGREAC
+            DO IGR=IGC,NGMTR
+              IF(IFGEDI(IGC) .EQ. IFGMTR(IGR)) THEN
+                GO TO 105
+              ENDIF
+            ENDDO
+            CALL XABORT(NAMSBR//
+     >      ': IFGEDI AND IFGMTR NOT COMPATIBLE')
+ 105        CONTINUE
+          ENDDO
+        ENDIF
+      ENDIF
+      IF(IPRINT .GE. 10 .AND. NGREAC .GT. 0) THEN
+        WRITE(IOUT,6021) (IFGEDI(IGC),IGC=1,NGREAC)
+        WRITE(IOUT,6032) ENET16(1),
+     >  (ENET16(IFGEDI(IGC)+1),IGC=1,NGREAC)
+        WRITE(IOUT,6042) (VELEDI(IGC),IGC=1,NGREAC)
+      ENDIF
+*----
+*  IF NGCCPO > 0 FIND IFGCPO FROM ENECPO
+*----
+      IF(NGCCPO .GT. 0) THEN
+        IF(ABS(ENECPO(1)-ENET16(1)) .GT. PRECIS ) CALL XABORT(NAMSBR//
+     >  ': ENECPO(1) SHOULD BE IDENTICAL TO ENET16(1)')
+        DO IGC=2,NGCCPO+1
+          DO IGR=IGC,NG+1
+            IF(ABS(ENECPO(IGC)-ENET16(IGR)) .LT. PRECIS ) THEN
+              IFGCPO(IGC-1)=IGR-1
+              GO TO 115
+            ENDIF
+          ENDDO
+ 115      CONTINUE
+        ENDDO
+        IF(NGCOND .GT. 0) THEN
+*----
+*  IF NGCOND > 0
+*  IFGCPO AND IFGCND NUST BE IDENTICAL
+*----
+          IF(NGCCPO .NE. NGCOND) CALL XABORT(NAMSBR//
+     >    ': NGCCPO AND NGCOND MUST BE IDENTICAL')
+          DO IGC=1,NGCCPO
+            IF(IFGCPO(IGC) .NE. IFGCND(IGC))
+     >      CALL XABORT(NAMSBR//
+     >      ': IFGCPO AND IFGCND MUST BE IDENTICAL')
+          ENDDO
+        ENDIF
+      ELSE
+*----
+*  IF NGCCPO =0
+*----
+        IF(NGCOND .GT. 0) THEN
+*----
+*  IF NGCOND > 0
+*  IFGCPO = IFGCND
+*----
+          NGCCPO=NGCOND
+          ENECPO(1)=ENET16(1)
+          DO IGC=1,NGCCPO
+            IFGCPO(IGC)=IFGCND(IGC)
+            ENECPO(IGC+1)=ENET16(IFGCPO(IGC)+1)
+          ENDDO
+        ELSE IF(NGREAC .GT. 0) THEN
+*----
+*  IF NGCOND = 0
+*  AND NGREAC > 0
+*  IFGCPO = IFGEDI
+*----
+          NGCCPO=NGREAC
+          ENECPO(1)=ENET16(1)
+          DO IGC=1,NGCCPO
+            IFGCPO(IGC)=IFGEDI(IGC)
+            ENECPO(IGC+1)=ENET16(IFGCPO(IGC)+1)
+          ENDDO
+        ELSE
+*----
+*  IF NGCOND = 0
+*  AND NGREAC = 0
+*  IFGCPO = IFGMTR
+*----
+          NGCCPO=NGMTR
+          ENECPO(1)=ENET16(1)
+          DO IGC=1,NGCCPO
+            IFGCPO(IGC)=IFGMTR(IGC)
+            ENECPO(IGC+1)=ENET16(IFGCPO(IGC)+1)   
+          ENDDO
+        ENDIF
+      ENDIF
+      IF(NGREAC .GT. 0) THEN
+*----
+*  IF NGREAC > 0
+*    TEST IF CONDENSATION STRUCTURE PROVIDED BY IFGEDI
+*    COMPATIBLE WITH IFGCPO AND IFGMTR
+*  ENDIF
+*----
+        
+        DO IGC=1,NGCCPO
+          DO IGR=IGC,NGREAC
+            IF(IFGCPO(IGC) .EQ. IFGEDI(IGR)) THEN
+              IFGEDI(IGC)=IGR
+              GO TO 135
+            ENDIF
+          ENDDO
+          CALL XABORT(NAMSBR//
+     >    ': IFGCPO AND IFGEDI NOT COMPATIBLE')
+ 135      CONTINUE
+        ENDDO
+      ENDIF
+*----
+*  NGMTR > 0
+*    TEST IF CONDENSATION STRUCTURE PROVIDED BY IFGMTR
+*    COMPATIBLE WITH IFGCPO
+*  ENDIF
+*----
+      DO IGC=1,NGCCPO
+        DO IGR=IGC,NGMTR
+          IF(IFGCPO(IGC) .EQ. IFGMTR(IGR)) THEN
+            IFGMTR(IGC)=IGR
+            GO TO 155
+          ENDIF
+        ENDDO
+        CALL XABORT(NAMSBR//
+     >  ': IFGCPO AND IFGMTR NOT COMPATIBLE')
+ 155    CONTINUE
+      ENDDO
+      IF(IPRINT .GE.10) THEN
+        IF(NGCOND .GT. 0)
+     >    WRITE(IOUT,6022) (IFGCND(IGC),IGC=1,NGCOND)
+        IF(NGCCPO .GT. 0) THEN
+          WRITE(IOUT,6023) (IFGCPO(IGC),IGC=1,NGCCPO)
+          WRITE(IOUT,6033) (ENECPO(IGC),IGC=1,NGCCPO+1)
+        ENDIF
+        WRITE(IOUT,6001)
+      ENDIF
+      DEALLOCATE(VELT16,VELEDI,IFGCPO)
+      RETURN
+*----
+*  PRINT FORMAT
+*----
+ 6000 FORMAT(1X,5('*'),' OUTPUT FROM ',A6,1X,5('*'))
+ 6001 FORMAT(1X,30('*'))
+ 6010 FORMAT(6X,'NUMBER OF LIBRARY GROUPS          = ',I10/
+     >       6X,'NUMBER OF MAIN TRANSPORT GROUPS   = ',I10/
+     >       6X,'NUMBER OF EDITING GROUPS          = ',I10/
+     >       6X,'NUMBER OF CONDENSATION GROUPS     = ',I10/
+     >       6X,'NUMBER OF CPO GROUPS              = ',I10)
+ 6020 FORMAT(6X,'MAIN TRANSPORT FEW GROUPS IDENTIFIER '/
+     >10(2X,I6))
+ 6021 FORMAT(6X,'EDIT FEW GROUPS IDENTIFIER '/
+     >10(2X,I6))
+ 6022 FORMAT(6X,'CONDENSATION FEW GROUPS IDENTIFIER '/
+     >10(2X,I6))
+ 6023 FORMAT(6X,'CPO FEW GROUPS IDENTIFIER '/
+     >10(2X,I6))
+ 6030 FORMAT(6X,'INITIAL ENERGY STRUCTURE (EV)'/
+     >1P,10(2X,E10.3))
+ 6031 FORMAT(6X,'ENERGY STRUCTURE IN MAIN GROUPS (EV)'/
+     >1P,10(2X,E10.3))
+ 6032 FORMAT(6X,'ENERGY STRUCTURE IN EDIT GROUPS (EV)'/
+     >1P,10(2X,E10.3))
+ 6033 FORMAT(6X,'FINAL ENERGY STRUCTURE (EV)'/
+     >1P,10(2X,E10.3))
+ 6040 FORMAT(6X,'AVERAGE VELOCITY IN INITIAL GROUPS (CM/S)'/
+     >1P,10(2X,E10.3))
+ 6041 FORMAT(6X,'AVERAGE VELOCITY IN MAIN GROUPS (CM/S)'/
+     >1P,10(2X,E10.3))
+ 6042 FORMAT(6X,'AVERAGE VELOCITY IN EDIT GROUPS (CM/S)'/
+     >1P,10(2X,E10.3))
+      END
diff --git a/Donjon/src/T16FLX.f b/Donjon/src/T16FLX.f
new file mode 100644
index 0000000..233db49
--- /dev/null
+++ b/Donjon/src/T16FLX.f
@@ -0,0 +1,331 @@
+*DECK T16FLX
+      SUBROUTINE T16FLX(IFT16 ,IPRINT,NGCCPO,NG    ,NGMTR ,NMATZ ,
+     >                  MMXM  ,MTRMSH,NZONE ,IFGMTR,VELMTR,IMIREG,
+     >                  VOLUME,B2CRI ,FLXINT,FLXDIS,OVERV ,KMSPEC,
+     >                  MATMSH,VQLE  ,ZONNUM, ZONRAD,ZONVOL)
+*
+*----
+*
+*Purpose:
+*  Read main transport flux and compute integrated flux, 
+*  flux disadvantage factor and 1/V cross sections.
+*
+*Author(s):
+* G. Marleau
+*
+*Parameters: input
+* IFT16   tape16 file unit.
+* IPRINT  print level where:
+*         =0 for no print; >=  1 print processing option.
+* NGCCPO  number of edit groups.
+* NG      number of groups on X-S library.
+* NGMTR   number of main transport groups.
+* NMATZ   number of mixtures.
+* MMXM    maximum number of zones and main transport meshes.
+* MTRMSH  number of main transport mesh points.
+* NZONE   number of zones.
+* IFGMTR  fewgroups for main transport.
+* VELMTR  velocity for main transport.
+* IMIREG  mixture update identifier where
+*          =0 do not update;
+*          =-1 update using CELLAV information;
+*          > 0 update using specified region number.
+*
+*Parameters: output
+* VOLUME  total volume.
+* B2CRI   critical bucklings.
+* FLXINT  volume integrated fluxes.
+* FLXDIS  flux disadvantage factor.
+* OVERV   1/V cross sections.
+* KMSPEC  material types.
+* MATMSH  material in each mesh.
+* VQLE    volume of each mesh.
+* ZONNUM  zone number.
+* ZONRAD  zone radius.
+* ZONVOL  zone volume.
+*
+*----
+*
+      IMPLICIT         NONE
+      INTEGER          IFT16,IPRINT,NGCCPO,NG,
+     >                 NGMTR,NMATZ,MMXM,MTRMSH,NZONE,IMIREG
+      INTEGER          IFGMTR(NGCCPO),
+     >                 KMSPEC(NMATZ),MATMSH(MMXM)
+      REAL             VELMTR(NGMTR),VOLUME,B2CRI(3),
+     >                 FLXINT(NGCCPO),FLXDIS(NGCCPO),
+     >                 OVERV(NGCCPO),VQLE(MMXM)
+      INTEGER          ZONNUM
+      REAL             ZONVOL(NZONE), ZONRAD(NZONE)
+*----
+*  MEMORY ALLOCATION
+*----
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: PHI
+*----
+*  T16 PARAMETERS
+*----
+      INTEGER          MAXKEY
+      PARAMETER       (MAXKEY=3)
+      CHARACTER        TKEY1(MAXKEY)*10,TKEY2(MAXKEY)*10,
+     >                 RKEY1*10,RKEY2*10
+      INTEGER          NKEY,IOPT,NBE,NID,IR
+      REAL             RID
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER          IOUT
+      CHARACTER        NAMSBR*6
+      PARAMETER       (IOUT=6,NAMSBR='T16FLX')
+      INTEGER          IGR,IGC,IGD,IGF,IMIX,ITRFL,IBUCK
+      REAL             B2INI(3)
+      INTEGER          IZ
+      REAL             CELLV
+*----
+*  SET END RECORDS FOR THIS SEARCH
+*----
+      ALLOCATE(PHI(NG,MMXM))
+      IF(IPRINT .GE. 10) THEN
+        WRITE(IOUT,6000) NAMSBR
+      ENDIF
+      IOPT=0
+      FLXINT(:NGCCPO)=0.0
+      FLXDIS(:NGCCPO)=0.0
+      OVERV(:NGCCPO)=0.0
+*----
+*  CELL VOLUME PER UNIT LENGTH 
+*----
+      REWIND(IFT16) 
+      TKEY1(1)='REGION    '
+      TKEY2(1)='DESCRIPTON'
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1  ,TKEY2  ,
+     >            NBE   )
+      IF(NBE .GT. 0) THEN
+        READ(IFT16) RKEY1,RKEY2,NBE,ZONNUM, 
+     >  (ZONRAD(IZ),IZ=1,NZONE),(ZONVOL(IZ), IZ=1, NZONE)
+      ELSE
+        CALL XABORT(NAMSBR//': KEYS '//TKEY1(1)//','//
+     >              TKEY2(1)//' NOT FOUND ON TAPE16')
+      ENDIF
+      CELLV=0.0
+      DO IZ=1, ZONNUM 
+         CELLV=CELLV+ZONVOL(IZ)
+      END DO 
+*----
+*  MTRFLX RECORDS
+*----
+      REWIND(IFT16)    
+      NKEY=2
+      TKEY1(2)='REGION    '
+      TKEY2(2)='DESCRIPTON'
+      TKEY1(1)='MTRFLX    '
+      TKEY2(1)='FLUX      '
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1 ,TKEY2 ,
+     >            NBE   )
+      ITRFL=0
+      IF(NBE .GT. 0 ) THEN
+        ITRFL=1
+      ELSE IF( NBE .LT. -1 ) THEN
+        READ(IFT16) RKEY1,RKEY2,NBE
+        IF(IMIREG .GT. 0) THEN
+*----
+*  Update mixture if IMIREG>0
+*----
+          TKEY1(2)='CELLAV    '
+          TKEY2(2)='NGROUPS   '
+          TKEY1(1)='REGION    '
+          TKEY2(1)='FLUX      '
+          DO IR=1,IMIREG-1
+            CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1 ,TKEY2 ,
+     >                  NBE   )
+            IF( NBE .LE. 0 ) CALL XABORT(NAMSBR//
+     >      ': REGION FLUX NOT AVAILABLE')
+            READ(IFT16) RKEY1,RKEY2
+          ENDDO
+          CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1 ,TKEY2 ,
+     >                NBE   )
+          IF( NBE .GT. 0 ) ITRFL=2
+        ELSE IF(IMIREG .LT. 0) THEN
+*----
+*  Update mixture using CELLAV information if IMIREG<0
+*----
+          TKEY1(2)='CELLAV    '
+          TKEY2(2)='K         '
+          TKEY1(1)='CELLAV    '
+          TKEY2(1)='FLUX      '
+          CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1 ,TKEY2 ,
+     >                NBE   )
+          IF( NBE .GT. 0 ) ITRFL=3
+        ENDIF
+      ENDIF
+      IF( ITRFL .EQ. 0 ) THEN
+         CALL XABORT(NAMSBR//
+     >   ': CANNOT FIND '//TKEY1(1)//' '//TKEY2(1)//' OR '//
+     >   TKEY1(2)//' '//TKEY2(2))
+      ELSE IF(ITRFL .EQ. 1) THEN
+*----
+*  USE MTRFLX
+*  1) CONDENSE AND HOMOGENIZE FLUX
+*  2) COMPUTE FLUX DISADVANTAGE FACTOR
+*  3) COMPUTE VOLUME
+*  4) COMPUTE OVERV
+*----
+        READ(IFT16) RKEY1,RKEY2,NBE,NID,NID,
+     >   (MATMSH(IR),VQLE(IR),
+     >   (PHI(IGR,IR),IGR=1,NGMTR),IR=1,MTRMSH)
+        VOLUME=0.0
+        DO IR=1,MTRMSH
+          IGF=0
+          VOLUME=VOLUME+VQLE(IR)
+          IF(IPRINT .GE. 100) THEN
+            WRITE(IOUT,6100) IR,VQLE(IR)
+            WRITE(IOUT,6110)(PHI(IGR,IR),IGR=1,NGMTR)
+          ENDIF
+          DO IGC=1,NGCCPO
+            IGD=IGF+1
+            IGF=IFGMTR(IGC)
+            DO IGR=IGD,IGF
+              FLXINT(IGC)=FLXINT(IGC)+PHI(IGR,IR)*VQLE(IR)
+              OVERV(IGC)=OVERV(IGC)
+     >                  +PHI(IGR,IR)*VQLE(IR)/VELMTR(IGR)
+            ENDDO
+          ENDDO
+          IMIX=MATMSH(IR)
+          IF(KMSPEC(IMIX) .EQ. 1) THEN
+            IGF=0
+            DO IGC=1,NGCCPO
+              IGD=IGF+1
+              IGF=IFGMTR(IGC)
+              DO IGR=IGD,IGF
+                FLXDIS(IGC)=FLXDIS(IGC)+PHI(IGR,IR)*VQLE(IR)
+              ENDDO
+            ENDDO
+          ENDIF
+        ENDDO
+      ELSE IF(ITRFL .EQ. 2) THEN
+*----
+*  USE REGION FLUX
+*  1) CONDENSE AND HOMOGENIZE FLUX
+*  2) COMPUTE FLUX DISADVANTAGE FACTOR
+*  4) COMPUTE OVERV
+*----
+        READ(IFT16) RKEY1,RKEY2,NBE,NID,NID,VOLUME,
+     >    (PHI(IGR,1),IGR=1,NGMTR)
+        IR=IMIREG
+        IGF=0
+        IF(IPRINT .GE. 100) THEN
+          WRITE(IOUT,6100) IR,VOLUME
+          WRITE(IOUT,6110)(PHI(IGR,IR),IGR=1,NGMTR)
+        ENDIF
+        DO 120 IGC=1,NGCCPO
+          IGD=IGF+1
+          IGF=IFGMTR(IGC)
+          DO 121 IGR=IGD,IGF
+            FLXINT(IGC)=FLXINT(IGC)+PHI(IGR,IR)*VOLUME
+            OVERV(IGC)=OVERV(IGC)
+     >              +(PHI(IGR,IR)*VOLUME)/VELMTR(IGR)
+ 121      CONTINUE
+          FLXDIS(IGC)=FLXINT(IGC)
+ 120    CONTINUE
+      ELSE
+*----
+*  USE CELLAV FLUX
+*  1) CONDENSE AND HOMOGENIZE FLUX
+*  2) COMPUTE FLUX DISADVANTAGE FACTOR
+*  3) COMPUTE VOLUME
+*  4) COMPUTE OVERV
+*----
+        IR=1
+        VOLUME=1.0
+        READ(IFT16) RKEY1,RKEY2,NBE,
+     >   (PHI(IGR,IR),IGR=1,NGMTR)
+        IF(IPRINT .GE. 100) THEN
+          WRITE(IOUT,6101)
+          WRITE(IOUT,6110)(PHI(IGR,IR),IGR=1,NGMTR)
+        ENDIF
+        DO IGR=1, NGMTR 
+          PHI(IGR,IR)=PHI(IGR,IR)/CELLV
+        ENDDO 
+        IGF=0
+        DO 130 IGC=1,NGCCPO
+          IGD=IGF+1
+          IGF=IFGMTR(IGC)
+          DO 131 IGR=IGD,IGF
+            FLXINT(IGC)=FLXINT(IGC)+PHI(IGR,IR)
+            OVERV(IGC)=OVERV(IGC)+PHI(IGR,IR)/VELMTR(IGR)
+ 131      CONTINUE
+          FLXDIS(IGC)=FLXINT(IGC)
+ 130    CONTINUE
+      ENDIF
+      DO 140 IGC=1,NGCCPO
+        FLXDIS(IGC)=FLXDIS(IGC)/FLXINT(IGC)
+        OVERV(IGC)=OVERV(IGC)/FLXINT(IGC)
+ 140  CONTINUE
+*----
+*  RADIAL AND AXIAL DIFFUSION COEFFICIENTS
+*  AND BUCKLING
+*----
+      TKEY1(2)='CELLAV    '
+      TKEY2(2)='K         '
+      TKEY1(1)='CELLAV    '
+      TKEY2(1)='DIFFUSION '
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1 ,TKEY2 ,
+     >            NBE   )
+      IF( NBE .NE. 5*NGMTR+5 ) CALL XABORT(NAMSBR//
+     >': CANNOT FIND '//TKEY1(1)//' '//TKEY2(1))
+      READ(IFT16) RKEY1,RKEY2,NBE,(NID,IR=1,3),
+     >           (RID,IGR=1,NGMTR),
+     >           (RID,IGR=1,NGMTR),
+     >           (RID,IGR=1,NGMTR),
+     >           (B2INI(IR),IR=1,2)
+      TKEY1(1)='CELLAV    '
+      TKEY2(1)='CRITICALB '
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1 ,TKEY2 ,
+     >            NBE   )
+      IF( NBE .EQ. 2*NGMTR+4 ) THEN
+        READ(IFT16) RKEY1,RKEY2,NBE,IBUCK,
+     >             (B2CRI(IR),IR=1,3)
+        IF(IBUCK .EQ. 2) THEN
+          B2CRI(3)=B2INI(1)+B2CRI(2)
+          B2CRI(1)=B2INI(1)/B2CRI(3)
+          B2CRI(2)=B2CRI(2)/B2CRI(3)
+        ELSE IF(IBUCK .EQ. 3) THEN
+          B2CRI(3)=B2CRI(1)+B2INI(2)
+          B2CRI(1)=B2CRI(1)/B2CRI(3)
+          B2CRI(2)=B2INI(2)/B2CRI(3)
+        ELSE
+          B2CRI(1)=B2CRI(1)/B2CRI(3)
+          B2CRI(2)=B2CRI(2)/B2CRI(3)
+        ENDIF
+      ELSE IF(NBE .EQ. -2) THEN
+        B2CRI(3)=B2INI(1)+B2INI(2)
+        B2CRI(1)=B2INI(1)/B2CRI(3)
+        B2CRI(2)=B2INI(2)/B2CRI(3)
+      ELSE
+        CALL XABORT(NAMSBR//
+     >': CANNOT FIND '//TKEY1(2)//' '//TKEY2(2))
+      ENDIF
+      IF(IPRINT .GE. 10) THEN
+        WRITE(IOUT,6010) (FLXINT(IGC),IGC=1,NGCCPO)
+        WRITE(IOUT,6011) (FLXDIS(IGC),IGC=1,NGCCPO)
+        WRITE(IOUT,6012) (OVERV(IGC),IGC=1,NGCCPO)
+        WRITE(IOUT,6013) (B2CRI(IR),IR=1,3)
+        WRITE(IOUT,6001)
+      ENDIF
+      RETURN
+*----
+*  PRINT FORMAT
+*----
+ 6000 FORMAT(1X,5('*'),' OUTPUT FROM ',A6,1X,5('*'))
+ 6001 FORMAT(1X,30('*'))
+ 6010 FORMAT(6X,'INTEGRATED FLUXES'/
+     >1P,10(2X,E10.3))
+ 6011 FORMAT(6X,'FLUX DISADVANTAGE FACTORS'/
+     >1P,10(2X,E10.3))
+ 6012 FORMAT(6X,'1/V '/
+     >1P,10(2X,E10.3))
+ 6013 FORMAT(6X,'CRITICAL BUCKLINGS'/
+     >1P,3(2X,E10.3))
+ 6100 FORMAT(6X,'MAIN TRANSPORT GROUP FLUX IN REGION  = ',I10,
+     >       5X,'OF VOLUME = ',1P,E10.3)
+ 6101 FORMAT(6X,'CELLAV MAIN TRANSPORT GROUP FLUX  ')
+ 6110 FORMAT(1P,10(2X,E10.3))
+      END
diff --git a/Donjon/src/T16FND.f b/Donjon/src/T16FND.f
new file mode 100644
index 0000000..f278cae
--- /dev/null
+++ b/Donjon/src/T16FND.f
@@ -0,0 +1,140 @@
+*DECK T16FND
+      SUBROUTINE T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1 ,TKEY2 ,
+     >                  NBELEM)
+*
+*----
+*
+*Purpose:
+*  Find next record on tape16 identified by keys TKEY1 and TKEY2.
+*
+*Author(s): 
+* G. Marleau
+*
+*Parameters: input
+* IFT16   tape16 file unit.
+* IPRINT  print level where:
+*         <100 for no print; 
+*         >=100 print record to read;
+*         >=10000 print all record read.
+* IOPT    processing option with:
+*         =-1 start at current position and read to end of file with
+*             no backspace before return;
+*         =0 start at current position and read to end of file with
+*             backspace before return;
+*         =1 rewind before reading and read to end of file;
+*         =2 start at current position, rewind, start at beginning of
+*         file until end of file.
+* NKEY    number of keys set to test:
+*         =1 search for TKEY1(1),TKEY2(1) until end of file;
+*         >1 search for TKEY1(1),TKEY2(1) until
+*         (TKEY1(IK),TKEY2(IK),IK=2,NKEY) or end of file.
+* TKEY1   primary key.
+* TKEY2   secondary key.
+*
+*Parameters: output
+* NBELEM  number of element found on record with:
+*         <-1 record not found before alternative keys -NBELEM ;
+*         =-1 record not found before end of files;
+*         >=0 record found with NBELEM elements.
+*
+*----
+*
+      IMPLICIT         NONE
+      INTEGER          IFT16,IPRINT,IOPT,NKEY,NBELEM
+      CHARACTER        TKEY1(NKEY)*10,TKEY2(NKEY)*10
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER          IOUT
+      CHARACTER        NAMSBR*6
+      PARAMETER       (IOUT=6,NAMSBR='T16FND')
+      CHARACTER        RKEY1*10,RKEY2*10
+      INTEGER          NBE,IEND,IKEY
+*----
+*  Print keys if required
+*----
+      IF(IPRINT .GE. 100) THEN
+        IF(IPRINT .LT. 10000) THEN
+          WRITE(6,6000) TKEY1(1),TKEY2(1)
+        ENDIF
+      ENDIF
+*----
+*  REWIND FILE FIRST IF IOPT=1
+*----
+      IEND=1
+      IF(IOPT .EQ. 1) THEN
+        REWIND(IFT16)
+      ELSE IF (IOPT .EQ. 2) THEN
+        IEND=0
+      ENDIF
+*----
+*  LOOP FOR READ
+*----
+ 100  CONTINUE
+      READ(IFT16,END=105) RKEY1,RKEY2,NBE
+      IF(IPRINT .GE. 10000) THEN
+        WRITE(6,6003) RKEY1,RKEY2,NBE
+      ENDIF
+      IF(RKEY1 .EQ. TKEY1(1) .AND.
+     >   RKEY2 .EQ. TKEY2(1)       ) THEN
+*----
+*  KEYS FOUND BACKSPACE AND RETURN
+*----
+        NBELEM=NBE
+        IF(IOPT .GE. 0) BACKSPACE(IFT16)
+        IF(IPRINT .GE. 100) THEN
+          WRITE(6,6001) RKEY1,RKEY2,NBELEM
+        ENDIF
+        RETURN
+      ELSE IF(NKEY .GE. 2) THEN
+        DO IKEY=2,NKEY
+          IF(RKEY1 .EQ. TKEY1(IKEY) .AND.
+     >       RKEY2 .EQ. TKEY2(IKEY)       ) THEN
+            NBELEM=-IKEY
+            IF(IOPT .GE. 0) BACKSPACE(IFT16)
+            IF(IPRINT .GE. 100) THEN
+              WRITE(6,6004) RKEY1,RKEY2,NBE,
+     >                      TKEY1(1),TKEY2(1)
+            ENDIF
+            RETURN
+          ENDIF
+        ENDDO
+      ENDIF
+*----
+*  KEYS NOT FOUND READ NEXT RECORD
+*----
+      GO TO 100
+*----
+*  END OF FILE REACHED
+*----
+ 105  CONTINUE
+      IF(IEND .EQ. 0) THEN
+*----
+*  REWIND FILE AND CONTINUE READ
+*----
+        IEND=1
+        REWIND(IFT16)
+        GO TO 100
+      ENDIF
+*----
+*  RECORD ABSENT, RETURN
+*----
+      NBELEM=-1
+      IF(IPRINT .GE. 100) THEN
+        IF(IPRINT .LT. 10000) THEN
+          WRITE(6,6002) TKEY1(1),TKEY2(1)
+        ENDIF
+      ENDIF
+      RETURN
+*----
+*  PRINT FORMAT
+*----
+ 6000 FORMAT( 1X, 'FIND T16 RECORD = ',2(A10,2X))
+ 6001 FORMAT( 1X, '     T16 RECORD = ',2(A10,2X),I10,
+     >        1X,'FOUND')
+ 6002 FORMAT( 1X, '     T16 RECORD = ',2(A10,2X),10X,
+     >        1X,'NOT FOUND')
+ 6003 FORMAT(11X,'T16 RECORD READ = ',2(A10,2X),I10)
+ 6004 FORMAT( 1X,'T16 STOP RECORD = ',2(A10,2X),I10,
+     >        1X,'FOUND BEFORE RECORD = ',2(A10,2X))
+      END
diff --git a/Donjon/src/T16GET.f b/Donjon/src/T16GET.f
new file mode 100644
index 0000000..387b93f
--- /dev/null
+++ b/Donjon/src/T16GET.f
@@ -0,0 +1,235 @@
+*DECK T16GET
+      SUBROUTINE T16GET(MAXMIX,MNLOCP,MNCPLP,MNPERT,NALOCP,IDLCPL,
+     >                  NCMIXS,MNBURN,NAMMIX,MIXRCI,PARRCI,MIXPER,
+     >                  PARPER,MIXREG)
+*
+*----
+*
+*Purpose:
+*  Read from input T16CPO processing options.
+*
+*Author(s): 
+* G. Marleau
+*
+*Parameters: input
+* MAXMIX  maximum number of mixtures.
+* MNLOCP  maximum number of local parameters.
+* MNCPLP  maximum number of coupled parameters.
+* MNPERT  maximum number of perturbations per local parameter.
+* NALOCP  local parameter names allowed.
+* IDLCPL  local ID for perturbation parameters.
+*
+*Parameters: input/output
+* NCMIXS  number of current mixtures.
+* MNBURN  current and final number of burnup steps
+* NAMMIX  names of mixtures.
+* MIXRCI  reference information for mixtures where:
+*         =0 no information for mixture;
+*         >0 information not updated; 
+*         <0 information to be updated. 
+* PARRCI  reference local parameters for mixtures.
+* MIXPER  perturbation information for mixtures.
+*         =0 no information for mixture;
+*         >0 information not updated; 
+*         <0 information to be updated. 
+* PARPER  perturbation parameters for mixtures.
+*
+*Parameters: output
+* MIXREG  mixture update identifier where:
+*          =0 do not update;
+*          =-1 update using CELLAV information;
+*          > 0 update using specified region number.
+*
+*Comments:
+* Input data is of the form:
+*    [[ MIXNAM [ { CELLAV | REGION noreg } ]
+*    [ RC [ nburn ] frstrec ]
+*    [[ NAMPER valref npert
+*       (valper(i),frstrec(i),i=1,npert)]]
+*    ]]
+*    [ MTMD [ valreft valrefd ] npert
+*       (valpert(i), valperd(i), frstrec(i),i=1,npert)]]
+*    ]
+*
+*----
+*
+      IMPLICIT         NONE
+      INTEGER          MAXMIX,MNLOCP,MNCPLP,MNPERT,NCMIXS,MNBURN
+      CHARACTER        NALOCP(MNLOCP+MNCPLP)*4
+      INTEGER          IDLCPL(2,MNLOCP+MNCPLP),NAMMIX(2,MAXMIX),
+     >                 MIXRCI(2+MNLOCP+MNCPLP,MAXMIX),
+     >                 MIXPER(MNPERT,MNLOCP+MNCPLP,MAXMIX),
+     >                 MIXREG(MAXMIX)
+      REAL             PARRCI(MNLOCP,MAXMIX),
+     >                 PARPER(MNPERT,2,MNLOCP+MNCPLP,MAXMIX)
+*----
+*  READ VARIABLES
+*----
+      CHARACTER        TEXT12*12
+      INTEGER          ITYPE,NITMA
+      REAL             FLOTT
+      DOUBLE PRECISION DFLOTT
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER          IOUT,NTC
+      CHARACTER        NAMSBR*6
+      PARAMETER       (IOUT=6,NTC=3,NAMSBR='T16GET')
+      INTEGER          KCHAR(NTC),INEXTM,ILOCP,ILOCL,NLPAR,
+     >                 ILPAR,NBRCI,IPAR,IMIX,IRLOC
+*----
+*  READ INPUT DATA.
+*----
+      INEXTM=0
+ 100  CONTINUE
+      CALL REDGET(ITYPE,NITMA,FLOTT,TEXT12,DFLOTT)
+ 101  CONTINUE
+      IF(ITYPE .NE. 3) CALL XABORT(NAMSBR//
+     >  ': KEYWORD EXPECTED')
+      IF(TEXT12 .EQ. ';') THEN
+*----
+*  END OF INPUT REACHED
+*  EXIT READ
+*----
+        GO TO 105
+      ELSE IF(TEXT12 .EQ. 'CELLAV') THEN
+*----
+*  CELLAV KEYWORD FOUND
+*----
+        IF(INEXTM .EQ. 0) CALL XABORT(NAMSBR//
+     >  ': MIXTURE NAME MUST BE DEFINED BEFORE CELLAV')
+        MIXREG(INEXTM)=-1
+      ELSE IF(TEXT12 .EQ. 'REGION') THEN
+*----
+*  REGION KEYWORD FOUND
+*----
+        IF(INEXTM .EQ. 0) CALL XABORT(NAMSBR//
+     >  ': MIXTURE NAME MUST BE DEFINED BEFORE REGION')
+        CALL REDGET(ITYPE,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(ITYPE .NE. 1) CALL XABORT(NAMSBR//
+     >  ': REGION NUMBER MUST FOLLOW REGION KEYWORD')
+        IF(NITMA .LT. 1) CALL XABORT(NAMSBR//
+     >  ': REGION NUMBER MUST BE > 0')
+        MIXREG(INEXTM)=NITMA
+      ELSE IF(TEXT12 .EQ. 'RC') THEN
+*----
+*  REFERENCE CASE INFORMATION
+*----
+        IF(INEXTM .EQ. 0) CALL XABORT(NAMSBR//
+     >  ': MIXTURE NAME MUST BE DEFINED RC')
+        CALL REDGET(ITYPE,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(ITYPE .NE. 1) CALL XABORT(NAMSBR//
+     >  ': DATA TYPE FOLLOWING RC MUST BE INTEGER')
+        IF(NITMA .LT. 1) CALL XABORT(NAMSBR//
+     >  ': FIRST INTEGER VALUE FOLLOWING RC MUST BE > 0')
+        MIXRCI(1,INEXTM)=NITMA
+        IF(MIXRCI(2,INEXTM) .EQ. 0) THEN
+          MIXRCI(2,INEXTM)=-1
+        ENDIF
+        CALL REDGET(ITYPE,NITMA,FLOTT,TEXT12,DFLOTT)
+        IF(ITYPE .NE. 1) GO TO 101
+        IF(NITMA .LT. 1) CALL XABORT(NAMSBR//
+     >  ': SECOND INTEGER VALUE FOLLOWING RC MUST BE > 0')
+        MNBURN=MAX(MNBURN,MIXRCI(1,INEXTM))
+        MIXRCI(2,INEXTM)=-MIXRCI(1,INEXTM)
+        MIXRCI(1,INEXTM)=NITMA
+      ELSE
+*----
+*  EITHER PERTURBATION OR NEW MIXTURE
+*  1) IF PERTURBATION
+*     TREAT INPUT AND RETURN TO READ NEXT KEYWORD
+*     OTHERWISE TEXT12 IS NEW MIXTURE NAME
+*----
+        IRLOC=2
+        DO ILOCP=1,MNLOCP+MNCPLP
+          NLPAR=1
+          IF(ILOCP .GT. MNLOCP) NLPAR=2
+          IF(TEXT12 .EQ. NALOCP(ILOCP)) THEN
+            IF(INEXTM .EQ. 0) CALL XABORT(NAMSBR//
+     >      ': MIXTURE NAME REQUIRED FOR PERTURBATIONS')
+*----
+*  SAVE REFERENCE PARAMETER AND TEST FOR COHERENCE
+*----
+            CALL REDGET(ITYPE,NITMA,FLOTT,TEXT12,DFLOTT)
+            IF(ITYPE .EQ. 2) THEN
+              DO ILPAR=1,NLPAR
+                IF(ITYPE .NE. 2) CALL XABORT(NAMSBR//
+     >          ': REFERENCES EXPECTED FOR PERTURBATIONS')
+                ILOCL=IDLCPL(ILPAR,ILOCP)
+                IF(MIXRCI(IRLOC+ILOCL,INEXTM) .EQ. 0) THEN
+                  PARRCI(ILOCL,INEXTM)=FLOTT
+                ELSE IF(PARRCI(ILOCL,INEXTM) .NE. FLOTT) THEN
+                  CALL XABORT(NAMSBR//
+     >            ': REFERENCE PARAMETER NOT COHERENT FOR '//
+     >            NALOCP(ILOCP)//
+     >            ' PERTURBATION INITIALIZATION')
+                ENDIF
+                CALL REDGET(ITYPE,NITMA,FLOTT,TEXT12,DFLOTT)
+              ENDDO
+            ELSE IF( MIXRCI(IRLOC+ILOCP,INEXTM) .EQ. 0) THEN
+              CALL XABORT(NAMSBR//
+     >        ': REFERENCE CASE NOT INITIALIZED FOR '//
+     >        NALOCP(ILOCP)//' PERTURBATION')
+            ENDIF
+*----
+*  READ NUMBER OF PERTURBATIONS
+*----
+            IF(ITYPE .NE. 1) CALL XABORT(NAMSBR//
+     >      ': INVALID RECORD FOLLOWING PERTURBATION')
+            IF(NITMA .LT. 0) CALL XABORT(NAMSBR//
+     >      ': NUMBER OF PERTURBATION MUST BE >= 0')
+            NBRCI=NITMA
+            MIXRCI(IRLOC+ILOCP,INEXTM)=-NITMA
+*----
+*  READ PERTURBATIONS PARAMETERS
+*----
+            DO IPAR=1,NBRCI
+              DO ILPAR=1,NLPAR
+                ILOCL=IDLCPL(ILPAR,ILOCP)
+                CALL REDGET(ITYPE,NITMA,FLOTT,TEXT12,DFLOTT)
+                IF(ITYPE .NE. 2) CALL XABORT(NAMSBR//
+     >          ': INVALID RECORD FOR REFERENCE PARAMETER')
+                PARPER(IPAR,ILPAR,ILOCP,INEXTM)=FLOTT
+              ENDDO
+              CALL REDGET(ITYPE,NITMA,FLOTT,TEXT12,DFLOTT)
+              IF(ITYPE .NE. 1) CALL XABORT(NAMSBR//
+     >        ': INVALID RECORD FOLLOWING PERTURBATION')
+              IF(NITMA .LT. 0) CALL XABORT(NAMSBR//
+     >        ': NUMBER OF PERTURBATION MUST BE >= 0')
+              MIXPER(IPAR,ILOCP,INEXTM)=NITMA
+            ENDDO
+            GO TO 100
+          ENDIF
+        ENDDO
+*----
+*  3) TEXT12 IS A NEW MIXTURE NAME
+*     TREAT INPUT AND RETURN TO READ NEXT KEYWORD
+*----
+        READ(TEXT12,'(A4,A2)') KCHAR(1),KCHAR(2)
+        DO IMIX=1,NCMIXS
+          IF(KCHAR(1) .EQ. NAMMIX(1,IMIX) .AND.
+     >       KCHAR(2) .EQ. NAMMIX(2,IMIX) ) THEN
+            INEXTM=IMIX
+            GO TO 145
+          ENDIF
+        ENDDO
+        NCMIXS=NCMIXS+1
+        NAMMIX(1,NCMIXS)=KCHAR(1)
+        NAMMIX(2,NCMIXS)=KCHAR(2)
+        IF(NCMIXS .GT. MAXMIX) CALL XABORT(NAMSBR//
+     >  ': TOO MANY MIXTURES READ')
+        INEXTM=NCMIXS
+ 145    CONTINUE
+*----
+*  ASSUME CELLAV BY DEFAULT
+*----
+        MIXREG(INEXTM)=-1
+      ENDIF
+      GO TO 100
+ 105  CONTINUE
+*----
+*  ALL THE REQUIRED INFORMATION READ
+*  RETURN
+*----
+      RETURN
+      END
diff --git a/Donjon/src/T16LST.f b/Donjon/src/T16LST.f
new file mode 100644
index 0000000..4ea70fd
--- /dev/null
+++ b/Donjon/src/T16LST.f
@@ -0,0 +1,50 @@
+*DECK T16LST
+      SUBROUTINE T16LST(IFT16 )
+*
+*----
+*
+*Purpose:
+*  Print records stored on tape16.
+*
+*Author(s):
+* G. Marleau
+*
+*Parameters: input
+* IFT16   tape16 file unit.
+*
+*----
+*
+      IMPLICIT         NONE
+      INTEGER          IFT16
+*----
+*  T16 KEYS
+*----
+      CHARACTER        TKEY1*10,TKEY2*10
+      INTEGER          NKEY,IOPT,NBE
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER          IOUT
+      CHARACTER        NAMSBR*6
+      PARAMETER       (IOUT=6,NAMSBR='T16LST')
+      INTEGER          IPRINT
+*----
+*  LIST TAPE16 RECORDS AFTER REWINDING
+*----
+      WRITE(IOUT,6000) NAMSBR
+      IPRINT=10000
+      IOPT=1
+      NKEY=1
+      TKEY1='          '
+      TKEY2=TKEY1
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1 ,TKEY2 ,
+     >            NBE)
+      WRITE(IOUT,6001)
+      RETURN
+      
+*----
+*  PRINT FORMAT
+*----
+ 6000 FORMAT( 1X, 'PRINTING CONTENTS OF TAPE16 FILE USING ',A6)
+ 6001 FORMAT( 1X, 'END OF TAPE16 FILE REACHED')
+      END
diff --git a/Donjon/src/T16MPI.f b/Donjon/src/T16MPI.f
new file mode 100644
index 0000000..3c979ae
--- /dev/null
+++ b/Donjon/src/T16MPI.f
@@ -0,0 +1,218 @@
+*DECK T16MPI
+      SUBROUTINE T16MPI(IPCPO ,IPRINT,MAXMIX,MNLOCP,MNCPLP,MNPERT,
+     >                  NALOCP,IDLCPL,NCMIXS,NGCCPO,ENECPO,NAMMIX,
+     >                  MIXRCI,PARRCI,PARPER)
+*
+*----
+*
+*Purpose:
+*  Initialize mixture processing option.
+*
+*Author(s): 
+* G. Marleau
+*
+*Parameters: input
+* IPCPO   pointer to CPO data structure.
+* IPRINT  print level.
+* MAXMIX  maximum number of mixtures.
+* MNLOCP  maximum number of local parameters.
+* MNCPLP  maximum number of coupled parameters.
+* MNPERT  maximum number of perturbations per local parameter.
+* NALOCP  local parameter names allowed.
+* IDLCPL  local ID for perturbation parameters.
+* NCMIXS  number of current mixtures.
+* NGCCPO  number of edit groups.
+* ENECPO  final energy group structure for CPO.
+* NAMMIX  names of mixtures.
+*
+*Parameters: output
+* MIXRCI  reference information for mixtures where:
+*         =0 no information for mixture;
+*         >0 information not updated; 
+*         <0 information to be updated. 
+* PARRCI  reference local parameters for mixtures.
+* PARPER  perturbation parameters for mixtures.
+*
+*----
+*
+      USE GANLIB
+      IMPLICIT         NONE
+      TYPE(C_PTR)      IPCPO
+      INTEGER          IPRINT,MAXMIX,MNLOCP,MNCPLP,MNPERT,
+     >                 NCMIXS,NGCCPO
+      CHARACTER        NALOCP(MNLOCP+MNCPLP)*4
+      INTEGER          IDLCPL(2,MNLOCP+MNCPLP),NAMMIX(2,MAXMIX),
+     >                 MIXRCI(2+MNLOCP+MNCPLP,MAXMIX)
+      REAL             ENECPO(NGCCPO+1),PARRCI(MNLOCP,MAXMIX),
+     >                 PARPER(MNPERT,2,MNLOCP+MNCPLP,MAXMIX)
+*----
+*  MEMORY ALLOCATION
+*----
+      INTEGER ,ALLOCATABLE, DIMENSION(:) :: IDSUF,NBPER
+      REAL,ALLOCATABLE, DIMENSION(:) :: ENEMIX,LOCALP
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER          IOUT,NPARAM,NTC,ILCMUP,ILCMDN
+      CHARACTER        NAMSBR*6
+      PARAMETER       (IOUT=6,NPARAM=4,ILCMUP=1,ILCMDN=2,
+     >                 NTC=3,NAMSBR='T16MPI')
+      CHARACTER        NAMDIR*12
+      INTEGER          IPARAM(NPARAM),
+     >                 ILOCP,IMIX,IPER,NBPERP,IGR,
+     >                 NLPAR,ILPAR,ILOCL,NPERTN,IR
+*----
+*  GET MIXTURE NAMES
+*----
+      CALL LCMGET(IPCPO,'MIXTURE-PREF',NAMMIX)
+*----
+*  GET PERTURBATION SUFFIX NAMES AND COMPARE WITH
+*  REFERENCE NAMES
+*----
+      NPERTN=MNLOCP+MNCPLP
+      ALLOCATE(ENEMIX(NGCCPO+1),IDSUF(NPERTN))
+      CALL LCMGET(IPCPO,'PERTURB-SUFX',IDSUF)
+      DO ILOCP=1,NPERTN
+        WRITE(NAMDIR,'(A4)') IDSUF(ILOCP)
+        IF(NAMDIR .NE. NALOCP(ILOCP)) CALL XABORT(NAMSBR//
+     >  ': INCOHERENT PERTURBATION NAMES')
+      ENDDO
+      DEALLOCATE(IDSUF)
+*----
+*  GET NUMBER OF PERTURBATION PER LOCAL PARAMETER PER MIXTURE
+*----
+      ALLOCATE(NBPER(NPERTN*NCMIXS))
+      CALL LCMGET(IPCPO,'PERTURB-NUMB',NBPER)
+      IPER=0
+      DO IMIX=1,NCMIXS
+        DO ILOCP=1,NPERTN
+          IPER=IPER+1
+          MIXRCI(2+ILOCP,IMIX)=NBPER(IPER)
+        ENDDO
+      ENDDO
+      DEALLOCATE(NBPER)
+      ALLOCATE(LOCALP(MNLOCP))
+*----
+*  GET LOCAL PARAMETERS
+*----
+      DO IMIX=1,NCMIXS
+*----
+*  GET REFERENCE MIXTURE PARAMETERS
+*----
+        WRITE(NAMDIR,'(A4,A2,A6)')
+     >  NAMMIX(1,IMIX),NAMMIX(2,IMIX),'RC    '
+        CALL LCMSIX(IPCPO,NAMDIR,ILCMUP)
+        CALL LCMGET(IPCPO,'PARAM       ',IPARAM)
+        IF(IPARAM(1) .NE. NGCCPO) THEN
+          CALL XABORT(NAMSBR//
+     >    ': INVALID NUMBER OF GROUPS FOR REFERENCE')
+        ENDIF
+*----
+*  TEST ENERGY GROUP STRUCTURE
+*----
+        CALL LCMGET(IPCPO,'ENERGY      ',ENEMIX)
+        DO IGR=1,NGCCPO+1
+          IF(ENECPO(IGR) .NE. ENEMIX(IGR)) THEN
+            CALL XABORT(NAMSBR//
+     >      ': INVALID GROUP STRUCTURE FOR REFERENCE')
+          ENDIF
+        ENDDO
+*----
+*  READ LOCAL PARAMETERS AND TRANSFER
+*  TO LOCAL TABLE
+*----
+        MIXRCI(2,IMIX)=IPARAM(4)
+        CALL LCMGET(IPCPO,'LOCAL-PARAMS',LOCALP)
+        DO ILOCP=1,MNLOCP
+          PARRCI(ILOCP,IMIX)=LOCALP(ILOCP)
+        ENDDO
+        CALL LCMSIX(IPCPO,NAMDIR,ILCMDN)
+*----
+*  GET PERTURBATIONS PARAMETERS
+*----
+        DO ILOCP=1,NPERTN
+          NBPERP=MIXRCI(2+ILOCP,MAXMIX)
+          IF(NBPERP .GT. 0) THEN
+            NLPAR=1
+            IF(ILOCP .GT. MNLOCP) NLPAR=2
+            DO IPER=1,NBPERP
+              WRITE(NAMDIR,'(A4,A2,A4,I2)')
+     >        NAMMIX(1,IMIX),NAMMIX(2,IMIX),NALOCP(ILOCP),IPER
+              CALL LCMSIX(IPCPO,NAMDIR,ILCMUP)
+              CALL LCMGET(IPCPO,'PARAM       ',IPARAM)
+              IF(IPARAM(1) .NE. NGCCPO) THEN
+                CALL XABORT(NAMSBR//
+     >          ': INVALID NUMBER OF GROUPS FOR PERTURBATION')
+              ENDIF
+*----
+*  TEST ENERGY GROUP STRUCTURE
+*----
+              CALL LCMGET(IPCPO,'ENERGY      ',ENEMIX)
+              DO IGR=1,NGCCPO+1
+                IF(ENECPO(IGR) .NE. ENEMIX(IGR)) THEN
+                  CALL XABORT(NAMSBR//
+     >            ': INVALID GROUP STRUCTURE FOR REFERENCE')
+                ENDIF
+              ENDDO
+              CALL LCMGET(IPCPO,'LOCAL-PARAMS',LOCALP)
+*----
+*  READ PERTURBED LOCAL PARAMETERS AND TRANSFER
+*  TO LOCAL TABLE
+*----
+              DO ILPAR=1,NLPAR
+                ILOCL=IDLCPL(ILPAR,ILOCP)
+                PARPER(IPER,ILPAR,ILOCP,IMIX)=LOCALP(ILOCL)
+              ENDDO
+              CALL LCMSIX(IPCPO,NAMDIR,ILCMDN)
+            ENDDO
+          ENDIF
+        ENDDO
+      ENDDO
+      DEALLOCATE(LOCALP,ENEMIX)
+*----
+*  PROCESS PRINT LEVEL
+*----
+      IF(IPRINT .GE. 10) THEN
+        WRITE(IOUT,6000) NAMSBR,NCMIXS
+        DO IMIX=1,NCMIXS
+          IF(MIXRCI(2,IMIX) .GT. 0) THEN
+            WRITE(IOUT,6010) (NAMMIX(IR,IMIX),IR=1,2),
+     >                        MIXRCI(2,IMIX)
+            WRITE(IOUT,6020)
+     >      (NALOCP(ILOCP),PARRCI(ILOCP,IMIX),ILOCP=1,MNLOCP)
+          ENDIF
+          DO ILOCP=1,NPERTN
+            NBPERP=MIXRCI(2+ILOCP,IMIX)
+            NLPAR=1
+            IF(ILOCP .GT. MNLOCP) NLPAR=2
+            IF(NBPERP .GT. 0) THEN
+              WRITE(IOUT,6011) NBPERP,NALOCP(ILOCP)
+              DO IPER=1,NBPERP
+                WRITE(IOUT,6022) IPER,
+     >          (NALOCP(IDLCPL(ILPAR,ILOCP)),
+     >           PARPER(IPER,ILPAR,ILOCP,IMIX),
+     >           ILPAR=1,NLPAR)
+              ENDDO
+            ENDIF
+          ENDDO
+        ENDDO
+        WRITE(IOUT,6001)
+      ENDIF
+      RETURN
+*----
+*  PRINT FORMAT
+*----
+ 6000 FORMAT(1X,5('*'),'OUTPUT FROM ',A6,5('*')/
+     >       6X,'CONTENTS OF CPO BEFORE UPDATE'/
+     >       6X,'NUMBER OF MIXTURES  = ',I10)
+ 6001 FORMAT(1X,28('*'))
+ 6010 FORMAT(6X,'NAME OF MIXTURES    = ',A4,A4,
+     >       2X,'NUMBER OF BURNUP    = ',I10,
+     >       2X,'ALREADY STORED ON CPO FILE')
+ 6011 FORMAT(6X,I10,' PERTURBATIONS FOR ',A4,
+     >       2X,'ALREADY STORED ON CPO FILE')
+ 6020 FORMAT(6X,'LOCAL PARAMETER FOR REFERENCE CASE'/
+     >       1P,6(2x,A4,1X,E10.3))
+ 6022 FORMAT(6X,'LOCAL PARAMETER PERTURBATION = ',I2/
+     >       1P,2(2x,A4,1X,E10.3))
+      END
diff --git a/Donjon/src/T16MPS.f b/Donjon/src/T16MPS.f
new file mode 100644
index 0000000..fe368e6
--- /dev/null
+++ b/Donjon/src/T16MPS.f
@@ -0,0 +1,275 @@
+*DECK T16MPS
+      SUBROUTINE T16MPS(IPCPO ,IPRINT,MAXMIX,MNLOCP,MNCPLP,MNPERT,
+     >                  NALOCP,IDLCPL,NCMIXS,NGCCPO,TITLE ,SUBTIT ,
+     >                  ENECPO,NAMMIX,MIXRCI,PARRCI,PARPER)
+*
+*----
+*
+*Purpose:
+*  Save mixture processing option on CPO.
+*
+*Author(s): 
+* G. Marleau
+*
+*Parameters: input
+* IPCPO   pointer to CPO data structure.
+* IPRINT  print level.
+* MAXMIX  maximum number of mixtures.
+* MNLOCP  maximum number of local parameters.
+* MNCPLP  maximum number of coupled parameters.
+* MNPERT  maximum number of perturbations per local parameter.
+* NALOCP  local parameter names allowed.
+* IDLCPL  local ID for perturbation parameters.
+* NCMIXS  number of current mixtures.
+* NGCCPO  number of edit groups.
+* TITLE   title.
+* SUBTIT  subtitle.
+* ENECPO  final energy group structure for CPO.
+* NAMMIX  names of mixtures.
+* MIXRCI  reference information for mixtures where:
+*         =0 no information for mixture;
+*         >0 information not updated; 
+*         <0 information to be updated. 
+* PARRCI  reference local parameters for mixtures.
+* PARPER  perturbation parameters for mixtures.
+*
+*----
+*
+      USE GANLIB
+      IMPLICIT         NONE
+      TYPE(C_PTR)      IPCPO
+      INTEGER          IPRINT,MAXMIX,MNLOCP,MNCPLP,MNPERT,
+     >                 NCMIXS,NGCCPO
+      CHARACTER        NALOCP(MNLOCP+MNCPLP)*4
+      INTEGER          IDLCPL(2,MNLOCP+MNCPLP)
+      CHARACTER        TITLE*72,SUBTIT*240
+      INTEGER          NAMMIX(2,MAXMIX),
+     >                 MIXRCI(2+MNLOCP+MNCPLP,MAXMIX)
+      REAL             ENECPO(NGCCPO+1),PARRCI(MNLOCP,MAXMIX),
+     >                 PARPER(MNPERT,2,MNLOCP+MNCPLP,MAXMIX)
+*----
+*  MEMORY ALLOCATION
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IDSUF,NBPER
+      REAL, ALLOCATABLE, DIMENSION(:) :: LOCALP
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER          IOUT,NPARAM,NTC,ILCMUP,ILCMDN
+      CHARACTER        NAMSBR*6,NAMMAC*12
+      PARAMETER       (IOUT=6,NPARAM=4,ILCMUP=1,ILCMDN=2,
+     >                 NTC=3,NAMSBR='T16MPS',NAMMAC='MACR        ')
+      CHARACTER        NAMDIR*12
+      INTEGER          IPARAM(NPARAM),KCHAR(NTC),
+     >                 NBURN,ILOCP,IMIX,IGC,
+     >                 IPER,NBPERP,ILCMLN,ITYLCM,NLPAR,ILPAR,ILOCL,
+     >                 IR,NPERTN,NMODRC
+*----
+*  SAVE MIXTURE NAMES
+*----
+      NAMDIR=NAMMAC
+      READ(NAMDIR,'(3A4)') (KCHAR(IR),IR=1,NTC)
+      NPERTN=MNLOCP+MNCPLP
+      CALL LCMPUT(IPCPO,'MIXTURE-PREF',2*NCMIXS,3,NAMMIX)
+*----
+*  SAVE PERTURBATION SUFFIX NAMES
+*----
+      ALLOCATE(IDSUF(NPERTN))
+      DO 100 ILOCP=1,NPERTN
+        READ(NALOCP(ILOCP),'(A4)') IDSUF(ILOCP)
+ 100  CONTINUE
+      CALL LCMPUT(IPCPO,'PERTURB-SUFX',NPERTN,3,IDSUF)
+      DEALLOCATE(IDSUF)
+*----
+*  SAVE NUMBER OF PERTURBATION PER LOCAL PARAMETER PER MIXTURE
+*----
+      ALLOCATE(NBPER(NPERTN*NCMIXS))
+      IPER=0
+      DO IMIX=1,NCMIXS
+        DO ILOCP=1,NPERTN
+          IPER=IPER+1
+          NBPER(IPER)=ABS(MIXRCI(2+ILOCP,IMIX))
+        ENDDO
+      ENDDO
+      CALL LCMPUT(IPCPO,'PERTURB-NUMB',NPERTN*NCMIXS,
+     >            1,NBPER)
+      DEALLOCATE(NBPER)
+      ALLOCATE(LOCALP(MNLOCP))
+*----
+*  SCAN OVER MIXTURES
+*----
+      DO IMIX=1,NCMIXS
+*----
+*  MIXTURE TO UPDATE
+*----
+        WRITE(NAMDIR,'(A4,A2,A6)')
+     >  NAMMIX(1,IMIX),NAMMIX(2,IMIX),'RC    '
+        NBURN=ABS(MIXRCI(2,IMIX))
+        IPARAM(1)=NGCCPO
+        IPARAM(2)=1
+        IPARAM(3)=2
+        IPARAM(4)=NBURN
+        NMODRC=0
+        DO ILOCP=1,NPERTN
+          IF(MIXRCI(2+ILOCP,IMIX) .LT. 0) THEN
+            NMODRC=NMODRC-1
+          ENDIF
+        ENDDO
+        IF(MIXRCI(2,IMIX) .LT. 0 ) THEN
+          CALL LCMSIX(IPCPO,NAMDIR,ILCMUP)
+          CALL LCMLEN(IPCPO,'PARAM       ',ILCMLN,ITYLCM)
+          IF(ILCMLN .EQ. 0) THEN
+            CALL LCMPUT(IPCPO,'PARAM       ',NPARAM,1,IPARAM)
+            CALL LCMPUT(IPCPO,'ENERGY      ',NGCCPO+1,2,ENECPO)
+          ELSE
+            CALL LCMGET(IPCPO,'PARAM       ',IPARAM)
+            IF(IPARAM(1) .NE. NGCCPO .OR.
+     >         IPARAM(2) .NE. 1      .OR.
+     >         IPARAM(3) .NE. 2      .OR.
+     >         IPARAM(4) .NE. NBURN      ) THEN
+*----
+*  ABORT SINCE REFERENCE CASE PARAMETERS HAVE CHANGED
+*----
+              CALL XABORT(NAMSBR//
+     >        ': INCOMPATIBLE PARAMETERS FOR '//NAMDIR)
+            ENDIF
+          ENDIF
+          LOCALP(:MNLOCP)=0.0
+          DO ILOCP=1,MNLOCP
+            LOCALP(ILOCP)=PARRCI(ILOCP,IMIX)
+          ENDDO
+          CALL LCMPUT(IPCPO,'LOCAL-PARAMS',MNLOCP, 2,LOCALP)
+          CALL LCMPTC(IPCPO,'TITLE       ',    72,    TITLE)
+          CALL LCMPTC(IPCPO,'SUB-TITLE   ',   240,   SUBTIT)
+          CALL LCMPUT(IPCPO,'ISOTOPESNAME',   NTC, 3, KCHAR)
+          CALL LCMSIX(IPCPO,NAMDIR,ILCMDN)
+        ELSE IF(NMODRC .LT. 0) THEN
+          CALL LCMSIX(IPCPO,NAMDIR,ILCMUP)
+          LOCALP(:MNLOCP)=0.0
+          DO ILOCP=1,MNLOCP
+            LOCALP(ILOCP)=PARRCI(ILOCP,IMIX)
+          ENDDO
+          CALL LCMPUT(IPCPO,'LOCAL-PARAMS',MNLOCP, 2,LOCALP)
+          CALL LCMSIX(IPCPO,NAMDIR,ILCMDN)
+        ENDIF
+*----
+*  PERTURBATIONS TO UPDATE
+*----
+        DO ILOCP=1,NPERTN
+          NBPERP=ABS(MIXRCI(2+ILOCP,IMIX))
+          IF(MIXRCI(2+ILOCP,IMIX) .LT. 0) THEN
+            NLPAR=1
+            IF(ILOCP .GT. MNLOCP) NLPAR=2
+            DO IPER=1,NBPERP
+              WRITE(NAMDIR,'(A4,A2,A4,I2)')
+     >        NAMMIX(1,IMIX),NAMMIX(2,IMIX),NALOCP(ILOCP),IPER
+              CALL LCMSIX(IPCPO,NAMDIR,ILCMUP)
+              CALL LCMLEN(IPCPO,'PARAM       ',ILCMLN,ITYLCM)
+              IF(ILCMLN .EQ. 0) THEN
+                CALL LCMPUT(IPCPO,'PARAM       ',NPARAM,1,IPARAM)
+                CALL LCMPUT(IPCPO,'ENERGY      ',NGCCPO+1,2,ENECPO)
+              ELSE
+                CALL LCMGET(IPCPO,'PARAM       ',IPARAM)
+                IF(IPARAM(1) .NE. NGCCPO .OR.
+     >             IPARAM(2) .NE. 1      .OR.
+     >             IPARAM(3) .NE. 2      .OR.
+     >             IPARAM(4) .NE. NBURN      ) THEN
+*----
+*  ABORT SINCE PERTURBATION PARAMETERS HAVE CHANGED
+*----
+                  CALL XABORT(NAMSBR//
+     >            ': INCOMPATIBLE PARAMETERS FOR '//NAMDIR)
+                ENDIF
+              ENDIF
+*----
+*  TRANSFER REFERENCE PARAMETERS
+*----
+              DO ILOCL=1,MNLOCP
+                LOCALP(ILOCL)=PARRCI(ILOCL,IMIX)
+              ENDDO
+*----
+*  TRANSFER PERTURBED PARAMETERS
+*----
+              DO ILPAR=1,NLPAR
+                ILOCL=IDLCPL(ILPAR,ILOCP)
+                LOCALP(ILOCL)=PARPER(IPER,ILPAR,ILOCP,IMIX)
+              ENDDO
+              CALL LCMPUT(IPCPO,'LOCAL-PARAMS',MNLOCP, 2,    LOCALP)
+              CALL LCMPTC(IPCPO,'TITLE       ',    72,        TITLE)
+              CALL LCMPTC(IPCPO,'SUB-TITLE   ',   240,       SUBTIT)
+              CALL LCMPUT(IPCPO,'ISOTOPESNAME',   NTC, 3,     KCHAR)
+              CALL LCMSIX(IPCPO,NAMDIR,ILCMDN)
+            ENDDO
+          ENDIF
+        ENDDO
+      ENDDO
+      DEALLOCATE(LOCALP)
+*----
+*  PROCESS PRINT LEVEL
+*----
+      IF(IPRINT .GE. 1) THEN
+        WRITE(IOUT,6000) NAMSBR,NCMIXS,NGCCPO
+        WRITE(IOUT,6030) (ENECPO(IGC),IGC=1,NGCCPO+1)
+        DO IMIX=1,NCMIXS
+          IF(MIXRCI(2,IMIX) .LT. 0) THEN
+            WRITE(IOUT,6010) (NAMMIX(IR,IMIX),IR=1,2),
+     >                        ABS(MIXRCI(2,IMIX))
+            WRITE(IOUT,6020)
+     >        (NALOCP(ILOCP),PARRCI(ILOCP,IMIX),ILOCP=1,MNLOCP)
+          ELSE IF(MIXRCI(2,IMIX) .GT. 0) THEN
+            WRITE(IOUT,6011) (NAMMIX(IR,IMIX),IR=1,2),
+     >                        ABS(MIXRCI(2,IMIX))
+            WRITE(IOUT,6020)
+     >      (NALOCP(ILOCP),PARRCI(ILOCP,IMIX),ILOCP=1,MNLOCP)
+          ENDIF
+          DO ILOCP=1,NPERTN
+            NBPERP=ABS(MIXRCI(2+ILOCP,IMIX))
+            NLPAR=1
+            IF(ILOCP .GT. MNLOCP) NLPAR=2
+            IF(MIXRCI(2+ILOCP,IMIX) .LT. 0) THEN
+              WRITE(IOUT,6012) NBPERP,NALOCP(ILOCP)
+              DO IPER=1,NBPERP
+                WRITE(IOUT,6021) IPER,
+     >          (NALOCP(IDLCPL(ILPAR,ILOCP)),
+     >           PARPER(IPER,ILPAR,ILOCP,IMIX),
+     >           ILPAR=1,NLPAR)
+              ENDDO
+            ELSE IF(MIXRCI(2+ILOCP,IMIX) .GT. 0) THEN
+              WRITE(IOUT,6013) NBPERP,NALOCP(ILOCP)
+              DO IPER=1,NBPERP
+                WRITE(IOUT,6021) IPER,
+     >          (NALOCP(IDLCPL(ILPAR,ILOCP)),
+     >           PARPER(IPER,ILPAR,ILOCP,IMIX),
+     >           ILPAR=1,NLPAR)
+              ENDDO
+            ENDIF
+          ENDDO
+        ENDDO
+        WRITE(IOUT,6001)
+      ENDIF
+*----
+*  PRINT FORMAT
+*----
+ 6000 FORMAT(1X,5('*'),'OUTPUT FROM ',A6,5('*')/
+     >       6X,'CONTENTS OF CPO AFTER UPDATE'/
+     >       6X,'NUMBER OF MIXTURES     = ',I10/
+     >       6X,'NUMBER OF GROUPS       = ',I10)
+ 6001 FORMAT(1X,28('*'))
+ 6010 FORMAT(6X,'NAME OF MIXTURES    = ',A4,A4,
+     >       2X,'NUMBER OF BURNUP    = ',I10,
+     >       2X,'UPDATED FROM CURRENT TAPE16')
+ 6011 FORMAT(6X,'NAME OF MIXTURES    = ',A4,A4,
+     >       2X,'NUMBER OF BURNUP    = ',I10,
+     >       2X,'TAKEN FROM OLD CPO')
+ 6012 FORMAT(6X,I10,' PERTURBATIONS FOR ',A4,
+     >       2X,'UPDATED FROM CURRENT TAPE16')
+ 6013 FORMAT(6X,I10,' PERTURBATIONS FOR ',A4,
+     >       2X,'UPDATED FROM OLD CPO')
+ 6020 FORMAT(6X,'LOCAL PARAMETER FOR REFERENCE CASE'/
+     >       1P,6(2X,A4,1X,E10.3))
+ 6021 FORMAT(6X,'LOCAL PARAMETER PERTURBATION = ',I2,
+     >       1P,2(2x,A4,1X,E10.3))
+ 6030 FORMAT(6X,'CPO ENERGY STRUCTURE (EV)'/
+     >1P,10(2X,E10.3))
+      RETURN
+      END
diff --git a/Donjon/src/T16RCA.f b/Donjon/src/T16RCA.f
new file mode 100644
index 0000000..baadd16
--- /dev/null
+++ b/Donjon/src/T16RCA.f
@@ -0,0 +1,405 @@
+*DECK T16RCA
+      SUBROUTINE T16RCA(IFT16 ,IPRINT,NGCCPO,NGMTR ,IFGMTR,NVXSR ,
+     >                  NMXSR ,B2CRI ,BRNIRR, NZONE,RECXSV,RECXSM,
+     >                  RECTMP,RECSCA,ZONVOL)
+*
+*----
+*
+*Purpose:
+*  Read tape16 CELLAV cross sections at a specific burnup.
+*
+*Author(s):
+* G. Marleau
+*
+*Parameters: input
+* IFT16   tape16 file unit.
+* IPRINT  print level where:
+*         =0 for no print; >=  1 print processing option.
+* NGCCPO  number of edit groups.
+* NGMTR   number of main transport groups.
+* IFGMTR  fewgroups for main transport.
+* NVXSR   number of vector cross sections.
+* NMXSR   number of matrix cross sections.
+* B2CRI   critical bucklings.
+* NZONE   number of zones.
+* ZONVOL  zone volume.
+*
+*Parameters: output
+* BRNIRR  burnup and irradiation.
+* RECXSV  vector cross sections.
+* RECXSM  matrix cross sections.
+* RECTMP  dummy vector cross sections.
+* RECSCA  dummy matrix cross sections.
+*
+*----
+*
+      IMPLICIT         NONE
+      INTEGER          IFT16,IPRINT,NGCCPO,NGMTR,NVXSR,NMXSR
+      INTEGER          IFGMTR(NGCCPO)
+      REAL             B2CRI(3),BRNIRR(3),
+     >                 RECXSV(NGCCPO,NVXSR+NMXSR),
+     >                 RECXSM(NGCCPO,NGCCPO,NMXSR),
+     >                 RECTMP(NGMTR,4),RECSCA(NGMTR,NGMTR)
+      REAL             ZONVOL(NZONE)
+*----
+*  T16 PARAMETERS
+*----
+      INTEGER          MAXKEY
+      PARAMETER       (MAXKEY=2)
+      CHARACTER        TKEY1(MAXKEY)*10,TKEY2(MAXKEY)*10,
+     >                 RKEY1*10,RKEY2*10
+      INTEGER          NKEY,IOPT,NBE,NID,IR, IZ
+      REAL             RID
+*----
+*  LOCAL VARIABLES
+*  WSMEV FACTOR TO TRANSFORM MEV IN JOULES (WS)
+*----
+      INTEGER          IOUT
+      CHARACTER        NAMSBR*6
+      REAL             WSMEV
+      PARAMETER       (IOUT=6,NAMSBR='T16RCA',WSMEV=1.602189E-13)
+      INTEGER          IGR,IGC,IGD,IGF,JGR,JGC,JGD,JGF
+      REAL             FLXNOR,BRNTMP(3),RTIME
+      INTEGER          NZONE
+      REAL             CELLV
+*----
+*  INITIALIZE CROSS SECTION VECTORS
+*----
+      IF(IPRINT .GE. 10) THEN
+        WRITE(IOUT,6000) NAMSBR
+      ENDIF
+      RECXSV(:NGCCPO,:NVXSR+NMXSR)=0.0
+      RECXSM(:NGCCPO,:NGCCPO,:NMXSR)=0.0
+*----
+*  LOCATE NEXT CELLAV RECORD
+*----
+      IOPT=0
+      TKEY1(1)='CELLAV    '
+      TKEY2(1)='MODERATOR '
+      NKEY=1
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1 ,TKEY2 ,
+     >            NBE   )
+      IF( NBE .LE. 0 ) CALL XABORT(NAMSBR//
+     >': CANNOT FIND '//TKEY1(1)//' '//TKEY2(1))
+      READ(IFT16) RKEY1,RKEY2,NBE
+      NKEY=2
+*----
+*  CELL AVERAGED ABSORPTION X-S
+*----
+      TKEY1(1)='CELLAV    '
+      TKEY2(1)='ABSORPTION'
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1 ,TKEY2 ,
+     >            NBE   )
+      IF( NBE .NE. NGMTR ) CALL XABORT(NAMSBR//
+     >': CANNOT FIND '//TKEY1(1)//' '//TKEY2(1))
+      READ(IFT16) RKEY1,RKEY2,NBE,(RECTMP(IGR,4),IGR=1,NGMTR)
+      IF(IPRINT .GE. 100) THEN
+        WRITE(IOUT,6100) TKEY2(1)
+        WRITE(IOUT,6110) (RECTMP(IGR,4),IGR=1,NGMTR)
+      ENDIF
+*----
+*  CELL AVERAGED NU*FISSION
+*----
+      TKEY1(1)='CELLAV    '
+      TKEY2(1)='NU-FISSION'
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1 ,TKEY2 ,
+     >            NBE   )
+      IF( NBE .NE. NGMTR ) CALL XABORT(NAMSBR//
+     >': CANNOT FIND '//TKEY1(1)//' '//TKEY2(1))
+      READ(IFT16) RKEY1,RKEY2,NBE,(RECTMP(IGR,3),IGR=1,NGMTR)
+      IF(IPRINT .GE. 100) THEN
+        WRITE(IOUT,6100) TKEY2(1)
+        WRITE(IOUT,6110) (RECTMP(IGR,3),IGR=1,NGMTR)
+      ENDIF
+*----
+*  CELL AVERAGED TRANSPORT
+*----
+      TKEY1(1)='CELLAV    '
+      TKEY2(1)='TOTAL-X   '
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1 ,TKEY2 ,
+     >            NBE   )
+      IF( NBE .NE. NGMTR ) CALL XABORT(NAMSBR//
+     >': CANNOT FIND '//TKEY1(1)//' '//TKEY2(1))
+      READ(IFT16) RKEY1,RKEY2,NBE,(RECTMP(IGR,2),IGR=1,NGMTR)
+      IF(IPRINT .GE. 100) THEN
+        WRITE(IOUT,6100) TKEY2(1)
+        WRITE(IOUT,6110) (RECTMP(IGR,2),IGR=1,NGMTR)
+      ENDIF
+      CELLV=0.0
+      DO IZ=1, NZONE 
+        CELLV=CELLV+ZONVOL(IZ)
+      ENDDO 
+      TKEY1(1)='CELLAV    '
+      TKEY2(1)='FLUX   '
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1 ,TKEY2 ,
+     >            NBE   )
+      IF( NBE .NE. NGMTR ) CALL XABORT(NAMSBR//
+     >': CANNOT FIND '//TKEY1(1)//' '//TKEY2(1))
+      READ(IFT16) RKEY1,RKEY2,NBE,(RECTMP(IGR,1),IGR=1,NGMTR)
+      IF(IPRINT .GE. 100) THEN
+        WRITE(IOUT,6100) TKEY2(1)
+        WRITE(IOUT,6110) (RECTMP(IGR,1),IGR=1,NGMTR)
+      ENDIF
+      DO IGR=1, NGMTR 
+        RECTMP(IGR,1)=RECTMP(IGR,1)/CELLV
+      ENDDO 
+*----
+*  CONDENSE TRANSPORT, ABSORPTION AND NU-FISSION X-S
+*  OVER CPO GROUPS
+*----
+      IGF=0
+      DO IGC=1,NGCCPO
+        IGD=IGF+1
+        IGF=IFGMTR(IGC)
+        FLXNOR=0.0
+        DO IGR=IGD,IGF
+          FLXNOR=FLXNOR+RECTMP(IGR,1)
+        ENDDO
+        IF(FLXNOR .GT. 0.0) THEN
+          FLXNOR=1.0/FLXNOR
+          DO IGR=IGD,IGF
+            RECTMP(IGR, 1)=RECTMP(IGR, 1)*FLXNOR
+            RECXSV(IGC, 2)=RECXSV(IGC, 2)
+     >                    +RECTMP(IGR,2)*RECTMP(IGR,1)
+            RECXSV(IGC, 3)=RECXSV(IGC, 3)
+     >                    +RECTMP(IGR,3)*RECTMP(IGR,1)
+            RECXSV(IGC,15)=RECXSV(IGC,15)
+     >                    +RECTMP(IGR,4)*RECTMP(IGR,1)
+          ENDDO
+        ELSE
+          CALL XABORT(NAMSBR//
+     >   ': FLUX IN ONE CPO GROUP IS 0.0')
+        ENDIF
+      ENDDO
+*----
+*  ISOTROPIC SCATTERING MATRIX FROM GROUP IGR TO JGR
+*  IS STORED ON TAPE 16 AS
+*  ((RECSCA(IGR,JGR),IGR=1,NGMTR),JGR=1,NGMTR)
+*  RECXSM(IGTO,IGFROM,1) REPRESENT
+*  SCATTERING CROSS SECTION
+*  FROM GROUP "IGFROM" TO GROUP "IGTO"
+*  FOR ANISOTROPY LEVEL 1
+*----
+      TKEY1(1)='CELLAV    '
+      TKEY2(1)='SCATTER   '
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1 ,TKEY2 ,
+     >            NBE   )
+      IF( NBE .NE. NGMTR*NGMTR ) CALL XABORT(NAMSBR//
+     >': CANNOT FIND '//TKEY1(1)//' '//TKEY2(1))
+      READ(IFT16) RKEY1,RKEY2,NBE,
+     >          ((RECSCA(IGR,JGR),IGR=1,NGMTR),JGR=1,NGMTR)
+      IF(IPRINT .GE. 100) THEN
+        WRITE(IOUT,6100) TKEY2(1)
+        WRITE(IOUT,6110) ((RECSCA(IGR,JGR),IGR=1,NGMTR),JGR=1,NGMTR)
+      ENDIF
+*----
+*  FISSION SPECTRUM
+*----
+      TKEY1(1)='CELLAV    '
+      TKEY2(1)='FISSPECT  '
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1 ,TKEY2 ,
+     >            NBE   )
+      IF( NBE .NE. NGMTR ) CALL XABORT(NAMSBR//
+     >': CANNOT FIND '//TKEY1(1)//' '//TKEY2(1))
+      READ(IFT16) RKEY1,RKEY2,NBE,(RECTMP(IGR,4),IGR=1,NGMTR)
+      IF(IPRINT .GE. 100) THEN
+        WRITE(IOUT,6100) TKEY2(1)
+        WRITE(IOUT,6110) (RECTMP(IGR,4),IGR=1,NGMTR)
+      ENDIF
+*----
+*  CONDENSE ISOTROPIC SCATTERING MATRIX AND FISSION SPECTRUM
+*  OVER CPO GROUPS
+*  COMPUTE TOTAL ISOTROPIC SCATTERING
+*  COMPUTE TOTAL AND TRANSPORT CORRECTION
+*  TOTAL(1) = ABSORPTION (15) + SCATTERING (21)
+*  TRANSPORT CORRECTION (2) = TOTAL(1) -TRANSPORT CORRECTED (2)
+*----
+      IGF=0
+      DO IGC=1,NGCCPO
+        IGD=IGF+1
+        IGF=IFGMTR(IGC)
+        DO IGR=IGD,IGF
+          RECXSV(IGC, 5)=RECXSV(IGC,5)+RECTMP(IGR,4)
+          JGF=0
+          DO JGC=1,NGCCPO
+            JGD=JGF+1
+            JGF=IFGMTR(JGC)
+            DO JGR=JGD,JGF
+              RECXSM(JGC,IGC,1)=RECXSM(JGC,IGC,1)
+     >                         +RECSCA(IGR,JGR)*RECTMP(IGR,1)
+              RECXSV(IGC,21)=RECXSV(IGC,21)
+     >                      +RECSCA(IGR,JGR)*RECTMP(IGR,1)
+            ENDDO
+          ENDDO
+        ENDDO
+        RECXSV(IGC,1)=RECXSV(IGC,15)+RECXSV(IGC,21)
+        RECXSV(IGC,2)=RECXSV(IGC,1)-RECXSV(IGC,2)
+      ENDDO
+*----
+*  LINEARLY ANISOTROPIC SCATTERING FROM GROUP IGR TO JGR
+*  IS STORED ON TAPE 16 AS
+*  ((RECSCA(IGR,JGR),IGR=1,NGMTR),JGR=1,NGMTR)
+*  RECXSM(IGTO,IGFROM,2) REPRESENT
+*  SCATTERING CROSS SECTION
+*  FROM GROUP "IGFROM" TO GROUP "IGTO"
+*  FOR ANISOTROPY LEVEL 2
+*----
+      TKEY1(1)='CELLAV    '
+      TKEY2(1)='SCATERP1  '
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1 ,TKEY2 ,
+     >            NBE   )
+      IF( NBE .EQ. NGMTR*NGMTR ) THEN
+        READ(IFT16) RKEY1,RKEY2,NBE,
+     >            ((RECSCA(IGR,JGR),IGR=1,NGMTR),JGR=1,NGMTR)
+        IF(IPRINT .GE. 100) THEN
+          WRITE(IOUT,6100) TKEY2(1)
+          WRITE(IOUT,6110) ((RECSCA(IGR,JGR),IGR=1,NGMTR),JGR=1,NGMTR)
+        ENDIF
+*----
+*  CONDENSE LINEARLY ANISOTROPIC SCATTERING MATRIX
+*  OVER CPO GROUPS
+*  COMPUTE TOTAL LINEARLY ANISOTROPIC SCATTERING
+*----
+        IGF=0
+        DO IGC=1,NGCCPO
+          IGD=IGF+1
+          IGF=IFGMTR(IGC)
+          DO IGR=IGD,IGF
+            JGF=0
+            DO JGC=1,NGCCPO
+              JGD=JGF+1
+              JGF=IFGMTR(JGC)
+              DO JGR=JGD,JGF
+                RECXSM(JGC,IGC,2)=RECXSM(JGC,IGC,2)
+     >                           +RECTMP(IGR,4)*RECSCA(IGR,JGR)
+                RECXSV(IGC,22)=RECXSV(IGC,22)
+     >                        +RECTMP(IGR,4)*RECSCA(IGR,JGR)
+              ENDDO
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDIF
+*----
+*  RADIAL AND AXIAL DIFFUSION COEFFICIENTS
+*  AND BUCKLING
+*----
+      TKEY1(2)='CELLAV    '
+      TKEY2(2)='K         '
+      TKEY1(1)='CELLAV    '
+      TKEY2(1)='DIFFUSION '
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1 ,TKEY2 ,
+     >            NBE   )
+      IF( NBE .NE. 5*NGMTR+5 ) CALL XABORT(NAMSBR//
+     >': CANNOT FIND '//TKEY1(1)//' '//TKEY2(1))
+      READ(IFT16) RKEY1,RKEY2,NBE,(NID,IR=1,3),
+     >           (RECTMP(IGR,2),IGR=1,NGMTR),
+     >           (RECTMP(IGR,3),IGR=1,NGMTR),
+     >           (RID,IGR=1,NGMTR),
+     >           (RID,IR=1,2)
+      IF(IPRINT .GE. 100) THEN
+        WRITE(IOUT,6100) TKEY2(1)
+        WRITE(IOUT,6110) (RECTMP(IGR,2),IGR=1,NGMTR)
+        WRITE(IOUT,6110) (RECTMP(IGR,3),IGR=1,NGMTR)
+      ENDIF
+*----
+*  CONDENSE DIFFUSION COEFFICIENTS
+*  COMPUTE STRD=1/3*DIFF
+*----
+      IGF=0
+      DO IGC=1,NGCCPO
+        IGD=IGF+1
+        IGF=IFGMTR(IGC)
+        DO IGR=IGD,IGF
+          RECXSV(IGC,17)=RECXSV(IGC,17)+RECTMP(IGR,1)
+     >       *(B2CRI(1)*RECTMP(IGR,2)+B2CRI(2)*RECTMP(IGR,3))
+          RECXSV(IGC,18)=RECXSV(IGC,18)
+     >                  +RECTMP(IGR,1)*RECTMP(IGR,2)
+          RECXSV(IGC,19)=RECXSV(IGC,19)
+     >                  +RECTMP(IGR,1)*RECTMP(IGR,2)
+          RECXSV(IGC,20)=RECXSV(IGC,20)
+     >                  +RECTMP(IGR,1)*RECTMP(IGR,3)
+        ENDDO
+*----
+*  IF DIFFUSION COEFFICIENT VANISHES
+*  ASSUME D=1/3*(TRANSPORT CORRECTED)
+*  NO DIRECTIONAL EFFECT
+*  THEN  USE STRD=1/3*DIFF
+*----
+        IF(RECXSV(IGC,17) .EQ. 0.0 .OR.
+     >     RECXSV(IGC,18) .EQ. 0.0 .OR.
+     >     RECXSV(IGC,19) .EQ. 0.0 .OR.
+     >     RECXSV(IGC,19) .EQ. 0.0 ) THEN
+          RECXSV(IGC,17)=RECXSV(IGC,1)-RECXSV(IGC,2)
+          RECXSV(IGC,18)=0.0
+          RECXSV(IGC,19)=0.0
+          RECXSV(IGC,20)=0.0
+        ELSE
+          RECXSV(IGC,17)=1.0/(3.0*RECXSV(IGC,17))
+          RECXSV(IGC,18)=1.0/(3.0*RECXSV(IGC,18))
+          RECXSV(IGC,19)=1.0/(3.0*RECXSV(IGC,19))
+          RECXSV(IGC,20)=1.0/(3.0*RECXSV(IGC,20))
+        ENDIF
+      ENDDO
+*----
+*  FISSION CROSS SECTION
+*----
+      TKEY1(2)='MTR       '
+      TKEY2(2)='FEWGROUPS '
+      TKEY1(1)='CELLAV    '
+      TKEY2(1)='SIGMAF    '
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1 ,TKEY2 ,
+     >            NBE   )
+      IF( NBE .NE. NGMTR ) CALL XABORT(NAMSBR//
+     >': CANNOT FIND '//TKEY1(1)//' '//TKEY2(1))
+      READ(IFT16) RKEY1,RKEY2,NBE,(RECTMP(IGR,4),IGR=1,NGMTR)
+      IF(IPRINT .GE. 100) THEN
+        WRITE(IOUT,6100) TKEY2(1)
+        WRITE(IOUT,6110) (RECTMP(IGR,4),IGR=1,NGMTR)
+      ENDIF
+*----
+*  CONDENSE FISSION CROSS SECTION
+*  OVER CPO GROUPS
+*----
+      IGF=0
+      DO IGC=1,NGCCPO
+        IGD=IGF+1
+        IGF=IFGMTR(IGC)
+        DO IGR=IGD,IGF
+          RECXSV(IGC, 4)=RECXSV(IGC, 4)
+     >                  +RECTMP(IGR,4)*RECTMP(IGR,1)
+        ENDDO
+      ENDDO
+*----
+*  BURNUP INFORMATION
+*----
+      TKEY1(1)='CELLAV    '
+      TKEY2(1)='AVG-ENERGY'
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1 ,TKEY2 ,
+     >            NBE   )
+      IF( NBE .EQ. 5 ) THEN
+        READ(IFT16) RKEY1,RKEY2,NBE,RTIME,
+     >              BRNTMP(3),BRNTMP(1),BRNTMP(2)
+        IF(IPRINT .GE. 10) THEN
+          WRITE(IOUT,6010) RTIME,BRNTMP(3),BRNTMP(1),BRNTMP(2)
+        ENDIF
+        BRNIRR(1)=BRNTMP(1)
+        BRNIRR(2)=BRNTMP(2)
+        BRNIRR(3)=WSMEV*BRNTMP(3)
+      ENDIF
+      IF(IPRINT .GE. 10) THEN
+        WRITE(IOUT,6001)
+      ENDIF
+      RETURN
+*----
+*  PRINT FORMAT
+*----
+ 6000 FORMAT(1X,5('*'),' OUTPUT FROM ',A6,1X,5('*'))
+ 6001 FORMAT(1X,30('*'))
+ 6010 FORMAT(6X,'BURNUP IRRADIATION '/1P,
+     >       6X,'TIME    (DAYS)     = ',E10.3/
+     >       6X,'ENERGY  (MEV)      = ',E10.3/
+     >       6X,'BURNUP  (MWD/T)    = ',E10.3/
+     >       6X,'IRRADIATION (N/KB) = ',E10.3)
+ 6100 FORMAT(6X,'CELLAV MAIN TRANSPORT GROUP ',A10)
+ 6110 FORMAT(1P,10(2X,E10.3))
+      END
diff --git a/Donjon/src/T16REC.f b/Donjon/src/T16REC.f
new file mode 100644
index 0000000..b7cd63a
--- /dev/null
+++ b/Donjon/src/T16REC.f
@@ -0,0 +1,62 @@
+*DECK T16REC
+      SUBROUTINE T16REC(IFT16 ,IPRINT,INEXTR)
+*
+*----
+*
+*Purpose:
+*  Locate next set of records on tape16.
+*
+*Author(s):
+* G. Marleau
+*
+*Parameters: input
+* IFT16   tape16 file unit.
+* IPRINT  print level where:
+*         =0 for no print; >=  1 print processing option.
+* INEXTR  next record set to read.
+*
+*----
+*
+      IMPLICIT         NONE
+      INTEGER          IFT16,IPRINT,INEXTR
+*----
+*  T16 PARAMETERS
+*----
+      INTEGER          MAXKEY
+      PARAMETER       (MAXKEY=3)
+      CHARACTER        TKEY1(MAXKEY)*10,TKEY2(MAXKEY)*10,
+     >                 RKEY1*10,RKEY2*10
+      INTEGER          NKEY,IOPT,NBE,NSKIPR,ISKIPR
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER          IOUT
+      CHARACTER        NAMSBR*6
+      PARAMETER       (IOUT=6,NAMSBR='T16REC')
+*----
+*  REWIND AND SKIP FIRST INEXTR-1 SETS OF RECORDS
+*----
+      REWIND(IFT16)
+      NSKIPR=INEXTR
+      TKEY1(1)='MTR       '
+      TKEY2(1)='FEWGROUPS '
+      NKEY=1
+      IOPT=-1
+      DO ISKIPR=1,NSKIPR
+        CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1 ,TKEY2 ,
+     >              NBE   )
+        IF(NBE .EQ. -1) THEN
+          WRITE(IOUT,9000) NAMSBR,TKEY1(1),TKEY2(1),INEXTR
+          CALL XABORT(NAMSBR//': INVALID RECORD NUMBER ON TAPE16')
+        ENDIF
+        READ(IFT16) RKEY1,RKEY2,NBE
+      ENDDO
+      RETURN
+*----
+*  ABORT FORMAT
+*----
+ 9000 FORMAT(1X,A6,1X,7('*'),' ERROR ',7('*')/
+     >       8X,I6,' TAPE16 RECORD WITH KEYS =',2(A10,2X),
+     >       'NOT FOUND'/
+     >       8X,21('*'))
+      END
diff --git a/Donjon/src/T16RRE.f b/Donjon/src/T16RRE.f
new file mode 100644
index 0000000..730364b
--- /dev/null
+++ b/Donjon/src/T16RRE.f
@@ -0,0 +1,294 @@
+*DECK T16RRE
+      SUBROUTINE T16RRE(IFT16 ,IPRINT,NGCCPO,NGMTR ,IFGMTR,NVXSR ,
+     >                  NMXSR ,IMIREG,VELMTR,B2CRI ,BRNIRR,FLXINT,
+     >                  OVERV,RECXSV,RECXSM,RECTMP,RECSCA)
+*
+*----
+*
+*Purpose:
+*  Read tape16 REGION cross sections at a specific burnup.
+*
+*Author(s):
+* G. Marleau
+*
+*Parameters: input
+* IFT16   tape16 file unit.
+* IPRINT  print level where:
+*         =0 for no print; >=  1 print processing option.
+* NGCCPO  number of edit groups.
+* NGMTR   number of main transport groups.
+* IFGMTR  fewgroups for main transport.
+* NVXSR   number of vector cross sections.
+* NMXSR   number of matrix cross sections.
+* IMIREG  mixture update identifier where
+*          =0 do not update;
+*          =-1 update using CELLAV information;
+*          > 0 update using specified region number.
+* VELMTR  velocity for main transport.
+* B2CRI   critical bucklings.
+* FLXINT  volume integrated fluxes.
+* OVERV   1/V cross sections.
+*
+*Parameters: output
+* BRNIRR  burnup and irradiation.
+* RECXSV  vector cross sections.
+* RECXSM  matrix cross sections.
+* RECTMP  dummy vector cross sections.
+* RECSCA  dummy matrix cross sections.
+*
+*----
+*
+      IMPLICIT         NONE
+      INTEGER          IFT16,IPRINT,NGCCPO,NGMTR,NVXSR,NMXSR,IMIREG
+      INTEGER          IFGMTR(NGCCPO)
+      REAL             VELMTR(NGMTR),B2CRI(3),BRNIRR(3),
+     >                 FLXINT(NGCCPO),OVERV(NGCCPO),
+     >                 RECXSV(NGCCPO,NVXSR+NMXSR),
+     >                 RECXSM(NGCCPO,NGCCPO,NMXSR),
+     >                 RECTMP(NGMTR,4),RECSCA(NGMTR,NGMTR)    
+*----
+*  T16 PARAMETERS
+*----
+      INTEGER          MAXKEY
+      PARAMETER       (MAXKEY=2)
+      CHARACTER        TKEY1(MAXKEY)*10,TKEY2(MAXKEY)*10,
+     >                 RKEY1*10,RKEY2*10
+      INTEGER          NKEY,IOPT,NBE,NID,NJD
+*----
+*  LOCAL VARIABLES
+*  WSMEV FACTOR TO TRANSFORM MEV IN JOULES (WS)
+*----
+      INTEGER          IOUT
+      CHARACTER        NAMSBR*6
+      REAL             WSMEV
+      PARAMETER       (IOUT=6,NAMSBR='T16RRE',WSMEV=1.602189E-13)
+      INTEGER          IREG,IGR,IGC,IGD,IGF,JGR,JGC,JGD,JGF,
+     >                 NREGON
+      REAL             VOLUME,BRNTMP(3),RTIME
+*----
+*  INITIALIZE CROSS SECTION VECTORS
+*----
+      IF(IPRINT .GE. 10) THEN
+        WRITE(IOUT,6000) NAMSBR
+      ENDIF
+      RECXSV(:NGCCPO,:NVXSR+NMXSR)=0.0
+      RECXSM(:NGCCPO,:NGCCPO,:NMXSR)=0.0
+*----
+*  LOCATE NEXT REGION DIMENSIONS RECORD
+*  AND READ NREGON
+*----
+      IOPT=0
+      TKEY1(1)='REGION    '
+      TKEY2(1)='DIMENSIONS'
+      NKEY=1
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1 ,TKEY2 ,
+     >            NBE   )
+      IF( NBE .NE. 2 ) CALL XABORT(NAMSBR//
+     >': CANNOT FIND '//TKEY1(1)//' '//TKEY2(1))
+      READ(IFT16) RKEY1,RKEY2,NBE,NREGON
+      TKEY1(2)='CELLAV    '
+      TKEY2(2)='NGROUPS   '
+      NKEY=2
+      DO IREG=1,NREGON
+*----
+*  REGIONAL FLUX
+*----
+        TKEY1(1)='REGION    '
+        TKEY2(1)='FLUX      '
+        CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1 ,TKEY2 ,
+     >              NBE   )
+        IF( NBE .NE. 3+NGMTR ) CALL XABORT(NAMSBR//
+     >  ': CANNOT FIND '//TKEY1(1)//' '//TKEY2(1))
+        IF(IMIREG .EQ. IREG) THEN
+          READ(IFT16) RKEY1,RKEY2,NBE,NID,NJD,VOLUME,
+     >               (RECTMP(IGR,1),IGR=1,NGMTR)
+          IF(IPRINT .GE. 100) THEN
+            WRITE(IOUT,6100) TKEY2(1)
+            WRITE(IOUT,6110) (RECTMP(IGR,1),IGR=1,NGMTR)
+          ENDIF
+*----
+*  TREAT ALL CONDENSED GROUPS
+*----
+          TKEY1(1)='REGION    '
+          TKEY2(1)='SIGMAS    '
+          IGF=0
+          DO IGC=1,NGCCPO
+            IGD=IGF+1
+            IGF=IFGMTR(IGC)
+*----
+*  FLUX AND 1/V CROSS SECTION CONDENSATION
+*----
+            DO IGR=IGD,IGF
+              FLXINT(IGC)=FLXINT(IGC)+RECTMP(IGR,1)
+              OVERV(IGC)=OVERV(IGC)+RECTMP(IGR,1)/VELMTR(IGR)
+            ENDDO
+            IF(FLXINT(IGC) .NE. 0.0) THEN
+              OVERV(IGC)=OVERV(IGC)/FLXINT(IGC)
+              DO IGR=IGD,IGF
+                RECTMP(IGR,1)=RECTMP(IGR,1)/FLXINT(IGC)
+              ENDDO
+              FLXINT(IGC)=FLXINT(IGC)*VOLUME
+            ENDIF
+*----
+*  LOOP OBER MTR GROUP ASSOCIATED WITH CPO GROUPS
+*----
+            DO IGR=IGD,IGF
+*----
+*  READ CROSS SECTIONS
+*----
+              CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1 ,TKEY2 ,
+     >                    NBE   )
+              IF( NBE .NE. 4+NGMTR ) CALL XABORT(NAMSBR//
+     >        ': CANNOT FIND '//TKEY1(1)//' '//TKEY2(1))
+              READ(IFT16) RKEY1,RKEY2,NBE,
+     >                    RECTMP(IGR,4),RECTMP(IGR,3),RECTMP(IGR,2),
+     >                    (RECSCA(IGR,JGR),JGR=1,NGMTR)
+              IF(IPRINT .GE. 100) THEN
+                WRITE(IOUT,6101) TKEY2(1),IGR
+                WRITE(IOUT,6110)
+     >            RECTMP(IGR,4),RECTMP(IGR,3),RECTMP(IGR,2),
+     >           (RECSCA(IGR,JGR),JGR=1,NGMTR)
+              ENDIF
+*----
+*  ABSORPTION, NU-FISSION AND TRANSPORT SECTION CONDENSATION
+*----
+              RECXSV(IGC, 2)=RECXSV(IGC, 2)
+     >                      +RECTMP(IGR,2)*RECTMP(IGR,1)
+              RECXSV(IGC, 3)=RECXSV(IGC, 3)
+     >                      +RECTMP(IGR,3)*RECTMP(IGR,1)
+              RECXSV(IGC,15)=RECXSV(IGC,15)
+     >                      +RECTMP(IGR,4)*RECTMP(IGR,1)
+*----
+*  SCATTERING SECTION CONDENSATION
+*----
+              JGF=0
+              DO JGC=1,NGCCPO
+                JGD=JGF+1
+                JGF=IFGMTR(JGC)
+                DO JGR=JGD,JGF
+                  RECXSM(JGC,IGC,1)=RECXSM(JGC,IGC,1)
+     >                             +RECSCA(IGR,JGR)*RECTMP(IGR,1)
+                  RECXSV(IGC,21)=RECXSV(IGC,21)
+     >                          +RECSCA(IGR,JGR)*RECTMP(IGR,1)
+                ENDDO
+              ENDDO
+            ENDDO
+*----
+*  TOTAL AND TRANSPORT CORRECTION
+*----
+            RECXSV(IGC,1)=RECXSV(IGC,15)+RECXSV(IGC,21)
+            RECXSV(IGC,2)=RECXSV(IGC,1)-RECXSV(IGC,2)
+          ENDDO
+          IF( NBE .EQ. 2*NGMTR ) THEN
+            IF(IPRINT .GE. 100) THEN
+              RECTMP(IGR,3)=RECTMP(IGR,2)
+              WRITE(IOUT,6100) TKEY2(1)
+              WRITE(IOUT,6110) (RECTMP(IGR,2),IGR=1,NGMTR)
+              WRITE(IOUT,6110) (RECTMP(IGR,3),IGR=1,NGMTR)
+            ENDIF
+*----
+*  CONDENSE DIFFUSION COEFFICIENTS
+*  COMPUTE STRD=1/3*DIFF
+*----
+            IGF=0
+            DO IGC=1,NGCCPO
+              IGD=IGF+1
+              IGF=IFGMTR(IGC)
+              DO IGR=IGD,IGF
+                RECXSV(IGC,17)=RECXSV(IGC,17)+RECTMP(IGR,1)
+     >             *(B2CRI(1)*RECTMP(IGR,2)+B2CRI(2)*RECTMP(IGR,3))
+                RECXSV(IGC,18)=RECXSV(IGC,18)
+     >                        +RECTMP(IGR,1)*RECTMP(IGR,2)
+                RECXSV(IGC,19)=RECXSV(IGC,19)
+     >                        +RECTMP(IGR,1)*RECTMP(IGR,2)
+                RECXSV(IGC,20)=RECXSV(IGC,20)
+     >                        +RECTMP(IGR,1)*RECTMP(IGR,3)
+              ENDDO
+              IF(RECXSV(IGC,17) .EQ. 0.0 .OR.
+     >           RECXSV(IGC,18) .EQ. 0.0 .OR.
+     >           RECXSV(IGC,19) .EQ. 0.0 .OR.
+     >           RECXSV(IGC,19) .EQ. 0.0 ) THEN
+                RECXSV(IGC,17)=RECXSV(IGC,1)-RECXSV(IGC,2)
+                RECXSV(IGC,18)=0.0
+                RECXSV(IGC,19)=0.0
+                RECXSV(IGC,20)=0.0
+              ELSE
+                RECXSV(IGC,17)=1.0/(3.0*RECXSV(IGC,17))
+                RECXSV(IGC,18)=1.0/(3.0*RECXSV(IGC,18))
+                RECXSV(IGC,19)=1.0/(3.0*RECXSV(IGC,19))
+                RECXSV(IGC,20)=1.0/(3.0*RECXSV(IGC,20))
+              ENDIF
+            ENDDO
+          ELSE
+            DO IGC=1,NGCCPO
+              RECXSV(IGC,17)=1.0/(3.0*(RECXSV(IGC,1)-RECXSV(IGC,2)))
+              RECXSV(IGC,18)=RECXSV(IGC,17)
+              RECXSV(IGC,19)=RECXSV(IGC,17)
+              RECXSV(IGC,20)=RECXSV(IGC,17)
+            ENDDO
+          ENDIF
+          GO TO 105
+        ELSE
+          READ(IFT16) RKEY1,RKEY2,NBE
+        ENDIF
+      ENDDO
+ 105  CONTINUE
+*----
+*  READ FISSION SPECTRUM
+*----
+      TKEY1(1)='CELLAV    '
+      TKEY2(1)='FISSPECT  '
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1 ,TKEY2 ,
+     >            NBE   )
+      IF( NBE .NE. NGMTR ) CALL XABORT(NAMSBR//
+     >': CANNOT FIND '//TKEY1(1)//' '//TKEY2(1))
+      READ(IFT16) RKEY1,RKEY2,NBE,(RECTMP(IGR,4),IGR=1,NGMTR)
+*----
+*  CONDENSE FISSION SPECTRUM OVER CPO GROUPS
+*----
+      IGF=0
+      DO IGC=1,NGCCPO
+        IGD=IGF+1
+        IGF=IFGMTR(IGC)
+        DO IGR=IGD,IGF
+          RECXSV(IGC, 5)=RECXSV(IGC,5)+RECTMP(IGR,4)
+        ENDDO
+      ENDDO
+*----
+*  BURNUP INFORMATION
+*----
+      TKEY1(2)='MTR       '
+      TKEY2(2)='FEWGROUPS '
+      TKEY1(1)='CELLAV    '
+      TKEY2(1)='AVG-ENERGY'
+      CALL T16FND(IFT16 ,IPRINT,IOPT  ,NKEY  ,TKEY1 ,TKEY2 ,
+     >            NBE   )
+      IF( NBE .EQ. 5 ) THEN
+        READ(IFT16) RKEY1,RKEY2,NBE,RTIME,
+     >              BRNTMP(3),BRNTMP(1),BRNTMP(2)
+        IF(IPRINT .GE. 10) THEN
+          WRITE(IOUT,6010) RTIME,BRNTMP(3),BRNTMP(1),BRNTMP(2)
+        ENDIF
+        BRNIRR(1)=BRNTMP(1)
+        BRNIRR(2)=BRNTMP(2)
+        BRNIRR(3)=WSMEV*BRNTMP(3)
+      ENDIF
+      IF(IPRINT .GE. 10) THEN
+        WRITE(IOUT,6001)
+      ENDIF
+      RETURN
+*----
+*  PRINT FORMAT
+*----
+ 6000 FORMAT(1X,5('*'),' OUTPUT FROM ',A6,1X,5('*'))
+ 6001 FORMAT(1X,30('*'))
+ 6010 FORMAT(6X,'BURNUP IRRADIATION '/1P,
+     >       6X,'TIME    (DAYS)     = ',E10.3/
+     >       6X,'ENERGY  (MEV)      = ',E10.3/
+     >       6X,'BURNUP  (MWD/T)    = ',E10.3/
+     >       6X,'IRRADIATION (N/KB) = ',E10.3)
+ 6100 FORMAT(6X,'CELLAV MAIN TRANSPORT GROUP ',A10)
+ 6101 FORMAT(6X,'CELLAV MAIN TRANSPORT GROUP ',A10,
+     >       6X,'GROUP  =',I10)
+ 6110 FORMAT(1P,10(2X,E10.3))
+      END
diff --git a/Donjon/src/T16WDS.f b/Donjon/src/T16WDS.f
new file mode 100644
index 0000000..537e547
--- /dev/null
+++ b/Donjon/src/T16WDS.f
@@ -0,0 +1,157 @@
+*DECK T16WDS
+      SUBROUTINE T16WDS(IPCPO ,NGCCPO,NVXSR ,NMXSR ,IBURN ,EFJ   ,
+     >                  NAMDXS,ITYXS ,FLXINT,FLXDIS,OVERV ,RECXSV,
+     >                  IDRXSM,RECXSM,RECSCA)
+*
+*----
+*
+*Purpose:
+*  Write properties to CPO data structure.
+*
+*Author(s):
+* G. Marleau
+*
+*Parameters: input
+* IPCPO   pointer to CPO data structure.
+* NGCCPO  number of edit groups.
+* NVXSR   number of vector cross sections.
+* NMXSR   number of matrix cross sections.
+* IBURN   burnup step.
+* EFJ     energy of fission in joules.
+* NAMDXS  name of vector cross sections.
+* ITYXS   types of cross sections saved.
+* FLXINT  volume integrated fluxes.
+* FLXDIS  flux disadvantage factor.
+* OVERV   1/V cross sections.
+* RECXSV  vector cross sections.
+* IDRXSM  compression vector for matrix cross sections.
+* RECXSM  matrix cross sections.
+* RECSCA  dummy matrix cross sections.
+*
+*----
+*
+      USE GANLIB
+      IMPLICIT         NONE
+      TYPE(C_PTR)      IPCPO
+      INTEGER          NGCCPO,NVXSR,NMXSR,IBURN
+      CHARACTER        NAMDXS(NVXSR+NMXSR)*12
+      INTEGER          IDRXSM(NGCCPO,2),ITYXS(NVXSR+NMXSR)
+      REAL             EFJ,FLXINT(NGCCPO),
+     >                 FLXDIS(NGCCPO),OVERV(NGCCPO),
+     >                 RECXSV(NGCCPO,NVXSR+NMXSR),
+     >                 RECXSM(NGCCPO,NGCCPO,NMXSR),
+     >                 RECSCA(NGCCPO*NGCCPO)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER          IOUT,ILCMUP,ILCMDN
+      CHARACTER        NAMSBR*6
+      PARAMETER       (IOUT=6,ILCMUP=1,ILCMDN=2,NAMSBR='T16WDS')
+      CHARACTER        NAMBRN*12,NAMMAC*12,NAMLEG*2
+      INTEGER          IVXS,IMXS,IGTO,IGFROM,IGMIN,IGMAX,NXSCMP
+      REAL             DENMAC
+*----
+*  SET UP BURUP DIRECTORY
+*----
+      WRITE(NAMBRN,'(A8,I4)') 'BURN    ',IBURN
+      CALL LCMSIX(IPCPO ,NAMBRN,ILCMUP)
+*----
+*  SAVE ISOTOPES DENSITY, ENERGY, INTEGRATED FLUX,
+*  DISADVANTAGE FACTOR AND OVERV ON MAIN DIRECTORY
+*----
+      DENMAC=1.0
+      CALL LCMPUT(IPCPO ,'ISOTOPESDENS',     1,2,DENMAC)
+      CALL LCMPUT(IPCPO ,'ISOTOPES-EFJ',     1,2,EFJ)
+      CALL LCMPUT(IPCPO ,'FLUX-INTG   ',NGCCPO,2,FLXINT)
+      CALL LCMPUT(IPCPO ,'FLUXDISAFACT',NGCCPO,2,FLXDIS)
+      CALL LCMPUT(IPCPO ,'OVERV       ',NGCCPO,2,OVERV)
+      NAMMAC='MACR        '
+      CALL LCMSIX(IPCPO ,NAMMAC,ILCMUP)
+*----
+*  FIND IF VECTOR XS NOT ALL 0.0
+*  AND INITIALIZE ITYXS ACCORDINGLY
+*  SAVE XS
+*----
+      DO IVXS=1,NVXSR
+        ITYXS(IVXS)=0
+        DO IGFROM=1,NGCCPO
+          IF(RECXSV(IGFROM,IVXS) .NE. 0.0) THEN
+            ITYXS(IVXS)=1
+            CALL LCMPUT(IPCPO ,NAMDXS(IVXS),
+     >                  NGCCPO,2,RECXSV(1,IVXS))
+          ENDIF
+        ENDDO
+      ENDDO
+*----
+*  FIND IF SCATTERING XS NOT ALL 0.0
+*  AND INITIALIZE ITYXS ACCORDINGLY
+*----
+      DO IMXS=1,NMXSR
+        ITYXS(IMXS+NVXSR)=0
+        DO IGTO=1,NGCCPO
+          DO IGFROM=1,NGCCPO
+            IF(RECXSM(IGTO,IGFROM,IMXS) .NE. 0.0) THEN
+              ITYXS(IMXS+NVXSR)=1
+              CALL LCMPUT(IPCPO ,NAMDXS(IMXS+NVXSR),
+     >                    NGCCPO,2,RECXSV(1,IMXS+NVXSR))
+              GO TO 105
+            ENDIF
+          ENDDO
+        ENDDO
+ 105    CONTINUE
+      ENDDO
+*----
+*  SAVE ITYXS
+*----
+      CALL LCMPUT(IPCPO ,'XS-SAVED    ',NVXSR+NMXSR,1,ITYXS)
+*----
+*  COMPRESS SCATTERING MATRIX
+*  RECXSM(IGTO,IGFROM,IMXS) REPRESENT SCATTERING CROSS SECTION
+*    FROM GROUP "IGFROM" TO GROUP "IGTO"
+*  IDRXSM(IGTO,1) IS MAXIMUM GROUP NUMBER
+*    WITH SCATTERING TO "IGTO" GROUP
+*  IDRXSM(IGTO,2) IS NUMBER OF GROUPS
+*    WITH SCATTERING TO "IGTO" GROUP
+*  RECSCA(IX) IS COMPRESSED SCATTERING MATRIX
+*  IX CAN BE LOCALIZED IN RECXSM(IGTO,IGFROM) USING
+*  IF(IGTO=1) THEN
+*    IPOSD=1
+*  ELSE
+*    IPOSD=1+SUM( IDRXSM(IGF,2) , IGF=1,IGTO-1)
+*  ENDIF
+*  IF(IGFROM.GT.IDRXSM(IGTO,1)) THEN
+*    XSSCMP NOT STORED
+*  ELSE IF(IGFROM.LT.IDRXSM(IGTO,1)-IDRXSM(IGTO,2)+1) THEN
+*    XSSCMP NOT STORED
+*  ELSE
+*    IX=IPOSD+IDRXSM(IGTO,1)-IGFROM
+*    RECSCA(IX)=RECXSM(IGTO,IGFROM)
+*  ENDIF
+*----
+      DO IMXS=1,NMXSR
+        NXSCMP=0
+        DO IGTO=1,NGCCPO
+          IGMIN=IGTO
+          IGMAX=IGTO
+          DO IGFROM=1,NGCCPO
+            IF(RECXSM(IGTO,IGFROM,IMXS) .NE. 0.0) THEN
+              IGMIN=MIN(IGMIN,IGFROM)
+              IGMAX=MAX(IGMAX,IGFROM)
+            ENDIF
+          ENDDO
+          IDRXSM(IGTO,1)=IGMAX
+          IDRXSM(IGTO,2)=IGMAX-IGMIN+1
+          DO IGFROM=IGMAX,IGMIN,-1
+            NXSCMP=NXSCMP+1
+            RECSCA(NXSCMP)=RECXSM(IGTO,IGFROM,IMXS)
+          ENDDO   
+        ENDDO
+        WRITE(NAMLEG,'(I2)') IMXS-1
+        CALL LCMPUT(IPCPO,'NJJ '//NAMLEG//'      ',NGCCPO,1,IDRXSM(1,1))
+        CALL LCMPUT(IPCPO,'IJJ '//NAMLEG//'      ',NGCCPO,1,IDRXSM(1,2))
+        CALL LCMPUT(IPCPO,'SCAT'//NAMLEG//'      ',NXSCMP,2,RECSCA)
+      ENDDO
+      CALL LCMSIX(IPCPO ,NAMMAC,ILCMDN)
+      CALL LCMSIX(IPCPO ,NAMBRN,ILCMDN)
+      RETURN
+      END
diff --git a/Donjon/src/TAVG.f b/Donjon/src/TAVG.f
new file mode 100644
index 0000000..b2f84bb
--- /dev/null
+++ b/Donjon/src/TAVG.f
@@ -0,0 +1,151 @@
+*DECK TAVG
+      SUBROUTINE TAVG(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Perform computations according to the time-average model.
+* 
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* D. Sekki
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The TAVG: module specification is: 
+* FMAP := TAVG: FMAP POWER :: (desctavg) ;
+* where
+*   FMAP : name of a \emph{fmap} object, that will be updated by the TAVG: 
+*     module. The FMAP object must contain the average exit burnups and 
+*     refuelling schemes of channels.
+*   POWER name of a \emph{power} object containing the channel and bundle 
+*     powers, previously computed by the FLPOW: module. The channel and bundle 
+*     powers are used by the TAVG: module to compute the normalized axial 
+*     power-shape over each channel. 
+*   (desctavg) : structure describing the input data to the TAVG: module.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(NSTATE=40,IOUT=6)
+      CHARACTER TEXT*12,HSIGN*12
+      INTEGER ISTATE(NSTATE)
+      DOUBLE PRECISION DFLOT
+      LOGICAL LEXIT,LSHAP
+      TYPE(C_PTR) IPMAP,IPPOW,JPMAP
+*----
+*  PARAMETER VALIDATION
+*----
+      IF(NENTRY.NE.2)CALL XABORT('@TAVG: TWO PARAMETERS EXPECTED.')
+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2))CALL XABORT(' '
+     1 //'@TAVG: LCM OBJECT EXPECTED AT LHS.')
+      IF(JENTRY(1).NE.1)CALL XABORT('@TAVG: MODIFICATION MODE '
+     1 //'FOR L_MAP EXPECTED.')
+      CALL LCMGTC(KENTRY(1),'SIGNATURE',12,HSIGN)
+      TEXT=HENTRY(1)
+      IF(HSIGN.NE.'L_MAP')CALL XABORT('@TAVG: SIGNATURE '
+     1 //' OF '//TEXT//' IS '//HSIGN//'. L_MAP EXPECTED.')
+      IPMAP=KENTRY(1)
+      IF((IENTRY(2).NE.1).AND.(IENTRY(2).NE.2))CALL XABORT(' '
+     1 //'@TAVG: LCM OBJECT EXPECTED AT RHS.')
+      CALL LCMGTC(KENTRY(2),'SIGNATURE',12,HSIGN)
+      TEXT=HENTRY(2)
+      IF(HSIGN.NE.'L_POWER')CALL XABORT('@TAVG: SIGNATURE '
+     1 //' OF '//TEXT//' IS '//HSIGN//'. L_POWER EXPECTED.')
+      IF(JENTRY(2).NE.2)CALL XABORT('@TAVG: READ-ONLY MODE '
+     1 //'FOR L_POWER EXPECTED.')
+      IPPOW=KENTRY(2)
+*----
+*  READ INPUT DATA
+*----
+      IMPX=1
+      ARP=0.5
+      LEXIT=.FALSE.
+      LSHAP=.FALSE.
+*     PRINTING INDEX
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('@TAVG: CHARACTER DATA EXPECTED(1).')
+      IF(TEXT.NE.'EDIT')GOTO 10
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.1)CALL XABORT('@TAVG: INTEGER DATA EXPECTED.')
+      IMPX=MAX(0,NITMA)
+*     AX-SHAPE OPTION
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('@TAVG: CHARACTER DATA EXPECTED(2).')
+   10 IF(TEXT.NE.'AX-SHAPE')GOTO 20
+      LSHAP=.TRUE.
+*     RELAXATION PARAMETER
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('@TAVG: CHARACTER DATA EXPECTED(3).')
+   20 IF(TEXT.NE.'RELAX')GOTO 30
+      CALL REDGET(ITYP,NITMA,ARP,TEXT,DFLOT)
+      IF(ITYP.NE.2)CALL XABORT('@TAVG: REAL DATA EXPECTED.')
+      IF(ARP.LE.0.)CALL XABORT('@TAVG: POSITIVE AND NON-ZERO RELAX'
+     1 //'ATION PARAMETER EXPECTED.')
+*     B-EXIT OPTION
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('@TAVG: CHARACTER DATA EXPECTED(4).')
+   30 IF(TEXT.NE.'B-EXIT')GOTO 40
+      LEXIT=.TRUE.
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('@TAVG: CHARACTER DATA EXPECTED(5).')
+   40 IF(TEXT.NE.';')CALL XABORT('@TAVG: END TO MODULE ; EXPECTED.')
+      IF((.NOT.LSHAP).AND.(.NOT.LEXIT))CALL XABORT('@TAVG: MODULE'
+     1 //' OPTION WAS NOT SPECIFIED.')
+*----
+*  RECOVER INFORMATION
+*----
+      ISTATE(:NSTATE)=0
+      CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+      NB=ISTATE(1)
+      NCH=ISTATE(2)
+      NCOMB=ISTATE(3)
+*     FUEL-MAP GEOMETRY
+      JPMAP=LCMGID(IPMAP,'GEOMAP')
+      ISTATE(:NSTATE)=0
+      CALL LCMGET(JPMAP,'STATE-VECTOR',ISTATE)
+      NX=ISTATE(3)
+      NY=ISTATE(4)
+      NZ=ISTATE(5)
+*     CHECK EXISTING DATA
+      CALL LCMLEN(IPMAP,'BURN-AVG',LENGT,ITYP)
+      IF(LENGT.EQ.0)CALL XABORT('@TAVG: MISSING BURNUP DATA IN FUEL'
+     1 //'-MAP OBJECT.')
+      CALL LCMLEN(IPMAP,'REF-SCHEME',LENGT,ITYP)
+      IF(LENGT.EQ.0)CALL XABORT('@TAVG: MISSING REF-SCHEME DATA IN '
+     1 //'FUEL-MAP OBJECT.')
+      CALL LCMLEN(IPPOW,'POWER-CHAN',LENGT,ITYP)
+      IF(LENGT.EQ.0)CALL XABORT('@TAVGCL: MISSING POWER-CHAN DATA I'
+     1 //'N L_POWER OBJECT.')
+*----
+*  PERFORM CALCULATION
+*----
+      IF(LSHAP)CALL TAVGCL(IPMAP,IPPOW,NCH,NB,NCOMB,NX,NY,NZ,ARP,IMPX)
+      IF(LEXIT)CALL TAVGEX(IPMAP,IPPOW,NCH,NCOMB,NX,NY,NZ,IMPX)
+      IF(IMPX.GT.2)CALL LCMLIB(IPMAP)
+      RETURN
+      END
diff --git a/Donjon/src/TAVGCL.f b/Donjon/src/TAVGCL.f
new file mode 100644
index 0000000..2f31a27
--- /dev/null
+++ b/Donjon/src/TAVGCL.f
@@ -0,0 +1,175 @@
+*DECK TAVGCL
+      SUBROUTINE TAVGCL(IPMAP,IPPOW,NCH,NB,NCOMB,NX,NY,NZ,ARP,IMPX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute burnup limits over the fuel lattice for the time-average
+* integration, based on the axial power shape over each channel.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* D. Sekki, R. Chambon
+*
+*Parameters: input/output
+* IPMAP   pointer to fuel-map information.
+* IPPOW   pointer to power information.
+* NCH     number of reactor channels.
+* NB      number of fuel bundles per channel.
+* NCOMB   number of combustion zones.
+* NX      number of elements along x-axis in fuel map.
+* NY      number of elements along y-axis in fuel map.
+* NZ      number of elements along z-axis in fuel map.
+* ARP     relaxation parameter for shape convergence.
+* IMPX    printing index (=0 for no print).
+*
+*Parameters: scratch
+* BURN0   low burnup integration limits.
+* BURN1   upper burnup integration limits.
+*
+*----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAP,IPPOW
+      INTEGER NCH,NB,NCOMB,NX,NY,NZ,IMPX
+      REAL ARP
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(IOUT=6)
+      INTEGER MIX(NX*NY*NZ),NAMX(NX),NAMY(NY),
+     1 IVECT(NCOMB,NB),NSCH(NCH),BZONE(NCH),IGAR(NB)
+      REAL POWB(NCH,NB),POWC(NCH),PSI(NB),BVAL(NCOMB),SOLD(NCH,NB),
+     1 BURN0(NCH,NB),BURN1(NCH,NB),B0(NB),B1(NB),SNEW(NCH,NB)
+      CHARACTER TEXT*12,CHANX*2,CHANY*2
+      DOUBLE PRECISION PNUM,PDEN
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ICHMAP
+*----
+*  RECOVER INFORMATION
+*----
+      MIX(:NX*NY*NZ)=0
+      CALL LCMGET(IPMAP,'BMIX',MIX)
+*     CHANNEL NAMES
+      NAMX(:NX)=0
+      CALL LCMGET(IPMAP,'XNAME',NAMX)
+      NAMY(:NY)=0
+      CALL LCMGET(IPMAP,'YNAME',NAMY)
+*     COMBUSTION-ZONE INDEX
+      BZONE(:NCH)=0
+      CALL LCMGET(IPMAP,'B-ZONE',BZONE)
+*     AVERAGE EXIT BURNUPS
+      BVAL(:NCOMB)=0.0
+      CALL LCMGET(IPMAP,'BURN-AVG',BVAL)
+*     REFUELLING SCHEME
+      NSCH(:NCH)=0
+      CALL LCMGET(IPMAP,'REF-SCHEME',NSCH)
+*     REFUELLING VECTOR
+      IVECT(:NCOMB,:NB)=0
+      CALL LCMGET(IPMAP,'REF-VECTOR',IVECT)
+*     PREVIOUS AXIAL SHAPE
+      SOLD(:NCH,:NB)=0.0
+      CALL LCMGET(IPMAP,'AX-SHAPE',SOLD)
+*     CHANNEL POWERS
+      POWC(:NCH)=0.0
+      CALL LCMGET(IPPOW,'POWER-CHAN',POWC)
+*     BUNDLE POWERS
+      POWB(:NCH,:NB)=0.0
+      CALL LCMGET(IPPOW,'POWER-BUND',POWB)
+*----
+*  SET THE CHANNEL INDEX MAP
+*----
+      ALLOCATE(ICHMAP(NX,NY))
+      ICHMAP(:NX,:NY)=0
+      ICH=0
+      DO 35 J=1,NY
+      DO 30 I=1,NX
+      IEL=(J-1)*NX+I
+      DO 10 IZ=1,NZ
+      IF(MIX((IZ-1)*NX*NY+IEL).NE.0) GO TO 20
+  10  CONTINUE
+      GO TO 30
+  20  ICH=ICH+1
+      ICHMAP(I,J)=ICH
+  30  CONTINUE
+  35  CONTINUE
+      IF(ICH.NE.NCH) CALL XABORT('@TAVGCL: INVALID NUMBER OF CHANNELS')
+*----
+*  CALCULATION OVER EACH CHANNEL
+*----
+      IF(IMPX.GT.0)WRITE(IOUT,1005)
+      BURN0(:NCH,:NB)=0.0
+      BURN1(:NCH,:NB)=0.0
+      ICH=0
+      PNUM=0.0D0
+      PDEN=0.0D0
+      DO 45 J=1,NY
+      DO 40 I=1,NX
+      IF(ICHMAP(I,J).EQ.0)GOTO 40
+      ICH=ICH+1
+*     POWER-SHAPE
+      DO IB=1,NB
+        IF(POWC(ICH).EQ.0.0) CALL XABORT('TAVGCL: ZERO CHANNEL POWER.')
+        PSI(IB)=ARP*(POWB(ICH,IB)/POWC(ICH))+(1.-ARP)*SOLD(ICH,IB)
+        SNEW(ICH,IB)=PSI(IB)
+        PNUM=PNUM+(SNEW(ICH,IB)-SOLD(ICH,IB))**2
+        PDEN=PDEN+SNEW(ICH,IB)**2
+        IGAR(IB)=IVECT(BZONE(ICH),IB)
+      ENDDO
+      IBSH=ABS(NSCH(ICH))
+*     INTEGRATION LIMITS
+      CALL TAVGLM(NB,IBSH,BVAL(BZONE(ICH)),PSI,B0,B1,IGAR,NSCH(ICH))
+      DO IB=1,NB
+        BURN0(ICH,IB)=B0(IB)
+        BURN1(ICH,IB)=B1(IB)
+      ENDDO
+      IF(IMPX.GE.3) THEN
+*       PRINT BURNUP LIMITS
+        WRITE(TEXT,'(A9,I3.3)')'CHANNEL #',ICH
+        WRITE(CHANX,'(A2)') (NAMX(I))
+        WRITE(CHANY,'(A2)') (NAMY(J))
+        WRITE(IOUT,1000)TEXT,CHANY,CHANX,NSCH(ICH)
+        WRITE(IOUT,1001)'B0',(B0(IB),IB=1,NB)
+        WRITE(IOUT,1001)'B1',(B1(IB),IB=1,NB)
+      ENDIF
+   40 CONTINUE
+   45 CONTINUE
+*     AXIAL-SHAPE ERROR
+      EPS=REAL(SQRT(PNUM/PDEN))
+*----
+*  PRINT INFORMATION
+*----
+      IF(IMPX.GT.0)WRITE(IOUT,1002)EPS,ARP
+      IF(IMPX.GE.3) THEN
+*       PRINT SHAPE
+        WRITE(IOUT,1003)
+        DO ICH=1,NCH
+          WRITE(TEXT,'(A6,I3.3)')'CHAN #',ICH
+          WRITE(IOUT,1004)TEXT,(SNEW(ICH,IB),IB=1,NB)
+        ENDDO
+      ENDIF
+*----
+*  STORE INFORMATION
+*----
+      CALL LCMPUT(IPMAP,'BURN-BEG',NCH*NB,2,BURN0)
+      CALL LCMPUT(IPMAP,'BURN-END',NCH*NB,2,BURN1)
+      CALL LCMPUT(IPMAP,'EPS-AX',1,2,EPS)
+      CALL LCMPUT(IPMAP,'AX-SHAPE',NCH*NB,2,SNEW)
+      DEALLOCATE(ICHMAP)
+      RETURN
+*
+ 1000 FORMAT(/5X,A12,5X,'NAME:',1X,A2,A2,
+     1  5X,'REFUELLING SCHEME:',1X,I2)
+ 1001 FORMAT(A3,12(F8.1,1X))
+ 1002 FORMAT(1X,'AXIAL-SHAPE ERROR =>',1P,E13.6,5X,
+     1 'RELAXATION PARAMETER =>',E13.6/)
+ 1003 FORMAT(/20X,'** AXIAL SHAPE OVER EACH',
+     1  1X,'CHANNEL **'/)
+ 1004 FORMAT(1X,A10,(2X,12(F6.4,1X)))
+ 1005 FORMAT(/1X,'** COMPUTING BURNUP INTEG',
+     1 'RATION',1X,'LIMITS **'/)
+      END
diff --git a/Donjon/src/TAVGEX.f b/Donjon/src/TAVGEX.f
new file mode 100644
index 0000000..34a4f4e
--- /dev/null
+++ b/Donjon/src/TAVGEX.f
@@ -0,0 +1,109 @@
+*DECK TAVGEX
+      SUBROUTINE TAVGEX(IPMAP,IPPOW,NCH,NCOMB,NX,NY,NZ,IMPX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute the core-average exit burnup and channel refuelling rates.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki
+*
+*Parameters: input/output
+* IPMAP  pointer to fuel-map information.
+* IPPOW  pointer to power information.
+* NCH    number of reactor channels.
+* NCOMB  number of combustion zones.
+* NX     number of elements along x-axis in fuel map.
+* NY     number of elements along y-axis in fuel map.
+* NZ     number of elements along z-axis in fuel map.
+* IMPX   printing index (=0 for no print).
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAP,IPPOW
+      INTEGER NCH,NCOMB,NX,NY,NZ,IMPX
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(IOUT=6)
+      INTEGER MIX(NX*NY*NZ),BZONE(NCH),NSCH(NCH),NAMX(NX),NAMY(NY)
+      REAL BVAL(NCOMB),RATE(NCH),POWC(NCH)
+      DOUBLE PRECISION SUMR,SUMB
+      CHARACTER TEXT*12,CHANX*2,CHANY*2
+*----
+*  RECOVER INFORMATION
+*----
+      MIX(:NX*NY*NZ)=0
+      CALL LCMGET(IPMAP,'BMIX',MIX)
+*     CHANNEL POWERS
+      POWC(:NCH)=0.0
+      CALL LCMGET(IPPOW,'POWER-CHAN',POWC)
+*     REFUELLING SCHEME
+      NSCH(:NCH)=0
+      CALL LCMGET(IPMAP,'REF-SCHEME',NSCH)
+*     AVERAGE EXIT BURNUPS
+      BVAL(:NCOMB)=0.0
+      CALL LCMGET(IPMAP,'BURN-AVG',BVAL)
+*     COMBUSTION-ZONE INDEX
+      BZONE(:NCH)=0
+      CALL LCMGET(IPMAP,'B-ZONE',BZONE)
+*     CHANNEL NAMES
+      NAMX(:NX)=0
+      CALL LCMGET(IPMAP,'XNAME',NAMX)
+      NAMY(:NY)=0
+      CALL LCMGET(IPMAP,'YNAME',NAMY)
+*----
+*  CALCULATION OVER EACH CHANNEL
+*----
+      IF(IMPX.GT.0)WRITE(IOUT,1000)
+      RATE(:NCH)=0.0
+      IEL=0
+      ICH=0
+      SUMR=0.0D0
+      SUMB=0.0D0
+      DO 15 J=1,NY
+      DO 10 I=1,NX
+      IEL=IEL+1
+      IF(MIX(IEL).EQ.0)GOTO 10
+      ICH=ICH+1
+*     REFUELLING RATE
+      RATE(ICH)=POWC(ICH)/BVAL(BZONE(ICH))
+      SUMR=SUMR+RATE(ICH)
+      SUMB=SUMB+BVAL(BZONE(ICH))*RATE(ICH)
+      IF(IMPX.LT.4)GOTO 10
+*     PRINT RATE
+      WRITE(TEXT,'(A9,I3.3)')'CHANNEL #',ICH
+      WRITE(CHANX,'(A2)') (NAMX(I))
+      WRITE(CHANY,'(A2)') (NAMY(J))
+      WRITE(IOUT,1001)TEXT,CHANY,CHANX,NSCH(ICH),RATE(ICH)
+   10 CONTINUE
+   15 CONTINUE
+*     EXIT BURNUP
+      BEXIT=REAL(SUMB/SUMR)
+      IF(IMPX.EQ.0)GOTO 20
+      IF(BEXIT.LT.10000.)THEN
+        WRITE(IOUT,1002)BEXIT
+      ELSE
+        WRITE(IOUT,1003)BEXIT
+      ENDIF
+   20 CALL LCMPUT(IPMAP,'B-EXIT',1,2,BEXIT)
+      CALL LCMPUT(IPMAP,'REF-RATE',NCH,2,RATE)
+      RETURN
+*
+ 1000 FORMAT(/1X,'**',1X,'COMPUTING CHANNEL',
+     1 1X,'REFUELLING',1X,'RATES',1X,'**'/)
+ 1001 FORMAT(5X,A12,5X,'NAME:',1X,A2,A2,5X,'RE',
+     1 'F-SCHEME:',1X,I2,5X,'REF-RATE: ',F6.4/)
+ 1002 FORMAT(/1X,'CORE-AVERAGE EXIT BURNUP',
+     1  1X,'=',1X,F7.2,1X,'MW*DAY/T'/)
+ 1003 FORMAT(/1X,'CORE-AVERAGE EXIT BURNUP',
+     1  1X,'=',1X,F8.2,1X,'MW*DAY/T'/)
+      END
diff --git a/Donjon/src/TAVGLM.f b/Donjon/src/TAVGLM.f
new file mode 100644
index 0000000..e2b8995
--- /dev/null
+++ b/Donjon/src/TAVGLM.f
@@ -0,0 +1,118 @@
+*DECK TAVGLM
+      SUBROUTINE TAVGLM(NB,SHIFT,BCHAN,PSI,BURN0,BURN1,IVECT,NSCH)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute the burnup integration limits for a given channel.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* D.Rozon, M.Beaudet, D.Sekki, I. Trancart
+*
+*Parameters: input
+* NB     number of fuel bundles.
+* SHIFT  number of bundles to refuel (bundle-shift).
+* PSI    axial shape over each bundle.
+* NSCH   refuelling scheme of a given channel.
+* BCHAN  average exit burnup for a given channel.
+* IVECT  refuelling pattern vector for a given channel.
+*
+*Parameters: output
+* BURN0  lower burnup integration limit.
+* BURN1  upper burnup integration limit.
+*
+*Parameters: scratch
+* DELT   incremental burnup over each fuel bundle.
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER NB,SHIFT,NSCH,IVECT(NB),CHR(NB),AGLIM
+      REAL BURN0(NB),BURN1(NB),PSI(NB),BCHAN,DELT(NB)
+*----
+*  LOCAL VARIABLES
+*----         
+      LOGICAL LAXSH
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----                
+*----
+*  COMPUTE BURNUP LIMITS
+*----
+      BURN0(:NB)=0.0
+      BURN1(:NB)=0.0
+      DELT(:NB)=0.0
+      LAXSH=.FALSE.
+      DO 10 IB=1,NB
+      DELT(IB)=SHIFT*BCHAN*PSI(IB)
+      IF(IVECT(IB).GT.IB)THEN
+        LAXSH=.TRUE.
+      ENDIF
+   10 CONTINUE
+*     Burnup attribution with axial Shuffling
+      IF(LAXSH)THEN 
+        AGLIM=INT(NB/SHIFT)+1
+        CHR(:NB)=AGLIM
+*       Two loops on bundle cycles (IA) and nmake tesumber of bundles (IB)
+        DO 25 IA=0,AGLIM-1
+        DO 20 IB=1,NB
+*       Index ordering
+        IF (NSCH.LT.0) THEN
+          KK=NB-IB+1
+          KV=NB-IVECT(IB)+1
+        ELSE
+          KK=IB
+          KV=IVECT(IB)
+        ENDIF
+*       New fuel
+        IF(IVECT(IB).EQ.0)THEN
+          CHR(IB)=0
+          BURN0(KK)=0.
+          BURN1(KK)=DELT(KK)
+        ELSE 
+*         Compute new burnup if previous bundle cycle done
+          IF(CHR(IVECT(IB)).EQ.(IA-1))THEN
+            CHR(IB)=IA
+            BURN0(KK)=BURN1(KV)
+            BURN1(KK)=DELT(KK)+BURN1(KV)
+          ENDIF
+        ENDIF
+   20   CONTINUE
+   25   CONTINUE
+*     Burnup attribution without axial Shuffling 
+*     One loop on number of bundles (IB)
+      ELSE 
+*       NEGATIVE DIRECTION
+        IF(NSCH.LT.0)THEN
+          DO 40 IB=1,NB
+          KK=NB-IB+1
+          KA=NB-IVECT(IB)+1
+          IF(IVECT(IB).LE.0)THEN
+            BURN0(KK)=0.
+          ELSE
+            BURN0(KK)=BURN1(KA)
+          ENDIF
+          BURN1(KK)=BURN0(KK)+DELT(KK)
+   40     CONTINUE
+*       POSITIVE DIRECTION
+        ELSE
+          DO 50 IB=1,NB
+          IF(IVECT(IB).LE.0)THEN
+            BURN0(IB)=0.
+          ELSE
+            BURN0(IB)=BURN1(IVECT(IB))
+          ENDIF
+          BURN1(IB)=BURN0(IB)+DELT(IB)
+   50     CONTINUE
+        ENDIF
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      RETURN
+      END
diff --git a/Donjon/src/THM.f b/Donjon/src/THM.f
new file mode 100644
index 0000000..4917d83
--- /dev/null
+++ b/Donjon/src/THM.f
@@ -0,0 +1,1489 @@
+*DECK THM
+      SUBROUTINE THM(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Simplified thermal-hydraulics module.
+*
+*Copyright:
+* Copyright (C) 2013 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* A. Hebert, P. Gallet and V. Salino
+* 02/2025: C. HUET - Modifications to include pressure drop calculation
+* 08/2025: M.Bellier & R. Guasch modifified to include :
+*                   - drift-flux model
+*                   - variable axial properties  
+*
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The THM: module specification is:
+* THERMO MAPFL := THM: [ THERMO ] MAPFL :: (descthm) ;
+* where
+*   THERMO : name of the \emph{thermo) object that will be created or updated 
+*     by the THM: module. Object \emph{thermo} contains thermal-hydraulics 
+*     information set or computed by THM: in transient or in permanent 
+*     conditions such as the distribution of the enthalpy, the pressure, the 
+*     velocity, the density and the temperatures of the coolant for all the 
+*     channels in the geometry. It also contains all the values of the fuel 
+*     temperatures in transient or in permanent conditions according to the 
+*     discretisation chosen for the fuel rods.
+*   MAPFL : name of the \emph{map} object containing fuel regions description 
+*     and local parameter informations.
+*   (descthm) : structure describing the input data to the THM: module. 
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(NSTATE=40,IOUT=6,PI=3.141592654,ZKILO=1.0E3)
+      PARAMETER(IMAXO=1000,JMAXO=100,KMAXO=200,NMAXO=40,MAXRAD=10)
+      PARAMETER(DTEMPR=5.0,DTEMPT=40.0,DPRESS=4.0)
+      CHARACTER TEXT*40,TEXT12*12,HSIGN*12,PNAME*12,TXTDIR*12,HSMG*131,
+     > UCONDF*12,UCONDC*12,SNAME*32,SCOMP*32,FNAME*32,FCOMP*32
+      INTEGER ISTATE(NSTATE),TIMEIT,ITIME
+      REAL STATE(NSTATE),DTIME,KHGAP,KHCONV,WTEFF
+      REAL POULET,HX(IMAXO),HY(JMAXO),HZ(KMAXO)
+      REAL RPRAD(MAXRAD),FPRAD(MAXRAD),TERP(MAXRAD)
+      DOUBLE PRECISION DFLOT,DSUM
+      LOGICAL LPRAD
+      TYPE(C_PTR) IPTHM,IPMAP,JPMAP,KPMAP,JPTHM,KPTHM,LPTHM,MPTHM,
+     > KPTHMI,LPTHMI,MPTHMI
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: NUM,IREFSC
+      REAL, ALLOCATABLE, DIMENSION(:) :: XX,YY,ZZ,BURN,BURN2,PW,FRO,
+     1 FNFUCST,FNTGCST,FRACPU
+      REAL, ALLOCATABLE, DIMENSION(:) :: FPOWER,KCONDF,KCONDC,TIMESR,
+     1 TPOWER,PFORM,DTERP
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: XBURN,POW,TCOMB,DCOOL,
+     1 TCOOL,TSURF,PCOOL,HCOOL
+      REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: RAD
+      DOUBLE PRECISION ARF,ARCI,ARCE,DARF,DARC
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: VAL,RVAL
+      REAL, ALLOCATABLE, DIMENSION(:) :: ACOOL,PCH,HD,FFUEL,FCOOL
+      REAL, ALLOCATABLE, DIMENSION(:) :: RAPCOOL,RAPFUEL,PM
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: FNFU,FNTG
+*----
+*  PARAMETER VALIDATION
+*----
+      IF(NENTRY.NE.2)CALL XABORT('@THM: 2 PARAMETERS EXPECTED.')
+      IPTHM=KENTRY(1)
+      IPMAP=KENTRY(2)
+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2))CALL XABORT('@THM:'
+     1 //' LCM OBJECT EXPECTED AT FIRST LHS.')
+      IF((IENTRY(2).NE.1).AND.(IENTRY(2).NE.2))CALL XABORT('@THM:'
+     1 //' LCM OBJECT EXPECTED AT SECOND LHS.')
+      CALL LCMGTC(IPMAP,'SIGNATURE',12,HSIGN)
+      IF(HSIGN.NE.'L_MAP')THEN
+        TEXT=HENTRY(2)
+        CALL XABORT('@THM: SIGNATURE OF '//TEXT//' IS '//HSIGN//
+     1  '. L_MAP EXPECTED.')
+      ENDIF
+*----
+*  RECOVER L_MAP STATE-VECTOR
+*----
+      CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+      NB=ISTATE(1)
+      NCH=ISTATE(2)
+      NPARM=ISTATE(8)
+      NSIMS=ISTATE(13)
+      ALLOCATE(FNFUCST(NCH),FNTGCST(NCH),FRACPU(NCH))
+*----
+*  READ DATA
+*----
+      IMPX=1
+      ITIME=0
+      DTIME=0.0
+      FPUISS=0.974
+      CFLUX=2.0E+6
+      SPEED=0.0
+      TINLET=0.0
+      POULET=0.0
+      POROS=0.05
+      ICONDF=0
+      ICONDC=0
+      IHGAP=0
+      IHCONV=0
+      IFRCDI=0
+      ISUBM=1
+      RC=0.0
+      RIG=0.0
+      RGG=0.0
+      RTG=0.0
+      PITCH=0.0
+      MAXIT1=50
+      MAXIT2=50
+      MAXIT3=50
+      IFLUID=0
+      IFUEL=0
+      IGAP=0
+      IPRES=0
+      IDFM=0
+      ERMAXT=1.0
+      ERMAXC=1.0E-3
+      NFD=5
+      NDTOT=8
+      NPRAD=0
+      TIMEIT=0
+      NPOWER=0
+      RELAX=1.0
+      RTIME=0.0
+      WTEFF=5.0/9.0 ! Rowlands weighting factor
+      EPSR=0.0
+      THETA=0.0
+      UCONDF='CELSIUS'
+      UCONDC='CELSIUS'
+      TPOW=0.0
+      FNFUCST(:NCH)=1.0
+      FNTGCST(:NCH)=0.0
+      FRACPU(:NCH)=0.0
+      IF(JENTRY(1).EQ.1) THEN
+        CALL LCMGET(IPTHM,'STATE-VECTOR',ISTATE)
+        IF(ISTATE(1).NE.NCH) CALL XABORT('THM: INVALID STATE VECTOR FO'
+     >  //'R IPTHM OPJECT.')
+        MAXIT1=ISTATE(3)
+        MAXIT2=ISTATE(4)
+        MAXIT3=ISTATE(5)
+        NFD=ISTATE(6)
+        NDTOT=ISTATE(7)
+        ITIME=ISTATE(8)
+        TIMEIT=ISTATE(9)
+        IHGAP=ISTATE(10)
+        IHCONV=ISTATE(11)
+        ICONDF=ISTATE(12)
+        ICONDC=ISTATE(13)
+        IFRCDI=ISTATE(14)
+        ISUBM=ISTATE(15)
+        IF(ICONDF.EQ.1) NCONDF=ISTATE(16)
+        IF(ICONDC.EQ.1) NCONDC=ISTATE(17)
+        NPRAD=ISTATE(18)
+        IFLUID=ISTATE(20)
+        IGAP=ISTATE(21)
+        IPRES=ISTATE(22)
+        CALL LCMGET(IPTHM,'REAL-PARAM',STATE)
+        DTIME=STATE(1)
+        FPUISS=STATE(2)
+        CFLUX=STATE(3)
+        SPEED=STATE(4)
+        POULET=STATE(5)
+        TINLET=STATE(6)
+        POROS=STATE(7)
+        RC=STATE(8)
+        RIG=STATE(9)
+        RGG=STATE(10)
+        RTG=STATE(11)
+        PITCH=STATE(12)
+        ERMAXT=STATE(13)
+        ERMAXC=STATE(14)
+        RELAX=STATE(15)
+        RTIME=STATE(16)
+        IF(IHGAP.EQ.1) KHGAP=STATE(17)
+        IF(IHCONV.EQ.1) KHCONV=STATE(18)
+        WTEFF=STATE(19)
+        TPOW=STATE(20)
+        EPSR=STATE(22)
+        THETA=STATE(23)
+*----
+*  RECOVER CELL-DEPENDENT DATA
+*----
+        CALL LCMGET(IPTHM,'NB-FUEL',FNFUCST)
+        CALL LCMGET(IPTHM,'NB-TUBE',FNTGCST)
+        CALL LCMGET(IPTHM,'FRACT-PU',FRACPU)
+*----
+*  RECOVER CONDUCTIVITY INFORMATION ON LCM OBJECT THM
+*----
+        IF(ICONDF.EQ.1) THEN
+          ALLOCATE(KCONDF(NCONDF+3))
+          CALL LCMGET(IPTHM,'KCONDF',KCONDF)
+          CALL LCMGTC(IPTHM,'UCONDF',12,UCONDF)
+        ENDIF
+        IF(ICONDC.EQ.1) THEN
+          ALLOCATE(KCONDC(NCONDC+1))
+          CALL LCMGET(IPTHM,'KCONDC',KCONDC)
+          CALL LCMGTC(IPTHM,'UCONDC',12,UCONDC)
+        ENDIF
+      ENDIF
+*----
+*  READ INPUT DATA
+*----
+      IPICK=0
+      LPRAD=.FALSE.
+   10 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.EQ.10)GO TO 60
+   20 IF(ITYP.NE.3)CALL XABORT('@THM: CHARACTER DATA EXPECTED.')
+      IF(TEXT.EQ.'EDIT') THEN
+*       Read printing index
+        CALL REDGET(ITYP,IMPX,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@THM: INTEGER FOR EDIT EXPECTED.')
+      ELSE IF(TEXT.EQ.'TIME') THEN
+*       Time at beginning of time-step (s).
+        CALL REDGET(ITYP,NITMA,RTIME,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR RTIME EXPECTED.')
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.EQ.2) THEN
+          DTIME=FLOT
+        ELSE IF(ITYP.EQ.3) THEN
+          GO TO 20
+        ELSE
+          CALL XABORT('@THM: REAL FOR DTIME EXPECTED.')
+        ENDIF
+        ITIME=1
+      ELSE IF(TEXT.EQ.'FLUID') THEN
+*       Read fluid type
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@THM: CHARACTER FOR FLUID EXPECTED.')
+        IF(TEXT.EQ.'H2O') THEN
+           IFLUID=0
+        ELSE IF(TEXT.EQ.'D2O') THEN
+           IFLUID=1
+        ELSE IF(TEXT.EQ.'SALT') THEN
+           IFLUID=2
+           CALL REDGET(ITYP,NITMA,FLOT,SNAME,DFLOT)
+           IF(ITYP.NE.3) THEN
+             CALL XABORT('@THM: CHARACTER FOR FLUID SALT NAME EXPECTED'
+     >       //'.')
+           ENDIF
+           CALL REDGET(ITYP,NITMA,FLOT,SCOMP,DFLOT)
+           IF(ITYP.NE.3) THEN
+             CALL XABORT('@THM: CHARACTER FOR FLUID SALT COMPOSITION'
+     >       //'EXPECTED.')
+           ENDIF
+        ELSE
+           CALL XABORT('@THM: INVALID FLUID TYPE.')
+        ENDIF
+      ELSE IF(TEXT.EQ.'FUEL') THEN
+*       Read fuel type
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@THM: CHARACTER FOR FLUID EXPECTED.')
+        IF(TEXT.EQ.'UO2') THEN
+           IFUEL=0
+        ELSE IF(TEXT.EQ.'SALT') THEN
+           IFUEL=1
+           CALL REDGET(ITYP,NITMA,FLOT,FNAME,DFLOT)
+           IF(ITYP.NE.3) THEN
+             CALL XABORT('@THM: CHARACTER FOR FLUID EXPECTED.')
+           ENDIF
+           CALL REDGET(ITYP,NITMA,FLOT,FCOMP,DFLOT)
+           IF(ITYP.NE.3) THEN
+             CALL XABORT('@THM: CHARACTER FOR FLUID EXPECTED.')
+           ENDIF
+        ELSE
+           CALL XABORT('@THM: INVALID FUEL TYPE.')
+        ENDIF
+      ELSE IF(TEXT.EQ.'FPUISS') THEN
+*       Coolant power factor
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.EQ.2) THEN
+           FPUISS=FLOT
+        ELSE
+           CALL XABORT('@THM: REAL FOR FPUISS EXPECTED.')
+        ENDIF
+      ELSE IF(TEXT.EQ.'CRITFL') THEN
+*       Critical heat flux (W/m^2)
+        CALL REDGET(ITYP,NITMA,CFLUX,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR CFLUX EXPECTED.')
+      ELSE IF(TEXT.EQ.'CWSECT') THEN
+*       Core coolant section (m^2)
+        CALL REDGET(ITYP,NITMA,CWSECT,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR CWSECT EXPECTED.')
+*       Coolant flow (m^3/h)
+        CALL REDGET(ITYP,NITMA,FLOW,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR FLOW EXPECTED.')
+        SPEED=FLOW/(3600.0*CWSECT)
+      ELSE IF(TEXT.EQ.'INLET-Q') THEN
+*       Core coolant section (m^2)
+        IF((POULET.EQ.0.0).OR.(TINLET.EQ.0.0)) CALL XABORT('@THM: INLE'
+     >  //'T INFORMATION NOT SET BEFORE USING INLET-Q.')
+        CALL REDGET(ITYP,NITMA,CWSECT,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR CWSECT EXPECTED.')
+*       Inlet mass flow rate (kg/s)
+        CALL REDGET(ITYP,NITMA,QFLUID,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR QFLUID EXPECTED.')
+        IF(IFLUID.EQ.0) THEN
+          CALL THMPT(POULET,TINLET,RHOL,R2,R3,R4,R5)
+        ELSE IF(IFLUID.EQ.1) THEN
+          CALL THMHPT(POULET,TINLET,RHOL,R2,R3,R4,R5)
+        ELSE IF(IFLUID.EQ.2) THEN
+          CALL THMSPT(SNAME,SCOMP,TINLET,RHOL,R2,R3,R4,R5,IMPX)
+        ENDIF
+        SPEED=QFLUID/(CWSECT*RHOL)
+      ELSE IF(TEXT.EQ.'SPEED') THEN
+*       Coolant velocity (m/s)
+        CALL REDGET(ITYP,NITMA,SPEED,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR SPEED EXPECTED.')
+      ELSE IF(TEXT.EQ.'INLET') THEN
+*       The POULET and TINLET informations are used to compute initial
+*       enthalpy and water density.
+*       Outlet pressure (Pa)
+        CALL REDGET(ITYP,NITMA,POULET,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR POULET EXPECTED.')
+*       Inlet temperature (K)
+        CALL REDGET(ITYP,NITMA,TINLET,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR TINLET EXPECTED.')
+      ELSE IF(TEXT.EQ.'PUFR') THEN
+        ICONDF=0
+*       Plutonium mass enrichment
+        CALL THMINP('PUFR',NCH,FRACPU)
+      ELSE IF(TEXT.EQ.'POROS') THEN
+        ICONDF=0
+*       Oxyde porosity
+        CALL REDGET(ITYP,NITMA,POROS,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR POROS EXPECTED.')
+      ELSE IF(TEXT.EQ.'CONDF') THEN
+        IF(ICONDF.EQ.1)DEALLOCATE(KCONDF)
+        ICONDF=1
+*       Fuel conductivity expressed as a function of fuel temperature
+*       (function = polynomial + inverse term)
+        CALL REDGET(ITYP,NCONDF,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@THM: INTEGER FOR CONDF EXPECTED.')
+        IF(NCONDF.LT.0)CALL XABORT('@THM: NCONDF MUST BE LARGER OR '
+     >                  //'EQUAL TO 0.')
+        ALLOCATE(KCONDF(NCONDF+3))
+        DO I=1,NCONDF+1
+          CALL REDGET(ITYP,NITMA,KCONDF(I),TEXT,DFLOT)
+          IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR KCONDF EXPECTED.')
+        ENDDO
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@THM: CHARACTER DATA EXPECTED (INV, '
+     >     //'CELSIUS OR KELVIN) IN CONDF STATEMENT.')
+        IF(TEXT12.EQ.'INV') THEN
+          CALL REDGET(ITYP,NITMA,KCONDF(NCONDF+2),TEXT,DFLOT)
+          IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR INV EXPECTED.')
+          CALL REDGET(ITYP,NITMA,KCONDF(NCONDF+3),TEXT,DFLOT)
+          IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR REF EXPECTED.')
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+        ELSE
+          KCONDF(NCONDF+2)=0.0 ! Coefficient for the inverse term
+          KCONDF(NCONDF+3)=-273.15 ! Reference for the inverse term
+        ENDIF
+        IF((TEXT12.NE.'CELSIUS').AND.(TEXT12.NE.'KELVIN')) THEN
+          CALL XABORT('@THM: UNIT KEYWORD EXPECTED (CELSIUS OR '
+     >                //'KELVIN) IN CONDF STATEMENT.')
+        ENDIF
+        UCONDF=TEXT12
+      ELSE IF(TEXT.EQ.'CONDC') THEN
+        IF(ICONDC.EQ.1)DEALLOCATE(KCONDC)
+        ICONDC=1
+*       Clad conductivity expressed as a polynomial of clad temperature
+        CALL REDGET(ITYP,NCONDC,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@THM: INTEGER FOR CONDC EXPECTED.')
+        IF(NCONDC.LT.0)CALL XABORT('@THM: NCONDC MUST BE LARGER OR '
+     >                  //'EQUAL TO 0.')
+        ALLOCATE(KCONDC(NCONDC+1))
+        DO I=1,NCONDC+1
+          CALL REDGET(ITYP,NITMA,KCONDC(I),TEXT,DFLOT)
+          IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR KCONDC EXPECTED.')
+        ENDDO
+        CALL REDGET(ITYP,NITMA,FLOT,UCONDC,DFLOT)
+        IF((ITYP.NE.3).OR.((UCONDC.NE.'CELSIUS').AND.
+     >                     (UCONDC.NE.'KELVIN'))) THEN
+          CALL XABORT('@THM: UNIT KEYWORD EXPECTED (CELSIUS OR '
+     >                //'KELVIN) IN CONDC STATEMENT.')
+        ENDIF
+      ELSE IF(TEXT.EQ.'HGAP') THEN
+        IHGAP=1
+*       Fixed, user-chosen value of the HGAP (heat exchange coefficient
+*       of the gap) (W/m^2/K)
+        CALL REDGET(ITYP,NITMA,KHGAP,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR HGAP EXPECTED.')
+      ELSE IF(TEXT.EQ.'HCONV') THEN
+        IHCONV=1
+*       Fixed, user-chosen value of the HCONV (heat transfer coefficient
+*       between clad and fluid) (W/m^2/K)
+        CALL REDGET(ITYP,NITMA,KHCONV,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR HCONV EXPECTED.')
+      ELSE IF(TEXT.EQ.'TEFF') THEN
+*       Surface temperature's weighting factor in effective fuel
+*       temperature
+        CALL REDGET(ITYP,NITMA,WTEFF,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR TEFF EXPECTED.')
+      ELSE IF(TEXT.EQ.'FORCEAVE') THEN
+*       Force the use of the average value approximation for fuel
+*       conductivity
+        IFRCDI=1
+      ELSE IF(TEXT.EQ.'MONO') THEN
+*       one-phase flow model
+        ISUBM=0
+      ELSE IF(TEXT.EQ.'BOWR') THEN
+*       Bowring's correlation
+        ISUBM=1
+      ELSE IF(TEXT.EQ.'SAHA') THEN
+*       Saha-Zuber correlation
+        ISUBM=2
+      ELSE IF(TEXT.EQ.'RADIUS') THEN
+*       Fuel pellet radius (m)
+        CALL REDGET(ITYP,NITMA,RC,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR RC EXPECTED.')
+*       Internal clad rod radius (m)
+        CALL REDGET(ITYP,NITMA,RIG,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR RIG EXPECTED.')
+*       External clad rod radius (m)
+        CALL REDGET(ITYP,NITMA,RGG,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR RGG EXPECTED.')
+*       Guide tube radius (m)
+        CALL REDGET(ITYP,NITMA,RTG,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR RTG EXPECTED.')
+      ELSE IF(TEXT.EQ.'ASSMB') THEN
+*       Number of active fuel rods
+        CALL THMINP('NB-FUEL',NCH,FNFUCST)
+*       Number of guide tubes
+        CALL THMINP('NB-TUBE',NCH,FNTGCST)
+      ELSE IF(TEXT.EQ.'CLUSTER') THEN
+*       Hexagonal pitch (m)
+        CALL REDGET(ITYP,NITMA,PITCH,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR PITCH EXPECTED.')
+*       Number of active fuel pins in cluster
+        CALL THMINP('NB-FUEL',NCH,FNFUCST)
+      ELSE IF(TEXT.EQ.'CONV') THEN
+*       Number of conduction iterations
+        CALL REDGET(ITYP,MAXIT1,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@THM: INTEGER FOR MAXIT1 EXPECTED.')
+*       Number of center-pellet iterations
+        CALL REDGET(ITYP,MAXIT2,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@THM: INTEGER FOR MAXIT2 EXPECTED.')
+*       Number of flow iterations
+        CALL REDGET(ITYP,MAXIT3,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@THM: INTEGER FOR MAXIT3 EXPECTED.')
+*       Temperature maximum error (K)
+        CALL REDGET(ITYP,NITMA,ERMAXT,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR ERMAXT EXPECTED.')
+*       maximum relative error for the calculation of the properties
+*       in the coolant (pressure, enthalpy, density, velocity,...)
+        CALL REDGET(ITYP,NITMA,ERMAXC,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR ERMAXC EXPECTED.')
+      ELSE IF(TEXT.EQ.'RODMESH') THEN
+*       Number of discretisation points in fuel
+        CALL REDGET(ITYP,NFD,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@THM: INTEGER FOR NFD EXPECTED.')
+*       Number of discretisation points in fuel rod (fuel+cladding)
+        CALL REDGET(ITYP,NDTOT,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@THM: INTEGER FOR NDTOT EXPECTED.')
+      ELSE IF(TEXT.EQ.'RELAX') THEN
+*       Relaxation parameter
+        CALL REDGET(ITYP,NITMA,RELAX,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR RELAX EXPECTED.')
+      ELSE IF(TEXT.EQ.'RAD-PROF') THEN
+*       Set radial power profile
+        NPRAD=0
+        LPRAD=.TRUE.
+   30   CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.EQ.3)GO TO 20
+        NPRAD=NPRAD+1
+        RPRAD(NPRAD)=FLOT
+        IF(NPRAD.GT.MAXRAD) CALL XABORT('@THM: MAXRAD OVERFLOW.')
+        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR RAD-PROF-X EXPECTED.')
+        IF(RPRAD(NPRAD).LT.0.0)CALL XABORT('@THM: R TOO SMALL.')
+        IF(RPRAD(NPRAD).GT.RC)CALL XABORT('@THM: R TOO LARGE.')
+        CALL REDGET(ITYP,NITMA,FPRAD(NPRAD),TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR RAD-PROF-F EXPECTED.')
+        GO TO 30
+      ELSE IF(TEXT.EQ.'POWER-LAW') THEN
+*       The total power in W generated in the fuel is defined as
+*       T-POWER*TIME-LAW(t).
+        CALL REDGET(ITYP,NITMA,TPOW,TEXT12,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR T-POWER EXPECTED.')
+        CALL REDGET(ITYP,NPOWER,FLOT,TEXT12,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@THM: INTEGER VALUE EXPECTED.')
+        ALLOCATE(TIMESR(NPOWER),TPOWER(NPOWER))
+        DO I=1,NPOWER
+          CALL REDGET(ITYP,NITMA,TIMESR(I),TEXT12,DFLOT)
+          IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR TIME EXPECTED.')
+          CALL REDGET(ITYP,NITMA,TPOWER(I),TEXT12,DFLOT)
+          IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR POWER EXPECTED.')
+        ENDDO
+        CALL LCMPUT(IPTHM,'TIME-SR1',NPOWER,2,TIMESR)
+        CALL LCMPUT(IPTHM,'POWER-SR1',NPOWER,2,TPOWER)
+        DEALLOCATE(TPOWER,TIMESR)
+      ELSE IF(TEXT.EQ.'F-RUG') THEN
+*       Rugosity of the fuel rod
+        CALL REDGET(ITYP,NITMA,EPSR,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR F-RUG EXPECTED.')
+      ELSE IF(TEXT.EQ.'THETA') THEN
+*       Angle of the fuel channel
+        CALL REDGET(ITYP,NITMA,THETA,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR THETA EXPECTED.')
+      ELSE IF(TEXT.EQ.'PDROP') THEN
+*       Pressure drop identification
+        CALL REDGET(ITYP,IPRES,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@THM: INTEGER FOR IPRES EXPECTED.')
+      ELSE IF(TEXT.EQ.'DFM') THEN
+*       Drift Flux Model identification
+        CALL REDGET(ITYP,IDFM,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@THM: INTEGER FOR IDFM EXPECTED.')
+      ELSE IF(TEXT.EQ.'SET-PARAM') THEN
+*       Reset a global parameter
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@THM: CHARACTER NAME EXPECTED.')
+        CALL REDGET(ITYP,NITMA,VALUE,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@THM: REAL FOR VALUE EXPECTED.')
+        JPMAP=LCMGID(IPMAP,'PARAM')
+        DO 40 IPAR=1,NPARM
+        KPMAP=LCMGIL(JPMAP,IPAR)
+        CALL LCMGTC(KPMAP,'P-NAME',12,PNAME)
+        CALL LCMGET(KPMAP,'P-TYPE',ITYPE)
+        IF(ITYPE.EQ.1) THEN
+          IF(PNAME.EQ.TEXT) THEN
+            CALL LCMPUT(KPMAP,'P-VALUE',1,2,VALUE)
+            IF(IMPX.GT.0) WRITE(6,500) PNAME,VALUE
+            GO TO 10
+          ELSE
+            GO TO 40
+          ENDIF
+        ELSE IF(ITYPE.EQ.2) THEN
+          CALL XABORT('@THM: CANNOT RESET LOCAL PARAMETER: '//TEXT)
+        ENDIF
+   40   CONTINUE
+        CALL XABORT('@THM: GLOBAL PARAMETER NAME NOT FOUND: '//TEXT)
+      ELSE IF(TEXT.EQ.';') THEN
+        GO TO 60
+      ELSE IF(TEXT.EQ.'PICK') THEN
+        IPICK=1
+        GO TO 60
+      ELSE
+        CALL XABORT('@THM: INVALID KEYWORD: '//TEXT//'.')
+      ENDIF
+      GO TO 10
+*----
+*  TEST DATA INPUT
+*----
+   60 IF(TINLET.LE.273.15) CALL XABORT('@THM: INLET TEMPERATURE MUST BE'
+     > //' HIGHER THAN 273.15K.')
+      IF(SPEED.EQ.0.0) CALL XABORT('@THM: ZERO COOLANT SPEED.')
+      IF(POULET.EQ.0.0) CALL XABORT('@THM: ZERO OUTLET PRESSURE.')
+      IF(RC.EQ.0.0) CALL XABORT('@THM: ZERO FUEL PELLET RADIUS.')
+      IF(RIG.EQ.0.0) CALL XABORT('@THM: ZERO INTERNAL CLAD ROD RADIUS.')
+      IF(RGG.EQ.0.0) CALL XABORT('@THM: ZERO EXTERNAL CLAD ROD RADIUS.')
+      IF(NDTOT.GT.NMAXO) CALL XABORT('@THM: NFD OVERFLOW, TOO MANY FUE'
+     > //'L DOMAINS')
+      IF(NDTOT.LT.8) CALL XABORT('@THM: NDTOT MUST AT LEAST BE EQUAL T'
+     > //'O 8')
+      IF(NFD.LT.4) CALL XABORT('@THM: NFD MUST AT LEAST BE EQUAL TO 4')
+      IF(NFD.GE.NDTOT) CALL XABORT('@THM: NFD MUST BE LOWER THAN NDTO'
+     > //'T.')
+      IF((RELAX.LE.0.0).OR.(RELAX.GT.1.0)) CALL XABORT('@THM: RELAX '
+     >  //'PARAMETER EXPECTED BETWEEN 0<RELAX<=1.')
+      IF((WTEFF.LT.0.0).OR.(WTEFF.GT.1.0)) CALL XABORT('@THM: WTEFF '
+     >  //'PARAMETER EXPECTED BETWEEN 0<=WTEFF<=1.')
+      IF(ITIME.EQ.1) RELAX=1.0
+      IF((RC.NE.RIG).AND.(IFUEL.EQ.1)) CALL XABORT('@THM: WITH MOLTEN'
+     > //' SALT FUEL INNER CLAD RADIUS MUST BE EQUAL TO FUEL RADIUS')
+*----
+*  PRINT CHANNEL-DEPENDENT DATA
+*----
+      IF(IMPX.GT.1) THEN
+        WRITE(6,'(/28H THM: CHANNEL-DEPENDENT DATA)')
+        I1=1
+        DO I=1,(NCH-1)/8+1
+          I2=I1+7
+          IF(I2.GT.NCH) I2=NCH
+          WRITE(6,'(//8H CHANNEL,8(I8,6X,1H|))') (J,J=I1,I2)
+          WRITE(6,'(8H NB-FUEL,8(F10.2,4X,1H|))') (FNFUCST(J),J=I1,I2)
+          WRITE(6,'(8H NB-TUBE,8(F10.2,4X,1H|))') (FNTGCST(J),J=I1,I2)
+          WRITE(6,'(8H PUFR   ,8(1P,E13.4,2H |))') (FRACPU(J),J=I1,I2)
+          I1=I1+8
+        ENDDO
+      ENDIF
+*----
+*  SET POWER DISTRIBUTION
+*----
+      ALLOCATE(FRO(NFD-1))
+      IF(NPRAD.EQ.0) THEN
+        FRO(:NFD-1)=1.0
+      ELSE
+        IF(.NOT.LPRAD) THEN
+          CALL LCMGET(IPTHM,'RAD-PROF_R',RPRAD)
+          CALL LCMGET(IPTHM,'RAD-PROF_F',FPRAD)
+        ELSE
+          CALL LCMPUT(IPTHM,'RAD-PROF_R',NPRAD,2,RPRAD)
+          CALL LCMPUT(IPTHM,'RAD-PROF_F',NPRAD,2,FPRAD)
+        ENDIF
+        DAR1=0.0
+        DELT=0.5*RC**2/REAL(NFD-1)
+        DO IM=1,NFD-1
+           DAR2=DAR1+DELT
+           RADM=SQRT(DAR1+DAR2)
+           CALL ALTERP(.FALSE.,NPRAD,RPRAD(1),RADM,.FALSE.,TERP(1))
+           DSUM=0.0D0
+           DO J=1,NPRAD
+             DSUM=DSUM+TERP(J)*FPRAD(J)
+           ENDDO
+           FRO(IM)=REAL(DSUM)
+           DAR1=DAR2
+        ENDDO
+      ENDIF
+      IF(IMPX.GT.1) WRITE(6,480) (FRO(IM),IM=1,NFD-1)
+*----
+*  RECOVER GEOMAP STATE-VECTOR
+*  ISTATE(1): 7 = XYZ, 9 = HEXZ
+*  In 3d hexagonal, NY=0, but THM: expects a 3D geometry, so we set
+*  NY=1 and  continue.
+*---- 
+      JPMAP=LCMGID(IPMAP,'GEOMAP')
+      CALL LCMGET(JPMAP,'STATE-VECTOR',ISTATE)
+      NX=ISTATE(3)
+      NY=ISTATE(4)
+      NZ=ISTATE(5)
+      NEL=ISTATE(6)
+      IF((ISTATE(1).EQ.9).AND.(NY.EQ.0)) NY=1
+      IF(NX.GT.IMAXO) CALL XABORT('@THM: NX OVERFLOW.')
+      IF(NY.GT.JMAXO) CALL XABORT('@THM: NY OVERFLOW.')
+      IF(NZ.GT.KMAXO) CALL XABORT('@THM: NZ OVERFLOW.')
+      ALLOCATE(PCH(NZ),ACOOL(NZ),HD(NZ))
+      ALLOCATE(FNFU(NCH,NZ),FNTG(NCH,NZ),RAPCOOL(NZ),
+     > RAPFUEL(NZ),PM(NZ),FFUEL(NZ),FCOOL(NZ))
+*----
+*  RECOVER REACTOR MESH IN METER
+*  The arrays HX, HY, and HZ contain the mesh size in X-, Y-, and
+*  Z-direction and are used to determine the volume of a mesh, i.e.
+*  V(I,J,K)=HX(I)*HY(J)*HZ(K)
+*  For 3D hexagonal, set HX and HY to the square root of the SA surface
+*  SASS
+*----
+      ALLOCATE(XX(NX+1),YY(NY+1),ZZ(NZ+1))
+      IF(ISTATE(1).EQ.7) THEN
+        CALL LCMGET(JPMAP,'MESHX',XX)
+        CALL LCMGET(JPMAP,'MESHY',YY)
+      ENDIF
+      CALL LCMGET(JPMAP,'MESHZ',ZZ)
+      IF(ISTATE(1).EQ.9) THEN
+        CALL LCMGET(JPMAP,'SIDE',SIDE)
+        SASS=1.5*SQRT(3.0)*SIDE*SIDE/1.0E4
+        DO 70 I=1,NX
+        HX(I) = SQRT(SASS)
+   70   CONTINUE
+        DO 80 I=1,NY
+        HY(I) = SQRT(SASS)
+   80   CONTINUE
+      ELSE
+        DO 90 I=1,NX
+        HX(I)=(XX(I+1)-XX(I))/100.0
+   90   CONTINUE
+        DO 100 I=1,NY
+        HY(I)=(YY(I+1)-YY(I))/100.0
+  100   CONTINUE
+      ENDIF
+      DO 110 I=1,NZ
+      HZ(I)=(ZZ(I+1)-ZZ(I))/100.0
+  110 CONTINUE
+      DO 120 I=1,NZ+1
+      ZZ(I)=ZZ(I)/100.0
+  120 CONTINUE
+      CALL LCMPUT(IPTHM,'MESHZ',NZ+1,2,ZZ)
+      DEALLOCATE(ZZ,YY,XX)
+*----
+*  RECOVER LOCAL PARAMETER INFORMATION FROM L_MAP OBJECT
+*----
+      ALLOCATE(NUM(NEL),BURN(NCH*NB),PW(NCH*NB))
+      CALL LCMGET(IPMAP,'BMIX',NUM)
+      CALL LCMLEN(IPMAP,'BURN-INST',ILONG,ITYLCM)
+      IF(ILONG.EQ.NCH*NB) THEN
+        CALL LCMGET(IPMAP,'BURN-INST',BURN)
+      ELSE
+        CALL LCMLEN(IPMAP,'BURN-BEG',ILONG,ITYLCM)
+        IF(ILONG.NE.NCH*NB) CALL XABORT('@THM: MISSING BURNUP INFO ON '
+     >  //'FUELMAP.')
+        ALLOCATE(BURN2(NCH*NB))
+        CALL LCMGET(IPMAP,'BURN-BEG',BURN)
+        CALL LCMGET(IPMAP,'BURN-END',BURN2)
+        DO I=1,NCH*NB
+          BURN(I)=(BURN(I)+BURN2(I))/2.0
+        ENDDO
+        DEALLOCATE(BURN2)
+      ENDIF
+      CALL LCMLEN(IPTHM,'POWER-SR1',NPOWER,ITYLCM)
+      IF(NPOWER.NE.0) THEN
+*       USE POWER TIME LAW
+        IF(IMPX.GT.0) WRITE(6,*) 'THM: T-POWER = ',TPOW,' W'
+        IF(TPOW.EQ.0.0) CALL XABORT('@THM: T-POWER NOT DEFINED.')
+        IF(NCH.NE.1) CALL XABORT('@THM: NCH=1 EXPECTED.')
+        ALLOCATE(TIMESR(NPOWER),TPOWER(NPOWER),DTERP(NPOWER))
+        CALL LCMGET(IPTHM,'TIME-SR1',TIMESR)
+        CALL LCMGET(IPTHM,'POWER-SR1',TPOWER)
+        IF(ITIME.EQ.0) THEN
+          CALL ALTERP(.FALSE.,NPOWER,TIMESR(1),RTIME,.FALSE.,DTERP(1))
+        ELSE
+          IF(DTIME.EQ.0.0) CALL XABORT('@THM: DTIME NOT DEFINED.')
+          CALL ALTERI(.FALSE.,NPOWER,TIMESR(1),RTIME,RTIME+DTIME,
+     >    DTERP(1))
+          DO J=1,NPOWER
+            DTERP(J)=DTERP(J)/DTIME
+          ENDDO
+        ENDIF
+        DPOW=0.0D0
+        DO J=1,NPOWER
+          DPOW=DPOW+DTERP(J)*TPOWER(J)
+        ENDDO
+        DPOW=DPOW*TPOW
+        DEALLOCATE(DTERP,TPOWER,TIMESR)
+        CALL LCMLEN(IPMAP,'AXIAL-FPW',ILONG,ITYLCM)
+        IF(ILONG.NE.NB) CALL XABORT('THM: NO AXIAL-FPW ON THE FUELMAP')
+        ALLOCATE(PFORM(NB))
+        CALL LCMGET(IPMAP,'AXIAL-FPW',PFORM)
+        DO I=1,NB
+          PW(I)=DPOW*PFORM(I)*1.0E-3
+        ENDDO
+        DEALLOCATE(PFORM)
+      ELSE
+*       RECOVER POWER FROM FUELMAP
+        CALL LCMGET(IPMAP,'BUND-PW',PW)
+      ENDIF
+      IF(IMPX.GT.2) THEN
+        PTOT=0.0
+        DO I=1,NCH*NB
+          PTOT=PTOT+PW(I)
+        ENDDO
+      ENDIF
+*----
+*  REBUILD LOCAL PARAMETER INFORMATION FOR THM
+*----
+      ALLOCATE(IREFSC(NCH))
+      CALL LCMLEN(IPMAP,'REF-SCHEME',ILONG,ITYLCM)
+      IF(ILONG.EQ.NCH) THEN
+        CALL LCMGET(IPMAP,'REF-SCHEME',IREFSC)
+      ELSE
+        IREFSC(:NCH)=1
+      ENDIF
+      ALLOCATE(XBURN(NZ,NX,NY),POW(NZ,NX,NY))
+      XBURN(:NZ,:NX,:NY)=0.0
+      POW(:NZ,:NX,:NY)=0.0
+      ICH=0
+      DO 165 IY=1,NY
+      DO 160 IX=1,NX
+      IEL=(IY-1)*NX+IX
+      DO 130 IZ=1,NZ
+      IF(NUM((IZ-1)*NX*NY+IEL).NE.0) GO TO 140
+  130 CONTINUE
+      GO TO 160
+  140 ICH=ICH+1
+      IB=0
+      DO 150 IZ=1,NZ
+      IF(NUM((IZ-1)*NX*NY+IEL).EQ.0) GO TO 150
+      IB=IB+1
+      IMA=(IB-1)*NCH+ICH
+      IF(IREFSC(ICH).GT.0) THEN
+        XBURN(IZ,IX,IY)=BURN(IMA)
+        POW(IZ,IX,IY)=PW(IMA)*1.0E3
+      ELSE
+        XBURN(NZ-IZ+1,IX,IY)=BURN(IMA)
+        POW(NZ-IZ+1,IX,IY)=PW(IMA)*1.0E3
+      ENDIF
+  150 CONTINUE
+      IF(IB.NE.NB) CALL XABORT('@THM: INVALID NUMBER OF BUNDLES.')
+  160 CONTINUE
+  165 CONTINUE
+      IF(ICH.NE.NCH) CALL XABORT('@THM: INVALID NUMBER OF CHANNELS.')
+      DEALLOCATE(PW,BURN)
+*----
+*  RECOVER AVERAGE FUEL TEMPERATURE FIELD FROM THM OBJECT
+*----
+      ALLOCATE(TCOMB(NZ,NX,NY))
+      TCOMB(:NZ,:NX,:NY)=0.0
+      JPMAP=LCMGID(IPMAP,'PARAM')
+      DO 220 IPAR=1,NPARM
+      KPMAP=LCMGIL(JPMAP,IPAR)
+      CALL LCMGTC(KPMAP,'P-NAME',12,PNAME)
+      IF(PNAME.EQ.'T-FUEL') THEN
+        CALL LCMGET(KPMAP,'P-TYPE',ITYPE)
+        ALLOCATE(VAL(NCH,NB))
+        IF(ITYPE.EQ.1) THEN
+          IF(IMPX.GT.0) WRITE(6,510) 'GLOBAL',PNAME
+          CALL LCMGET(KPMAP,'P-VALUE',FLOT)
+          DO 175 ICH=1,NCH
+          DO 170 IB=1,NB
+          VAL(ICH,IB)=FLOT
+  170     CONTINUE
+  175     CONTINUE
+        ELSE IF(ITYPE.EQ.2) THEN
+          IF(IMPX.GT.0) WRITE(6,510) 'LOCAL',PNAME
+          CALL LCMGET(KPMAP,'P-VALUE',VAL)
+        ENDIF
+        ICH=0
+        DO 215 IY=1,NY
+        DO 210 IX=1,NX
+        IEL=(IY-1)*NX+IX
+        DO 180 IZ=1,NZ
+        IF(NUM((IZ-1)*NX*NY+IEL).NE.0) GO TO 190
+  180   CONTINUE
+        GO TO 210
+  190   ICH=ICH+1
+        IB=0
+        DO 200 IZ=1,NZ
+        IF(NUM((IZ-1)*NX*NY+IEL).EQ.0) GO TO 200
+        IB=IB+1
+        IF(IREFSC(ICH).GT.0) THEN
+          TCOMB(IZ,IX,IY)=VAL(ICH,IB)
+        ELSE
+          TCOMB(NZ-IZ+1,IX,IY)=VAL(ICH,IB)
+        ENDIF
+  200   CONTINUE
+  210   CONTINUE
+  215   CONTINUE
+        DEALLOCATE(VAL)
+      ENDIF
+  220 CONTINUE
+      DEALLOCATE(IREFSC)
+*---- 
+*  TEST TO COMPUTE STEADY-STATE OR TRANSIENT CALCULATION
+*----
+      IF(ITIME.EQ.0) THEN
+         GO TO 230
+      ELSE IF(ITIME.EQ.1) THEN
+         GO TO 310
+      ELSE
+         CALL XABORT('@THM: UNEXPECTED VALUE FOR ITIME.')
+      ENDIF
+*----
+*  CALL DRIVER FOR STEADY-STATE CALCULATION
+*----
+*     memory allocation for the steady-state calculation
+  230 ALLOCATE(DCOOL(NZ,NX,NY),TCOOL(NZ,NX,NY),TSURF(NZ,NX,NY),
+     > PCOOL(NZ,NX,NY),HCOOL(NZ,NX,NY),RAD((NDTOT-1),NZ,NX,NY))
+      DCOOL(:NZ,:NX,:NY)=0.0
+      TCOOL(:NZ,:NX,:NY)=0.0
+      TSURF(:NZ,:NX,:NY)=0.0
+      PCOOL(:NZ,:NX,:NY)=0.0
+      HCOOL(:NZ,:NX,:NY)=0.0
+      RAD(:NDTOT-1,:NZ,:NX,:NY)=0.0
+*----
+*  COMPUTE FUEL RADII
+*----
+      ALLOCATE(RVAL((NDTOT-1),NZ))
+      IF(JENTRY(1).EQ.0) THEN
+        WRITE(6,*)'RC,RIG=',RC,RIG
+*CGT THERE IS GAP
+        IF(RC.NE.RIG) THEN
+          IGAP=0
+          ARF=0.5*RC**2  ! at fuel radius
+          ARCI=0.5*RIG**2 ! at internal clad radius
+          ARCE=0.5*RGG**2 ! at external clad radius
+          DARF=ARF/REAL(NFD-1)
+          DARC=(ARCE-ARCI)/REAL(NDTOT-NFD-2)
+          DO IEL=1,NZ
+            RVAL(1,IEL)=0.0
+            DO I=1,NFD-1
+              RVAL(I+1,IEL)=REAL(SQRT(2.0D0*REAL(I)*DARF))
+            ENDDO
+            DO I=NFD+1,NDTOT-1
+              RVAL(I,IEL)=REAL(SQRT(2.0D0*(ARCI+REAL(I-NFD-1)*DARC)))
+            ENDDO
+          ENDDO
+        ELSE
+*CGT NO GAP
+          IGAP=1
+          ARF=0.5*RC**2  ! at fuel radius
+          ARCE=0.5*RGG**2 ! at external clad radius
+          DARF=ARF/REAL(NFD-1)
+          DARC=(ARCE-ARF)/REAL(NDTOT-NFD-1)
+          DO IEL=1,NZ
+            RVAL(1,IEL)=0.0
+            DO I=1,NFD
+              RVAL(I+1,IEL)=REAL(SQRT(2.0D0*REAL(I)*DARF))
+            ENDDO
+            DO I=NFD+1,NDTOT-1
+              RVAL(I,IEL)=REAL(SQRT(2.0D0*(ARF+REAL(I-NFD)*DARC)))
+            ENDDO
+          ENDDO
+        ENDIF
+        CALL LCMPUT(IPTHM,'REF-RAD',(NDTOT-1)*NZ,2,RVAL)
+        JPTHM=LCMDID(IPTHM,'HISTORY-DATA')
+        KPTHM=LCMDID(JPTHM,'TIMESTEP0000')
+        LPTHM=LCMLID(KPTHM,'CHANNEL',NCH)
+      ELSE
+        JPTHM=LCMGID(IPTHM,'HISTORY-DATA')
+        KPTHM=LCMGID(JPTHM,'TIMESTEP0000')
+        LPTHM=LCMGID(KPTHM,'CHANNEL')
+      ENDIF
+*----
+*  LOOP OVER REACTOR CHANNELS
+*----
+      ICH=0
+      SUMSEC=0.0
+      DO 265 IY=1,NY
+      DO 260 IX=1,NX
+        IEL=IX+(IY-1)*NX
+        DO 240 IZ=1,NZ
+          IF(NUM((IZ-1)*NX*NY+IEL).NE.0) GO TO 250
+  240   CONTINUE
+        GO TO 260
+  250   ICH=ICH+1
+*----
+*  COMPUTE HYDRAULICS CONSTANTS
+*  SASS:    assembly cross section in m^2
+*  RC:      fuel pellet radius in m
+*  RTG:     guide tube radius in m
+*  ACOOL:   coolant cross section per assembly in m^2
+*  RAPCOOL: assembly over coolant volumic ratio
+*  RAPFUEL: assembly over fuel volumic ratio
+*  FCOOL:   power density fraction in coolant.
+*  FFUEL:   power density fraction in fuel.
+*  PCH:     heating perimeter in m
+*  PM:      perimeter in contact with flow in m
+*  HD:      hydraulic diameter of one assembly in m
+*  SPEED:   inlet flow velocity in m/s
+*----
+        IF(FNFUCST(ICH).EQ.0.0) GO TO 260
+        SASS=HX(IX)*HY(IY)
+        DO K=1, NZ
+          FNFU(ICH,K)=FNFUCST(ICH)
+          FNTG(ICH,K)=FNTGCST(ICH)
+        IF(PITCH.EQ.0.0) THEN
+*         PWR ASSEMBLY
+          ACOOL(K)=SASS-FNFU(ICH,K)*PI*RGG*RGG-FNTG(ICH,K)*PI*RTG*RTG
+          RAPCOOL(K)=SASS/ACOOL(K)
+          PCH(K)=FNFU(ICH,K)*2.0*PI*RGG
+          PM=PCH(K)+FNTG(ICH,K)*2.0*PI*RTG
+          SUMSEC=SUMSEC+ACOOL(K)
+        ELSE
+*         CANDU CLUSTER
+          ATOTHEX=3.0*PITCH**2.0*(3.0)**0.5/2.0
+          ATIGEHEX=3.0*PI*RGG*RGG
+          ACOOL(K)=ATOTHEX-ATIGEHEX
+          PM(K)=6.0*PI*RGG
+          PCH(K)=PM(K)
+          RAPCOOL(K)=3.0*SASS/(FNFU(ICH,K)*ACOOL(K))
+          SUMSEC=SUMSEC+FNFU(ICH,K)*ACOOL(K)/3.0
+        ENDIF
+        RAPFUEL(K)=SASS/(FNFU(ICH,K)*PI*RC*RC)
+        FCOOL(K)=(1.0-FPUISS)*RAPCOOL(K)
+        FFUEL(K)=FPUISS*RAPFUEL(K)
+        HD(K)=4.0*ACOOL(K)/PM(K)
+        IF(HD(K).LE.0.) CALL XABORT('THM: NEGATIVE HYDRAULIC 
+     >DIAMETER(1).')
+        ENDDO
+*----
+*  RECOVER STEADY-STATE RADII
+*----
+        IF(JENTRY(1).EQ.0) THEN
+          RAD(:,:,IX,IY)=RVAL(:,:)
+        ELSE IF(JENTRY(1).EQ.1) THEN
+          MPTHM=LCMGIL(LPTHM,ICH)
+          CALL LCMGET(MPTHM,'RADII',RAD(1,1,IX,IY))
+        ENDIF
+*----
+*  EXECUTION OF THE STEADY-STATE DRIVER PROGRAM
+*----
+        MPTHM=LCMDIL(LPTHM,ICH)
+        CALL THMDRV(MPTHM,IMPX,IX,IY,NZ,XBURN(1,IX,IY),SASS,HZ,CFLUX,
+     >  POROS,FNFU(ICH,:),NFD,NDTOT,IFLUID,SNAME,SCOMP,IGAP,IFUEL,FNAME,
+     >  FCOMP,FCOOL,FFUEL,ACOOL,
+     >  HD,PCH,RAD(1,1,IX,IY),MAXIT1,MAXIT2,ERMAXT,SPEED,TINLET,POULET,
+     >  FRACPU(ICH),ICONDF,NCONDF,KCONDF,UCONDF,ICONDC,NCONDC,KCONDC,
+     >  UCONDC,IHGAP,KHGAP,IHCONV,KHCONV,WTEFF,IFRCDI,ISUBM,FRO,
+     >  POW(1,IX,IY),IPRES,IDFM,TCOMB(1,IX,IY),DCOOL(1,IX,IY),
+     >  TCOOL(1,IX,IY),TSURF(1,IX,IY),HCOOL(1,IX,IY),PCOOL(1,IX,IY))
+  260 CONTINUE
+  265 CONTINUE
+      IF(IMPX.GT.1) WRITE(6,610) SUMSEC,CWSECT
+      DEALLOCATE(RVAL)
+      CALL LCMPUT(KPTHM,'TIME',1,2,RTIME)
+      IF(IMPX.GT.1) WRITE(6,470) 'TIMESTEP0000',RTIME
+*----
+*  PRINT AVERAGED THERMALHYDRAULICS PROPERTIES OVER THE CORE MAP
+*----
+      IF(IMPX.GT.1) THEN
+        CALL THMAVG(IPMAP,IMPX,NX,NY,NZ,NCH,TCOMB,TSURF,DCOOL,TCOOL,
+     >  PCOOL,HCOOL,POW,NSIMS)
+      ENDIF
+      DEALLOCATE(RAD,HCOOL)
+      GO TO 400
+*----
+* CALL DRIVER FOR TRANSIENT CALCULATION
+*----
+*     memory allocation for the transient calculation
+  310 ALLOCATE(TSURF(NZ,NX,NY),TCOOL(NZ,NX,NY),DCOOL(NZ,NX,NY),
+     > PCOOL(NZ,NX,NY))
+      TSURF(:NZ,:NX,:NY)=0.0
+      TCOOL(:NZ,:NX,:NY)=0.0
+      DCOOL(:NZ,:NX,:NY)=0.0
+      PCOOL(:NZ,:NX,:NY)=0.0
+*----
+*  RECOVER TIME INDEX AT INITIAL CONDITIONS
+*----
+      JPTHM=LCMDID(IPTHM,'HISTORY-DATA')
+      KPTHMI=LCMGID(JPTHM,'TIMESTEP0000')
+      CALL LCMGET(KPTHMI,'TIME',TIMEPR)
+      IF(ABS(RTIME-TIMEPR).LE.1.0E-3*DTIME) THEN
+        TIMEIT=1
+      ELSE
+        DO I=1,TIMEIT
+          WRITE(TXTDIR,'(8HTIMESTEP,I4.4)') I
+          KPTHMI=LCMGID(JPTHM,TXTDIR)
+          CALL LCMGET(KPTHMI,'TIME',TIMEPR)
+          IF(ABS(RTIME-TIMEPR).LE.1.0E-3*DTIME) THEN
+            TIMEIT=I+1
+            GO TO 315
+          ENDIF
+        ENDDO
+        WRITE(HSMG,'(45H@THM: UNABLE TO FIND INITIAL CONDITIONS AT T=,
+     >  1P,E14.4,3H S.)') RTIME
+        CALL XABORT(HSMG)
+      ENDIF
+  315 LPTHMI=LCMGID(KPTHMI,'CHANNEL')
+      WRITE(TXTDIR,'(8HTIMESTEP,I4.4)') TIMEIT
+      KPTHM=LCMDID(JPTHM,TXTDIR)
+      LPTHM=LCMLID(KPTHM,'CHANNEL',NCH)
+      IF(IMPX.GT.1) WRITE(6,530) TIMEIT,RTIME,RTIME+DTIME
+*----
+*  LOOP OVER REACTOR CHANNELS
+*----
+      ICH=0
+      DO 355 IY=1,NY
+      DO 350 IX=1,NX
+        IEL=IX+(IY-1)*NX
+        DO 320 IZ=1,NZ
+          IF(NUM((IZ-1)*NX*NY+IEL).NE.0) GO TO 330
+  320   CONTINUE
+        GO TO 350
+  330   ICH=ICH+1
+*----
+*  COMPUTE HYDRAULICS CONSTANTS
+*----
+        IF(FNFUCST(ICH).EQ.0.0) GO TO 350
+        SASS=HX(IX)*HY(IY)
+        DO K=1, NZ
+          FNFU(ICH,K)=FNFUCST(ICH)
+          FNTG(ICH,K)=FNTGCST(ICH)
+        IF(PITCH.EQ.0.0) THEN
+*         PWR ASSEMBLY
+          ACOOL(K)=SASS-FNFU(ICH,K)*PI*RGG*RGG-FNTG(ICH,K)*PI*RTG*RTG
+          RAPCOOL(K)=SASS/ACOOL(K)
+          PCH(K)=FNFU(ICH,K)*2.0*PI*RGG
+          PM=PCH(K)+FNTG(ICH,K)*2.0*PI*RTG
+        ELSE
+*         CANDU CLUSTER
+          ATOTHEX=3.0*PITCH**2.0*(3.0)**0.5/2.0
+          ATIGEHEX=3.0*PI*RGG*RGG
+          ACOOL(K)=ATOTHEX-ATIGEHEX
+          PM(K)=6.0*PI*RGG
+          PCH(K)=PM(K)
+          RAPCOOL(K)=3.0*SASS/(FNFU(ICH,K)*ACOOL(K))
+        ENDIF
+        RAPFUEL(K)=SASS/(FNFU(ICH,K)*PI*RC*RC)
+        FCOOL(K)=(1.0-FPUISS)*RAPCOOL(K)
+        FFUEL(K)=FPUISS*RAPFUEL(K)
+        HD(K)=4.0*ACOOL(K)/PM(K)
+        IF(HD(K).LE.0.) CALL XABORT('THM: NEGATIVE HYDRAULIC 
+     >DIAMETER(2).')
+        ENDDO
+*----
+*  EXECUTION OF THE TRANSIENT DRIVER PROGRAM
+*----
+        MPTHMI=LCMGIL(LPTHMI,ICH)
+        MPTHM=LCMDIL(LPTHM,ICH)
+        CALL THMTRS(MPTHMI,MPTHM,IMPX,IX,IY,NZ,XBURN(1,IX,IY),SASS,HZ,
+     >  DTIME,CFLUX,POROS,FNFU(ICH,:),NFD,NDTOT,IFLUID,SNAME,SCOMP,
+     >  IGAP,IFUEL,FNAME,FCOMP,   
+     >  FCOOL,FFUEL,ACOOL,HD,PCH,MAXIT3,MAXIT1,MAXIT2,ERMAXT,ERMAXC,
+     >  SPEED,TINLET,POULET,FRACPU(ICH),ICONDF,NCONDF,KCONDF,UCONDF,
+     >  ICONDC,NCONDC,KCONDC,UCONDC,IHGAP,KHGAP,IHCONV,KHCONV,WTEFF,
+     >  IFRCDI,ISUBM,FRO,POW(1,IX,IY),TCOMB(1,IX,IY),DCOOL(1,IX,IY),
+     >  TCOOL(1,IX,IY),TSURF(1,IX,IY))
+  350 CONTINUE
+  355 CONTINUE
+      CALL LCMPUT(KPTHM,'TIME',1,2,RTIME+DTIME)
+      IF(IMPX.GT.1) WRITE(6,470) TXTDIR,RTIME+DTIME
+*----
+*  RECOVER LOCAL PARAMETER INFORMATION COMPUTED BY THMDRV OR THMTRS
+*----
+  400 ERRA1=0.0
+      ERRA2=0.0
+      ERRA3=0.0
+      ERRBB=0.0
+      ZMINA1=1.0E10
+      ZMINA2=1.0E10
+      ZMINA3=1.0E10
+      ZMINBB=1.0E10
+      ZMAXA1=0.0
+      ZMAXA2=0.0
+      ZMAXA3=0.0
+      ZMAXBB=0.0
+      RATIOX=0.0
+      ALLOCATE(IREFSC(NCH))
+      CALL LCMLEN(IPMAP,'REF-SCHEME',ILONG,ITYLCM)
+      IF(ILONG.EQ.NCH) THEN
+        CALL LCMGET(IPMAP,'REF-SCHEME',IREFSC)
+      ELSE
+        IREFSC(:NCH)=1
+      ENDIF
+      JPMAP=LCMGID(IPMAP,'PARAM')
+      DO 460 IPAR=1,NPARM
+      KPMAP=LCMGIL(JPMAP,IPAR)
+      CALL LCMGTC(KPMAP,'P-NAME',12,PNAME)
+      IF((PNAME.EQ.'T-FUEL').OR.(PNAME.EQ.'D-COOL').OR.
+     1   (PNAME.EQ.'T-COOL').OR.(PNAME.EQ.'T-SURF').OR.
+     2   (PNAME.EQ.'P-COOL')) THEN
+        CALL LCMGET(KPMAP,'P-TYPE',ITYPE)
+        ALLOCATE(VAL(NCH,NB))
+        RELAX0=1.0
+        IF(ITYPE.EQ.1) THEN
+          IF(IMPX.GT.0) WRITE(6,510) 'GLOBAL',PNAME
+          CALL LCMGET(KPMAP,'P-VALUE',FLOT)
+          DO 415 ICH=1,NCH
+          DO 410 IB=1,NB
+          VAL(ICH,IB)=FLOT
+  410     CONTINUE
+  415     CONTINUE
+        ELSE IF(ITYPE.EQ.2) THEN
+          RELAX0=RELAX
+          IF(IMPX.GT.0) WRITE(6,510) 'LOCAL',PNAME
+          CALL LCMGET(KPMAP,'P-VALUE',VAL)
+        ENDIF
+        ICH=0
+        DO 455 IY=1,NY
+        DO 450 IX=1,NX
+        IEL=(IY-1)*NX+IX
+        DO 420 IZ=1,NZ
+        IF(NUM((IZ-1)*NX*NY+IEL).NE.0) GO TO 430
+  420   CONTINUE
+        GO TO 450
+  430   ICH=ICH+1
+        IB=0
+        DO 440 IZ=1,NZ
+        IF(NUM((IZ-1)*NX*NY+IEL).EQ.0) GO TO 440
+        IB=IB+1
+        FLOT=0.0
+        IF(PNAME.EQ.'T-FUEL') THEN
+          IF(IREFSC(ICH).GT.0) THEN
+            FLOT=RELAX0*TCOMB(IZ,IX,IY)+(1.0-RELAX0)*VAL(ICH,IB)
+          ELSE
+            FLOT=RELAX0*TCOMB(NZ-IZ+1,IX,IY)+(1.0-RELAX0)*VAL(ICH,IB)
+          ENDIF
+          IF(ITIME.EQ.0) ERRA1=MAX(ERRA1,ABS(VAL(ICH,IB)-FLOT))
+          ZMINA1=MIN(ZMINA1,FLOT)
+          ZMAXA1=MAX(ZMAXA1,FLOT)
+        ELSE IF(PNAME.EQ.'D-COOL') THEN
+          IF(IREFSC(ICH).GT.0) THEN
+            FLOT=RELAX0*DCOOL(IZ,IX,IY)/ZKILO+(1.0-RELAX0)*VAL(ICH,IB)
+          ELSE
+            FLOT=RELAX0*DCOOL(NZ-IZ+1,IX,IY)/ZKILO+(1.0-RELAX0)
+     >      *VAL(ICH,IB)
+          ENDIF
+          IF(ITIME.EQ.0) ERRA2=MAX(ERRA2,ABS(VAL(ICH,IB)-FLOT))
+          ZMINA2=MIN(ZMINA2,FLOT)
+          ZMAXA2=MAX(ZMAXA2,FLOT)
+        ELSE IF(PNAME.EQ.'T-COOL') THEN
+          IF(IREFSC(ICH).GT.0) THEN
+            FLOT=RELAX0*TCOOL(IZ,IX,IY)+(1.0-RELAX0)*VAL(ICH,IB)
+          ELSE
+            FLOT=RELAX0*TCOOL(NZ-IZ+1,IX,IY)+(1.0-RELAX0)*VAL(ICH,IB)
+          ENDIF
+          IF(ITIME.EQ.0) ERRA3=MAX(ERRA3,ABS(VAL(ICH,IB)-FLOT))
+          ZMINA3=MIN(ZMINA3,FLOT)
+          ZMAXA3=MAX(ZMAXA3,FLOT)
+        ELSE IF(PNAME.EQ.'T-SURF') THEN
+          IF(IREFSC(ICH).GT.0) THEN
+            FLOT=RELAX0*TSURF(IZ,IX,IY)+(1.0-RELAX0)*VAL(ICH,IB)
+          ELSE
+            FLOT=RELAX0*TSURF(NZ-IZ+1,IX,IY)+(1.0-RELAX0)*VAL(ICH,IB)
+          ENDIF
+          IF(ITIME.EQ.0) ERRBB=MAX(ERRBB,ABS(VAL(ICH,IB)-FLOT))
+          ZMINBB=MIN(ZMINBB,FLOT)
+          ZMAXBB=MAX(ZMAXBB,FLOT)
+        ELSE IF(PNAME.EQ.'P-COOL') THEN
+          IF(IREFSC(ICH).GT.0) THEN
+            FLOT=RELAX0*PCOOL(IZ,IX,IY)+(1.0-RELAX0)*VAL(ICH,IB)
+          ELSE
+            FLOT=RELAX0*PCOOL(NZ-IZ+1,IX,IY)+(1.0-RELAX0)*VAL(ICH,IB)
+          ENDIF
+          IF(ITIME.EQ.0) ERRA4=MAX(ERRBB,ABS(VAL(ICH,IB)-FLOT))
+          ZMINA4=MIN(ZMINBB,FLOT)
+          ZMAXA4=MAX(ZMAXBB,FLOT)
+        ELSE
+          CALL XABORT('@THM: INVALID PARAMETER TYPE: '// PNAME//'.')
+        ENDIF
+        VAL(ICH,IB)=FLOT
+  440   CONTINUE
+  450   CONTINUE
+  455   CONTINUE
+        ITYPE=2
+        CALL LCMPUT(KPMAP,'P-TYPE',1,1,ITYPE)
+        CALL LCMPUT(KPMAP,'P-VALUE',NCH*NB,2,VAL)
+        CALL LCMLEN(IPMAP,'AXIAL-FPW',JLONG,ITYLCM)
+        DD1=0.0
+        DD2=0.0
+        IF(JLONG.NE.0) THEN
+          ALLOCATE(FPOWER(NB))
+          IF(JLONG.NE.NB) CALL XABORT('THM: UNABLE TO FIND RECORD AXIA'
+     1    //'L-FPW IN THE FUELMAP.')
+          CALL LCMGET(IPMAP,'AXIAL-FPW',FPOWER)
+          DO ICH=1,NCH
+            DO IB=1,NB
+              DD1=DD1+VAL(ICH,IB)*FPOWER(IB)**2
+              DD2=DD2+FPOWER(IB)**2
+            ENDDO
+          ENDDO
+          DEALLOCATE(FPOWER)
+        ELSE
+          ALLOCATE(PW(NCH*NB))
+          CALL LCMGET(IPMAP,'BUND-PW',PW)
+          ITOT=0
+          DO IB=1,NB
+            DO ICH=1,NCH
+              ITOT=ITOT+1
+              DD1=DD1+VAL(ICH,IB)*PW(ITOT)**2
+              DD2=DD2+PW(ITOT)**2
+            ENDDO
+          ENDDO
+          DEALLOCATE(PW)
+        ENDIF
+        TMOY0=DD1/DD2
+        TEXT12='AVG-'//PNAME(:8)
+        CALL LCMLEN(IPTHM,TEXT12,KLONG,ITYLCM)
+        IF(((PNAME.EQ.'T-FUEL').OR.(PNAME.EQ.'T-COOL').OR.
+     1  (PNAME.EQ.'P-COOL')).AND.(KLONG.GT.0)) THEN
+          CALL LCMGET(IPTHM,TEXT12,TMOY0I)
+          IF(PNAME.EQ.'T-FUEL') THEN
+            RATIO=ABS(TMOY0/DTEMPR-TMOY0I/DTEMPR)
+            IF(IMPX.GT.0) WRITE(6,490) TEXT12,TMOY0I,TMOY0,RATIO
+            RATIOX=MAX(RATIOX,RATIO)
+          ELSE IF(PNAME.EQ.'T-COOL') THEN
+            RATIO=ABS(TMOY0/DTEMPT-TMOY0I/DTEMPT)
+            IF(IMPX.GT.0) WRITE(6,490) TEXT12,TMOY0I,TMOY0,RATIO
+            RATIOX=MAX(RATIOX,RATIO)
+          ELSE IF(PNAME.EQ.'P-COOL') THEN
+            RATIO=ABS(TMOY0/DPRESS-TMOY0I/DPRESS)
+            IF(IMPX.GT.0) WRITE(6,490) TEXT12,TMOY0I,TMOY0,RATIO
+            RATIOX=MAX(RATIOX,RATIO)
+          ENDIF
+        ENDIF
+        CALL LCMPUT(IPTHM,TEXT12,1,2,TMOY0)
+        DEALLOCATE(VAL)
+      ENDIF
+      IF(PNAME.EQ.'T-FUEL') THEN
+        IF(ITIME.EQ.0) CALL LCMPUT(IPTHM,'ERROR-T-FUEL',1,2,ERRA1)
+        CALL LCMPUT(IPTHM,'MIN-T-FUEL',1,2,ZMINA1)
+        CALL LCMPUT(IPTHM,'MAX-T-FUEL',1,2,ZMAXA1)
+        IF(IMPX.GT.0) WRITE(6,520) 'FUEL TEMPERATURE',ERRA1,'K',
+     1  ZMINA1,'K',ZMAXA1,'K'
+      ELSE IF(PNAME.EQ.'D-COOL') THEN
+        IF(ITIME.EQ.0) CALL LCMPUT(IPTHM,'ERROR-D-COOL',1,2,ERRA2)
+        CALL LCMPUT(IPTHM,'MIN-D-COOL',1,2,ZMINA2)
+        CALL LCMPUT(IPTHM,'MAX-D-COOL',1,2,ZMAXA2)
+        IF(IMPX.GT.0) WRITE(6,520) 'COOLANT DENSITY',ERRA2,'g/cc',
+     1  ZMINA2,'g/cc',ZMAXA2,'g/cc'
+      ELSE IF(PNAME.EQ.'T-COOL') THEN
+        IF(ITIME.EQ.0) CALL LCMPUT(IPTHM,'ERROR-T-COOL',1,2,ERRA3)
+        CALL LCMPUT(IPTHM,'MIN-T-COOL',1,2,ZMINA3)
+        CALL LCMPUT(IPTHM,'MAX-T-COOL',1,2,ZMAXA3)
+        IF(IMPX.GT.0) WRITE(6,520) 'COOLANT TEMPERATURE',ERRA3,'K',
+     1  ZMINA3,'K',ZMAXA3,'K'
+      ELSE IF(PNAME.EQ.'T-SURF') THEN
+        IF(ITIME.EQ.0) CALL LCMPUT(IPTHM,'ERROR-T-SURF',1,2,ERRBB)
+        IF(IMPX.GT.0) WRITE(6,520) 'FUEL SURFACE TEMPERATURE',ERRBB,
+     1  'K',ZMINBB,'K',ZMAXBB,'K'
+      ELSE IF(PNAME.EQ.'P-COOL') THEN
+        IF(ITIME.EQ.0) CALL LCMPUT(IPTHM,'ERROR-P-COOL',1,2,ERRA4)
+        CALL LCMPUT(IPTHM,'MIN-P-COOL',1,2,ZMINA4)
+        CALL LCMPUT(IPTHM,'MAX-P-COOL',1,2,ZMAXA4)
+        IF(IMPX.GT.0) WRITE(6,520) 'COOLANT PRESSURE',ERRA4,'Pa',
+     1  ZMINA4,'Pa',ZMAXA4,'Pa'
+      ENDIF
+  460 CONTINUE
+      DEALLOCATE(IREFSC)
+*----
+*  SAVE CONDUCTIVITY INFORMATION ON LCM OBJECT THM
+*----
+      IF(ICONDF.EQ.1) THEN
+        CALL LCMPUT(IPTHM,'KCONDF',NCONDF+3,2,KCONDF)
+        CALL LCMPTC(IPTHM,'UCONDF',12,UCONDF)
+      ENDIF
+      IF(ICONDC.EQ.1) THEN
+        CALL LCMPUT(IPTHM,'KCONDC',NCONDC+1,2,KCONDC)
+        CALL LCMPTC(IPTHM,'UCONDC',12,UCONDC)
+      ENDIF
+*----
+*  RELEASE MEMORY
+*----
+      DEALLOCATE(ACOOL,PCH,HD)
+      DEALLOCATE(RAPCOOL,RAPFUEL,PM,FNFU,FNTG,FFUEL,FCOOL)
+      DEALLOCATE(PCOOL,DCOOL,TCOOL,TSURF,TCOMB)
+      DEALLOCATE(NUM)
+      DEALLOCATE(POW,XBURN)
+      DEALLOCATE(FRO)
+      IF(ICONDF.EQ.1)DEALLOCATE(KCONDF)
+      IF(ICONDC.EQ.1)DEALLOCATE(KCONDC)
+*----
+*  STATE-VECTOR FOR THM
+*----
+      HSIGN='L_THM'
+      CALL LCMPTC(IPTHM,'SIGNATURE',12,HSIGN)
+      ISTATE(:NSTATE)=0
+      ISTATE(1)=NCH
+      ISTATE(2)=NZ
+      ISTATE(3)=MAXIT1
+      ISTATE(4)=MAXIT2
+      ISTATE(5)=MAXIT3
+      ISTATE(6)=NFD
+      ISTATE(7)=NDTOT
+      ISTATE(8)=ITIME
+      ISTATE(9)=TIMEIT
+      ISTATE(10)=IHGAP
+      ISTATE(11)=IHCONV
+      ISTATE(12)=ICONDF
+      ISTATE(13)=ICONDC
+      ISTATE(14)=IFRCDI
+      ISTATE(15)=ISUBM
+      IF(ICONDF.EQ.1) ISTATE(16)=NCONDF
+      IF(ICONDC.EQ.1) ISTATE(17)=NCONDC
+      ISTATE(18)=NPRAD
+      ISTATE(19)=NPOWER
+      ISTATE(20)=IFLUID
+      ISTATE(21)=IGAP
+      ISTATE(22)=IPRES
+      ISTATE(23)=IDFM
+      CALL LCMPUT(IPTHM,'STATE-VECTOR',NSTATE,1,ISTATE)
+      STATE(:NSTATE)=0.0
+      STATE(1)=DTIME
+      STATE(2)=FPUISS
+      STATE(3)=CFLUX
+      STATE(4)=SPEED
+      STATE(5)=POULET
+      STATE(6)=TINLET
+      STATE(7)=POROS
+      STATE(8)=RC
+      STATE(9)=RIG
+      STATE(10)=RGG
+      STATE(11)=RTG
+      STATE(12)=PITCH
+      STATE(13)=ERMAXT
+      STATE(14)=ERMAXC
+      STATE(15)=RELAX
+      STATE(16)=RTIME
+      IF(IHGAP.EQ.1) STATE(17)=KHGAP
+      IF(IHCONV.EQ.1) STATE(18)=KHCONV
+      STATE(19)=WTEFF
+      STATE(20)=TPOW
+      STATE(21)=RATIOX
+      STATE(22)=EPSR
+      STATE(23)=THETA
+      CALL LCMPUT(IPTHM,'REAL-PARAM',NSTATE,2,STATE)
+      IF(IMPX.GT.0) THEN
+         WRITE(6,540) ISTATE(:15),ISTATE(18:23)
+         IF(ISTATE(10).EQ.1) WRITE(6,550) (ISTATE(16))
+         IF(ISTATE(11).EQ.1) WRITE(6,560) (ISTATE(17))
+         WRITE(6,570) STATE(:16),STATE(19),STATE(21:23)
+         IF(ISTATE(10).EQ.1) WRITE(6,580) (STATE(17))
+         IF(ISTATE(11).EQ.1) WRITE(6,590) (STATE(18))
+         IF(ISTATE(19).GT.0) WRITE(6,600) (STATE(20))
+      ENDIF
+      IF(IMPX.GT.4) CALL LCMLIB(IPTHM)
+*----
+*  SAVE CELL-DEPENDENT DATA
+*----
+      CALL LCMPUT(IPTHM,'NB-FUEL',NCH,2,FNFUCST)
+      CALL LCMPUT(IPTHM,'NB-TUBE',NCH,2,FNTGCST)
+      CALL LCMPUT(IPTHM,'FRACT-PU',NCH,2,FRACPU)
+      DEALLOCATE(FRACPU,FNTGCST,FNFUCST)
+*----
+*  RECOVER THE VARIATION RATIO AND SAVE IT IN A CLE-2000 VARIABLE
+*----
+      IF(IPICK.EQ.1) THEN
+         CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+         IF(ITYP.NE.-2) CALL XABORT('THM: OUTPUT REAL EXPECTED.')
+         ITYP=2
+         CALL REDPUT(ITYP,NITMA,RATIOX,TEXT12,DFLOT)
+         CALL REDGET(ITYP,NITMA,FLOT,TEXT12,DFLOT)
+         IF((ITYP.NE.3).OR.(TEXT12.NE.';')) THEN
+           CALL XABORT('THM: ; CHARACTER EXPECTED.')
+         ENDIF      
+      ENDIF      
+      RETURN
+*
+  470 FORMAT(/11H THM: SAVE ,A,9H AT TIME=,1P,E12.4,3H S.)
+  480 FORMAT(/31H THM: RADIAL POWER FORM FACTORS/(1P,10E12.4))
+  490 FORMAT(/18H THM: PARAMETER = ,A,1P,E12.4,3H ->,E12.4,7H RATIO=,
+     1 E12.4)
+  500 FORMAT(/27H THM: SET GLOBAL PARAMETER ,A,2H =,1P E12.4)
+  510 FORMAT(/14H THM: RECOVER ,A,13H PARAMETER = ,A,1H.)
+  520 FORMAT(/15H THM: ERROR ON ,A,2H =,F12.3,1X,A,13H  MIN VALUE =,
+     1 F12.3,1X,A,13H  MAX VALUE =,F12.3,1X,A)
+  530 FORMAT(/28H THM: PERFORM TRANSIENT STEP,I5,9H BETWEEN ,1P,E14.4,
+     1 4H AND,E14.4,3H S.)
+  540 FORMAT(/
+     1 14H STATE VECTOR:/
+     2 7H NZ    ,I9,27H   (NUMBER OF AXIAL MESHES)/
+     3 7H NCH   ,I9,43H   (NUMBER OF CHANNELS IN THE RADIAL PLANE)/
+     4 7H MAXIT1,I9,36H   (NUMBER OF CONDUCTION ITERATIONS)/
+     5 7H MAXIT2,I9,39H   (NUMBER OF CENTER-PELLET ITERATIONS)/
+     6 7H MAXIT3,I9,30H   (NUMBER OF FLOW ITERATIONS)/
+     7 7H NFD   ,I9,32H   (NUMBER OF FUEL RADIAL ZONES)/
+     8 7H NDTOT ,I9,36H   (NUMBER OF DISCRETISATION POINTS)/
+     9 7H ITIME ,I9,21H   (CALCULATION TYPE)/
+     1 7H TIMEIT,I9,30H   (TRANSIENT ITERATION INDEX)/
+     2 7H IHGAP ,I9,34H   (HGAP FLAG (0=DEFAULT/1=FIXED))/
+     3 7H IHCONV,I9,42H   (HCONV FLAG (0=DITTUS-BOELTER/1=FIXED))/
+     4 7H ICONDF,I9,46H   (FUEL CONDUCTIVITY FLAG (0=STORA-CHENEBAULT,
+     5 54H (UOX), COMETHE (MOX)/1=USER-PROVIDED FUNCTION OF FUEL,
+     6 14H TEMPERATURE))/
+     7 7H ICONDC,I9,39H   (CLAD CONDUCTIVITY FLAG (0=DEFAULT/1,
+     8 47H=USER-PROVIDED POLYNOMIAL OF CLAD TEMPERATURE))/
+     9 7H IFRCDI,I9,40H   (FUEL CONDUCTIVITY APPROXIMATION FLAG,
+     1 44H (0=DEFAULT/1=AVERAGE APPROXIMATION FORCED))/
+     2 7H ISUBM ,I9,47H   (BOILING MODEL FLAG (0=ONE-PHASE/1=BOWRING C,
+     3 37HORRELATION/2=SAHA-ZUBER CORRELATION))/
+     4 7H NPRAD ,I9,47H   (RADIAL POWER FORM FACTOR (0=FLAT/NUMBER OF ,
+     5 8HPOINTS))/
+     6 7H NPOWER,I9,36H   (NUMBER OF POINTS IN POWER-TABLE)/
+     7 7H IFLUID,I9,32H   (TYPE OF FLUID (0=H2O/1=D2O))/
+     8 7H IGAP  ,I9,39H   (GAP IS CONSIDERED (0=GAP/1=NO GAP))/
+     9 7H IPRES ,I9,46H   (PRESSURE DROP (0=CONSTANT/1=NON CONSTANT))/
+     1 7H IDFM  ,I9,47H   (DRIFT FLUX MODEL (0=HEM1/1=EPRI/2=MODEBSTIO,
+     2 21HN/3=GERAMP/4=CHEXAL)))
+  550 FORMAT(
+     1 7H NCONDF,I9,43H   (DEGREE OF FUEL CONDUCTIVITY POLYNOMIAL))
+  560 FORMAT(
+     1 7H NCONDC,I9,43H   (DEGREE OF CLAD CONDUCTIVITY POLYNOMIAL))
+  570 FORMAT(/
+     1 12H REAL PARAM:,1P/
+     2 7H DTIME ,E12.4,19H   (TIME STEP IN S)/
+     3 7H FPUISS,E12.4,25H   (COOLANT POWER FACTOR)/
+     4 7H CFLUX ,E12.4,32H   (CRITICAL HEAT FLUX IN W/M^2)/
+     5 7H SPEED ,E12.4,28H   (COOLANT VELOCITY IN M/S)/
+     6 7H POULET,E12.4,34H   (OUTLET COOLANT PRESSURE IN PA)/
+     7 7H TINLET,E12.4,35H   (INLET COOLANT TEMPERATURE IN K)/
+     8 7H POROS ,E12.4,19H   (OXYDE POROSITY)/
+     9 7H RC    ,E12.4,28H   (FUEL PELLET RADIUS IN M)/
+     1 7H RIG   ,E12.4,34H   (INTERNAL CLAD ROD RADIUS IN M)/
+     2 7H RGG   ,E12.4,34H   (EXTERNAL CLAD ROD RADIUS IN M)/
+     3 7H RTG   ,E12.4,27H   (GUIDE TUBE RADIUS IN M)/
+     4 7H PITCH ,E12.4,24H   (HEXAGONAL SIDE IN M)/
+     5 7H ERMAXT,E12.4,35H   (TEMPERATURE MAXIMUM ERROR IN K)/
+     6 7H ERMAXC,E12.4,32H   (FLOW MAXIMUM RELATIVE ERROR)/
+     7 7H RELAX ,E12.4,25H   (RELAXATION PARAMETER)/
+     8 7H RTIME ,E12.4,20H   (TIME VALUE IN S)/
+     9 7H WTEFF ,E12.4,44H   (SURFACE TEMPERATURE WEIGHTING FACTOR IN ,
+     1 27HEFFECTIVE FUEL TEMPERATURE)/
+     2 7H RATIOX,E12.4,35H   (MAXIMUM OF VARIABLE VARIATIONS)/
+     3 7H EPSR  ,E12.4,34H   (RUGOSITY IN M OF THE FUEL ROD)/
+     4 7H THETA ,E12.4,41H   (ANGLE IN RADIANS OF THE FUEL CHANNEL))
+  580 FORMAT(7H HGAP  ,1P,E12.4,20H   (HGAP IN W/m^2/K))
+  590 FORMAT(7H HCONV ,1P,E12.4,21H   (HCONV IN W/m^2/K))
+  600 FORMAT(7H HCONV ,1P,E12.4,22H   (POWER FACTOR IN W))
+  610 FORMAT(/37H THM: CORE COOLANT SECTION. COMPUTED=,1P,E9.2,
+     1 7H GIVEN=,E9.2,4H m2.)
+      END
diff --git a/Donjon/src/THMAVG.f b/Donjon/src/THMAVG.f
new file mode 100644
index 0000000..0e09a65
--- /dev/null
+++ b/Donjon/src/THMAVG.f
@@ -0,0 +1,426 @@
+*DECK THMAVG
+      SUBROUTINE THMAVG(IPMAP,IMPX,NX,NY,NZ,NCH,TCOMB,TSURF,DCOOL,
+     > TCOOL,PCOOL,HCOOL,POW,NSIMS)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Print averaged thermalhydraulics properties over the core map.
+*
+*Copyright:
+* Copyright (C) 2012 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* M. Cordiez
+*
+*Parameters: input
+* IPMAP   pointer to the fuelmap object.
+* IMPX    printing index (=0 for no print).
+* NX      number of meshes along X direction.
+* NY      number of meshes along Y direction.
+* NZ      number of meshes along Z direction (channel direction).
+* NCH     number of fuel channels in the axial plane.
+* TCOMB   averaged fuel temperature distribution in K.
+* TSURF   surface fuel temperature distribution in K.
+* DCOOL   coolant density distribution in g/cc.
+* TCOOL   coolant temperature distribution in K.
+* PCOOL   coolant pressure distribution in Pa.
+* HCOOL   coolant enthalpty distribution in J/kg.
+* POW     power distribution in W.
+* NSIMS   flag greater than zero to activate axial averaging of
+*         thermohydraulics information.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER MAXHHX
+      PARAMETER(MAXHHX=30)
+      TYPE(C_PTR) IPMAP
+      INTEGER IMPX,NX,NY,NZ,NCH,NSIMS
+      REAL TCOMB(NZ,NX,NY),TSURF(NZ,NX,NY),DCOOL(NZ,NX,NY),
+     > TCOOL(NZ,NX,NY),PCOOL(NZ,NX,NY),HCOOL(NZ,NX,NY),POW(NZ,NX,NY)
+*----
+*  LOCAL VARIABLES
+*----
+*     Variables for an averaged fuel bundle
+      INTEGER NBLEVELCOMB,IHY(MAXHHX)
+      REAL TCOMBAVGAVG, TSURFAVGAVG, DCOOLAVGAVG, TCOOLAVGAVG,
+     > PCOOLAVGAVG, HCOOLAVGAVG, POWAVGAVG, POWRELAVGAVG
+      REAL TCOMBAVG(NZ), TSURFAVG(NZ), DCOOLAVG(NZ), TCOOLAVG(NZ),
+     > PCOOLAVG(NZ), HCOOLAVG(NZ), POWERAVG(NZ), POWRELAVG(NZ)
+*     --> POWRELAVG : relative power by axial plane
+*     Variables for axially averaged to draw a core map
+      REAL TCOMBCM(NX,NY),TSURFCM(NX,NY),DCOOLCM(NX,NY),TCOOLCM(NX,NY),
+     > PCOOLCM(NX,NY),HCOOLCM(NX,NY),POWERCM(NX,NY),POWRELCM(NX,NY)
+      REAL POWAVGCM, POWRELAVGCM
+      CHARACTER HHX(MAXHHX)*1,TEXT1*1,TEXT1B*1,TEXT4*4
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      CHARACTER(LEN=4), ALLOCATABLE, DIMENSION(:) :: HZONE
+*----
+*  RECOVER NAVAL BATTLE COORDINATES OF THE MAP
+*----
+      IF(NSIMS.GT.0) THEN
+        LX=NSIMS/100
+        LY=MOD(NSIMS,100)
+        ALLOCATE(HZONE(NCH))
+        CALL LCMGTC(IPMAP,'S-ZONE',4,NCH,HZONE)
+        TEXT4=HZONE(1)
+        READ(TEXT4,'(A1,I2)') TEXT1,INTG2
+        L=0
+        DO K=1,NCH
+          TEXT4=HZONE(K)
+          READ(TEXT4,'(A1,I2)') TEXT1B,INTG2B
+          IF(TEXT1B.EQ.TEXT1) THEN
+            L=L+1
+            IF(L.GT.MAXHHX)CALL XABORT('@THMAVG: MAXHHX OVERFLOW.(1)')
+            IF(L.GT.LY)CALL XABORT('@THMAVG: INCOHERENCE IN BASIC '
+     >      //'ASSEMBLY LAYOUT GIVEN IN RESINI: (1).')
+            IHY(L)=INTG2B
+          ENDIF
+        ENDDO
+        L=L+1
+        IF(L.GT.MAXHHX)CALL XABORT('@THMAVG: MAXHHX OVERFLOW.(2)')
+        IHY(L)=0
+        L=0
+        DO K=1,NCH
+          TEXT4=HZONE(K)
+          READ(TEXT4,'(A1,I2)') TEXT1B,INTG2B
+          IF(INTG2B.EQ.IHY((LY+1)/2)) THEN
+            L=L+1
+            IF(L.GT.MAXHHX)CALL XABORT('@THMAVG: MAXHHX OVERFLOW.(3)')
+            IF(L.GT.LX)CALL XABORT('@THMAVG: INCOHERENCE IN BASIC '
+     >      //'ASSEMBLY LAYOUT GIVEN IN RESINI: (2).')
+            HHX(L)=TEXT1B
+          ENDIF
+        ENDDO
+        DEALLOCATE(HZONE)
+      ENDIF
+*----
+*  VARIABLES INITIALIZATION
+*----
+*     Variables for an average fuel bundle
+      TCOMBAVGAVG  = 0
+      TSURFAVGAVG  = 0
+      DCOOLAVGAVG  = 0
+      TCOOLAVGAVG  = 0
+      PCOOLAVGAVG  = 0
+      HCOOLAVGAVG  = 0
+      POWAVGAVG    = 0
+      POWRELAVGAVG = 0
+      NBLEVELCOMB = 0
+      DO L=1,NZ
+        TCOMBAVG(L) = 0.0
+        TSURFAVG(L) = 0.0
+        DCOOLAVG(L) = 0.0
+        TCOOLAVG(L) = 0.0
+        PCOOLAVG(L) = 0.0
+        HCOOLAVG(L) = 0.0
+        POWERAVG(L) = 0.0
+        POWRELAVG(L) = 0.0
+      ENDDO
+*     Variables for an averaged core layer (map of values)
+      POWAVGCM     = 0
+      POWRELAVGCM  = 0
+*----
+*  SUM THE VALUES FOR A EVERY FUEL BUNDLE TO AVERAGE THEM
+*----
+      NBASS=0
+      DO 95 I=1,NX
+      DO 90 J=1,NY
+      TCOMBCM(I,J) = 0.0
+      TSURFCM(I,J) = 0.0
+      DCOOLCM(I,J) = 0.0
+      TCOOLCM(I,J) = 0.0
+      PCOOLCM(I,J) = 0.0
+      HCOOLCM(I,J) = 0.0
+      POWERCM(I,J) = 0.0
+      POWRELCM(I,J) = 0.0
+      IF(POW((NZ+1)/2,I,J).GT.0.0) THEN
+*        We do not average on the reflectors whose values equal 0
+         NBASS=NBASS+1
+         TCOMBAVG=TCOMBAVG+TCOMB(:,I,J)
+         TSURFAVG=TSURFAVG+TSURF(:,I,J)
+         DCOOLAVG=DCOOLAVG+DCOOL(:,I,J)
+         TCOOLAVG=TCOOLAVG+TCOOL(:,I,J)
+         PCOOLAVG=PCOOLAVG+PCOOL(:,I,J)
+         HCOOLAVG=HCOOLAVG+HCOOL(:,I,J)
+         POWERAVG=POWERAVG+POW(:,I,J)
+      ENDIF
+   90 CONTINUE
+   95 CONTINUE
+*----
+*  COMPUTE THE AVERAGED VALUES FOR A GENERIC FUEL BUNDLE
+*----
+      IF(NSIMS.GT.0) THEN
+         TCOMBAVG=TCOMBAVG/REAL(NBASS)
+         TSURFAVG=TSURFAVG/REAL(NBASS)
+         DCOOLAVG=DCOOLAVG/REAL(NBASS)
+         TCOOLAVG=TCOOLAVG/REAL(NBASS)
+         PCOOLAVG=PCOOLAVG/REAL(NBASS)
+         HCOOLAVG=HCOOLAVG/REAL(NBASS)
+         POWERAVG=POWERAVG/REAL(NBASS)
+*
+*        Computation of the relative power by axial plane and
+*        computation of the averaged-on-z-axis values of an average
+*        fuel bundle
+         DO L=1,NZ
+           TCOMBAVGAVG=TCOMBAVGAVG+TCOMBAVG(L)
+           TSURFAVGAVG=TSURFAVGAVG+TSURFAVG(L)
+           DCOOLAVGAVG=DCOOLAVGAVG+DCOOLAVG(L)
+           TCOOLAVGAVG=TCOOLAVGAVG+TCOOLAVG(L)
+           PCOOLAVGAVG=PCOOLAVGAVG+PCOOLAVG(L)
+           HCOOLAVGAVG=HCOOLAVGAVG+HCOOLAVG(L)
+           POWAVGAVG=POWAVGAVG+POWERAVG(L)
+           IF(POWERAVG(L).NE.0) NBLEVELCOMB=NBLEVELCOMB+1
+         ENDDO
+         TCOMBAVGAVG=TCOMBAVGAVG/REAL(NBLEVELCOMB)
+         TSURFAVGAVG=TSURFAVGAVG/REAL(NBLEVELCOMB)
+         DCOOLAVGAVG=DCOOLAVGAVG/REAL(NBLEVELCOMB)
+         TCOOLAVGAVG=TCOOLAVGAVG/REAL(NBLEVELCOMB)
+         PCOOLAVGAVG=PCOOLAVGAVG/REAL(NBLEVELCOMB)
+         HCOOLAVGAVG=HCOOLAVGAVG/REAL(NBLEVELCOMB)
+         POWAVGAVG=POWAVGAVG/REAL(NBLEVELCOMB)
+         POWRELAVG=POWERAVG/POWAVGAVG
+*
+*        Computation of the average relative power by axial plane
+*        (it must be equal to 1)
+         DO L=1,NZ
+           POWRELAVGAVG=POWRELAVGAVG+POWRELAVG(L)
+         ENDDO
+         POWRELAVGAVG=POWRELAVGAVG/REAL(NBLEVELCOMB)
+*
+*        There is no use in computing them if the user does not want them
+         IF(IMPX.GT.2) THEN
+           WRITE(6,'(/28H THMAVG: AVERAGE FUEL BUNDLE/1X,27(1H-))')
+           WRITE(6,210) ' ___________________________________________',
+     >          '_____________________________________________________',
+     >          '___________________'
+           WRITE(6,210) '|     |    TFUEL    |    TSURF    |    DCOOL ',
+     >          '   |    TCOOL    |    PCOOL    |    HCOOL    |    ',
+     >          'POWER    |  POW REL  |'
+           WRITE(6,230) '| AVG |',TCOMBAVGAVG,' |',TSURFAVGAVG,' |',
+     >          DCOOLAVGAVG,' |',TCOOLAVGAVG,' |',PCOOLAVGAVG,' |',
+     >          HCOOLAVGAVG,' |',POWAVGAVG,' |',POWRELAVGAVG,' |'
+           WRITE(6,210) '|_____|_____________|_____________|__________',
+     >          '___|_____________|_____________|_____________|_______',
+     >          '______|___________|'
+           DO L=NZ,1,-1
+             IF(L.EQ.1) THEN
+               WRITE(6,230) '| BOT |',TCOMBAVG(L),' |',TSURFAVG(L),
+     >            ' |',DCOOLAVG(L),' |',TCOOLAVG(L),' |',PCOOLAVG(L),
+     >            ' |',HCOOLAVG(L),' |',POWERAVG(L),' |',
+     >            POWRELAVG(L),' |'
+             ELSEIF(L.EQ.NZ) THEN
+               WRITE(6,230) '| TOP |',TCOMBAVG(L),' |',TSURFAVG(L),
+     >            ' |',DCOOLAVG(L),' |',TCOOLAVG(L),' |',PCOOLAVG(L),
+     >            ' |',HCOOLAVG(L),' |',POWERAVG(L),' |',
+     >            POWRELAVG(L),' |'
+             ELSE
+               WRITE(6,235) '| ',L,' |',TCOMBAVG(L),' |',TSURFAVG(L),
+     >            ' |',DCOOLAVG(L),' |',TCOOLAVG(L),' |',PCOOLAVG(L),
+     >            ' |',HCOOLAVG(L),' |',POWERAVG(L),' |',
+     >            POWRELAVG(L),' |'
+             ENDIF
+           ENDDO
+           WRITE(6,210) '|_____|_____________|_____________|_________',
+     >          '____|_____________|_____________|_____________|______',
+     >          '_______|___________|'
+         ENDIF
+*----
+*  COMPUTE THE AVERAGED VALUES ON THE CORE MAP
+*----
+*       We do not average on the reflectors whose values equal 0
+        DO K=1,NZ
+            TCOMBCM(:,:)=TCOMBCM(:,:)+TCOMB(K,:,:)
+            TSURFCM(:,:)=TSURFCM(:,:)+TSURF(K,:,:)
+            DCOOLCM(:,:)=DCOOLCM(:,:)+DCOOL(K,:,:)
+            TCOOLCM(:,:)=TCOOLCM(:,:)+TCOOL(K,:,:)
+            PCOOLCM(:,:)=PCOOLCM(:,:)+PCOOL(K,:,:)
+            HCOOLCM(:,:)=HCOOLCM(:,:)+HCOOL(K,:,:)
+            POWERCM(:,:)=POWERCM(:,:)+POW(K,:,:)
+        ENDDO
+        TCOMBCM=TCOMBCM/REAL(NBLEVELCOMB)
+        TSURFCM=TSURFCM/REAL(NBLEVELCOMB)
+        DCOOLCM=DCOOLCM/REAL(NBLEVELCOMB)
+        TCOOLCM=TCOOLCM/REAL(NBLEVELCOMB)
+        PCOOLCM=PCOOLCM/REAL(NBLEVELCOMB)
+        HCOOLCM=HCOOLCM/REAL(NBLEVELCOMB)
+        POWERCM=POWERCM/REAL(NBLEVELCOMB)
+*       Calculation of the relative power distribution (avg = 1)
+        DO 106 I=1,NX
+        DO 105 J=1,NY
+          POWAVGCM=POWAVGCM+POWERCM(I,J)
+  105   CONTINUE
+  106   CONTINUE
+        POWAVGCM=POWAVGCM/REAL(NBASS)
+        POWRELCM=POWERCM/POWAVGCM
+        DO 108 I=1,NX
+        DO 107 J=1,NY
+          POWRELAVGCM=POWRELAVGCM+POWRELCM(I,J)
+  107   CONTINUE
+  108   CONTINUE
+        POWRELAVGCM=POWRELAVGCM/REAL(NBASS)
+*
+*        There is no use in computing them if the user does not want them
+         IF(IMPX.GT.2) THEN
+           IDEB=1
+           JDEB=1
+*          We do not draw the reflector
+           I=1
+           DO WHILE (POW((NZ+1)/2,I,(NY+1)/2).EQ.0)
+             IDEB=IDEB+1
+             I=I+1
+           END DO
+           J=1
+           DO WHILE (POW((NZ+1)/2,(NX+1)/2,J).EQ.0)
+             JDEB=JDEB+1
+             J=J+1
+           END DO
+*          ********************
+*          We write the results
+*          ********************
+*          Fuel temperature
+           WRITE(6,'(/25H THMAVG: AVERAGE CORE MAP/1X,24(1H-))')
+           WRITE(6,202) 'TCOMB'
+           WRITE(6,203,ADVANCE='NO') (HHX(I),I=1,NX-2*IDEB+2)
+           DO 111 J=JDEB,NY
+             WRITE(6,204,ADVANCE='NO') IHY(J-JDEB+1)
+             ENDLINE=0
+           DO 110 I=IDEB,NX
+             IF(POW((NZ+1)/2,I,J).GT.0) THEN
+               WRITE(6,205,ADVANCE='NO') TCOMBCM(I,J)
+               ENDLINE=1
+             ELSE IF(ENDLINE.EQ.0) THEN
+               WRITE(6,208,ADVANCE='NO')
+             ENDIF
+  110      CONTINUE
+  111      CONTINUE
+*          Surface temperature
+           WRITE(6,202) 'TSURF'
+           WRITE(6,203,ADVANCE='NO') (HHX(I),I=1,NX-2*IDEB+2)
+           DO 113 J=JDEB,NY
+             WRITE(6,204,ADVANCE='NO') IHY(J-JDEB+1)
+             ENDLINE=0
+           DO 112 I=IDEB,NX
+             IF(POW((NZ+1)/2,I,J).GT.0) THEN
+               WRITE(6,205,ADVANCE='NO') TSURFCM(I,J)
+               ENDLINE=1
+             ELSE IF(ENDLINE.EQ.0) THEN
+               WRITE(6,208,ADVANCE='NO')
+             ENDIF
+  112      CONTINUE
+  113      CONTINUE
+*          Coolant density
+           WRITE(6,202) 'DCOOL'
+           WRITE(6,203,ADVANCE='NO') (HHX(I),I=1,NX-2*IDEB+2)
+           DO 115 J=JDEB,NY
+             WRITE(6,204,ADVANCE='NO') IHY(J-JDEB+1)
+             ENDLINE=0
+           DO 114 I=IDEB,NX
+             IF(POW((NZ+1)/2,I,J).GT.0) THEN
+               WRITE(6,206,ADVANCE='NO') DCOOLCM(I,J)
+               ENDLINE=1
+             ELSE IF(ENDLINE.EQ.0) THEN
+               WRITE(6,208,ADVANCE='NO')
+             ENDIF
+  114      CONTINUE
+  115      CONTINUE
+*          Coolant temperature
+           WRITE(6,202) 'TCOOL'
+           WRITE(6,203,ADVANCE='NO') (HHX(I),I=1,NX-2*IDEB+2)
+           DO 117 J=JDEB,NY
+             WRITE(6,204,ADVANCE='NO') IHY(J-JDEB+1)
+             ENDLINE=0
+           DO 116 I=IDEB,NX
+             IF(POW((NZ+1)/2,I,J).GT.0) THEN
+               WRITE(6,205,ADVANCE='NO') TCOOLCM(I,J)
+               ENDLINE=1
+             ELSE IF(ENDLINE.EQ.0) THEN
+               WRITE(6,208,ADVANCE='NO')
+             ENDIF
+  116      CONTINUE
+  117      CONTINUE
+*          Coolant pressure
+           WRITE(6,202) 'PCOOL'
+           WRITE(6,203,ADVANCE='NO') (HHX(I),I=1,NX-2*IDEB+2)
+           DO 119 J=JDEB,NY
+             WRITE(6,204,ADVANCE='NO') IHY(J-JDEB+1)
+             ENDLINE=0
+           DO 118 I=IDEB,NX
+             IF(POW((NZ+1)/2,I,J).GT.0) THEN
+               WRITE(6,207,ADVANCE='NO') PCOOLCM(I,J)
+               ENDLINE=1
+             ELSE IF(ENDLINE.EQ.0) THEN
+               WRITE(6,208,ADVANCE='NO')
+             ENDIF
+  118      CONTINUE
+  119      CONTINUE
+*          Coolant enthalpy
+           WRITE(6,202) 'HCOOL'
+           WRITE(6,203,ADVANCE='NO') (HHX(I),I=1,NX-2*IDEB+2)
+           DO 121 J=JDEB,NY
+             WRITE(6,204,ADVANCE='NO') IHY(J-JDEB+1)
+             ENDLINE=0
+           DO 120 I=IDEB,NX
+             IF(POW((NZ+1)/2,I,J).GT.0) THEN
+               WRITE(6,207,ADVANCE='NO') HCOOLCM(I,J)
+               ENDLINE=1
+             ELSE IF(ENDLINE.EQ.0) THEN
+               WRITE(6,208,ADVANCE='NO')
+             ENDIF
+  120      CONTINUE
+  121      CONTINUE
+*          Power
+           WRITE(6,202) 'POWER'
+           WRITE(6,203,ADVANCE='NO') (HHX(I),I=1,NX-2*IDEB+2)
+           DO 123 J=JDEB,NY
+             WRITE(6,204,ADVANCE='NO') IHY(J-JDEB+1)
+             ENDLINE=0
+           DO 122 I=IDEB,NX
+             IF(POW((NZ+1)/2,I,J).GT.0) THEN
+               WRITE(6,207,ADVANCE='NO') POWERCM(I,J)
+               ENDLINE=1
+             ELSE IF(ENDLINE.EQ.0) THEN
+               WRITE(6,208,ADVANCE='NO')
+             ENDIF
+  122      CONTINUE
+  123      CONTINUE
+*          Power
+           WRITE(6,209) 'RELATIVE POWER, REFLECTORS EXCLUDED (AVG:',
+     1                  POWRELAVGCM,')'
+           WRITE(6,203,ADVANCE='NO') (HHX(I),I=1,NX-2*IDEB+2)
+           DO 125 J=JDEB,NY
+             WRITE(6,204,ADVANCE='NO') IHY(J-JDEB+1)
+             ENDLINE=0
+           DO 124 I=IDEB,NX
+             IF(POW((NZ+1)/2,I,J).GT.0) THEN
+               WRITE(6,206,ADVANCE='NO') POWRELCM(I,J)
+               ENDLINE=1
+             ELSE IF(ENDLINE.EQ.0) THEN
+               WRITE(6,208,ADVANCE='NO')
+             ENDIF
+  124      CONTINUE
+  125      CONTINUE
+         ENDIF
+      ENDIF
+      RETURN
+*
+  202 FORMAT(/1X,A)
+  203 FORMAT(1X,20(8X,1A1))
+  204 FORMAT(/1X,I2)
+  205 FORMAT(F9.1)
+  206 FORMAT(F9.3)
+  207 FORMAT(1P,E9.2)
+  208 FORMAT(9X)
+  209 FORMAT(/1X,A,F7.4,A)
+  210 FORMAT(1X,A,A,A,A)
+  230 FORMAT(1X,A,F12.2,A,F12.2,A,F12.4,A,F12.2,A,3P,E12.4,
+     >       A,1P,E12.4,A,1P,E12.4,A,0P,F10.4,A)
+  235 FORMAT(1X,A,I3,A,F12.2,A,F12.2,A,F12.4,A,F12.2,A,3P,E12.4,
+     >       A,1P,E12.4,A,1P,E12.4,A,0P,F10.4,A)
+      END
diff --git a/Donjon/src/THMCCD.f b/Donjon/src/THMCCD.f
new file mode 100644
index 0000000..ddf9765
--- /dev/null
+++ b/Donjon/src/THMCCD.f
@@ -0,0 +1,78 @@
+*DECK THMCCD
+      REAL FUNCTION THMCCD(TEMP,POROS,FRACPU)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute the product of the heat capacity of fuel (in J/Kg/K) times
+* its density (in Kg/m^3).
+*
+*Copyright:
+* Copyright (C) 2012 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* P. Gallet
+*
+*Parameters: input
+* TEMP    fuel temperature in Kelvin.
+* POROS   oxyde porosity.
+* FRACPU  plutonium mass fraction in fuel.
+* 
+*Parameters: output
+* THMCCD  product of the heat capacity of fuel times its density
+*         (in J/K/m^3).
+* 
+*Reference:
+* J. J. Carbajo, G. L. Yoder, S. G. Popov and V. K. Ivanov, "A review of
+* the thermophysical properties of MOX and UO2 fuels," J. of Nuclear
+* Materials, 299, 181-198 (2001).
+*
+*-----------------------------------------------------------------------
+*
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      REAL TEMP,POROS,FRACPU
+*----
+*  LOCAL VARIABLES
+*  CP:    heat capacity in J/Kg/K
+*  DENS0: fuel density with zero porosity
+*  ROURA: uranium density in Kg/m^3
+*  ROPLU: plutonium density in Kg/m^3
+*----
+      REAL CP,DENS0,RO,ROURA,ROPLU,A1,A2,A3,A4,CORR,T2,T1,C1U,C2U,C3U,
+     > C4U,C5U,C6U,C1PU,C2PU,C3PU,C4PU,C5PU,C6PU,CPU,CPPU
+      PARAMETER (ROURA=10970.0,ROPLU=11460.0,A1=0.99672,A2=1.179E-05,
+     > A3=-2.429E-09,A4=1.219E-12,C1U=193.238,C2U=325.7294,
+     > C3U=-312.0042,C4U=116.8224,C5U=-9.7535,C6U=-2.6441,C1PU=311.7866,
+     > C2PU=39.258,C3PU=-2.256,C4PU=0.0,C5PU=0.0,C6PU=-7.0131)
+*
+      T2=MAX(0.0,TEMP)
+      T1=T2/1000.0
+*     temperature correction coefficient for density calculation
+      CORR=1.0/(A1+A2*T2+A3*T2**2.0+A4*T2**3.0)**3.0
+      IF(FRACPU.EQ.0.0) THEN
+*        UOX
+*        density of the UOX fuel
+         RO=(1.0-POROS)*ROURA*CORR
+*        heat capacity of the UOX fuel
+         CPU=C1U+C2U*T1+C3U*T1**2.0+C4U*T1**3.0+C5U*T1**4.0+C6U
+     >       /(T1**2.0)
+         CPPU=0.00
+         CP=CPU
+      ELSE
+*        MOX
+*        density of the MOX fuel
+         DENS0=100.0*CORR/((FRACPU/ROPLU)+((100.0-FRACPU)/ROURA))
+         RO=(1.-POROS)*DENS0
+*        heat capacity of the MOX fuel
+         CPU=C1U+C2U*T1+C3U*T1**2.0+C4U*T1**3.0+C5U*T1**4.0+C6U
+     >       /(T1**2.0)
+         CPPU=C1PU+C2PU*T1+C3PU*T1**2.0+C6PU/(T1**2.0)
+         CP=((100.0-FRACPU)*CPU+FRACPU*CPPU)/100.0
+      ENDIF
+*     total internal energy of the fuel
+      THMCCD=RO*CP
+      RETURN
+      END
diff --git a/Donjon/src/THMCDI.f b/Donjon/src/THMCDI.f
new file mode 100644
index 0000000..89f00af
--- /dev/null
+++ b/Donjon/src/THMCDI.f
@@ -0,0 +1,209 @@
+*DECK THMCDI
+      FUNCTION THMCDI(T2K,T1K,BURN,POROS,FRACPU,ICONDF,NCONDF,KCONDF,
+     > UCONDF,IFRCDI)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute the thermal conductivity integral of UOX or MOX fuel.
+*
+*Copyright:
+* Copyright (C) 2012 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* A. Hebert, V. Salino
+*
+*Parameters: input
+* T2K     final temperature in Kelvin.
+* T1K     initial temperature in Kelvin.
+* BURN    fuel burnup in MWday/tonne.
+* POROS   fuel porosity.
+* FRACPU  plutonium mass fraction in fuel.
+* ICONDF  fuel conductivity flag (0=Stora-Chenebault or COMETHE/
+*         1=user-provided polynomial + inverse term).
+* NCONDF  degree of user-provided fuel conductivity polynomial.
+* KCONDF  polynomial coefficients for fuel conductivity in W/m/K^(k+1)
+*         (except for the two last coefficients which belongs to the
+*         inverse term).
+* UCONDF  required unit of temperature in polynomial for fuel
+*         conductivity (KELVIN or CELSIUS).
+* IFRCDI  flag indicating if average approximation is forced during
+*         fuel conductivity evaluation (0=default/1=average
+*         approximation forced).
+*
+*Parameters: output
+* THMCDI  thermal conductivity integral in Watt/m/K.
+*
+*Reference:
+* A. Poncot, "Assimilation de donnees pour la dynamique du xenon dans
+* les coeurs de centrale nucleaire", Ph.D Thesis, Universite de
+* Toulouse, France, 2008.
+*
+*-----------------------------------------------------------------------
+*
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER ICONDF,NCONDF,IFRCDI
+      REAL T1K,T2K,BURN,POROS,FRACPU,KCONDF(NCONDF+3),THMCDI
+      CHARACTER UCONDF*12
+*----
+*  LOCAL VARIABLES
+* NPAS    number of rectangles in the quadrature
+* DT      rectangle width
+* T2T1    temperature difference
+* DTMIN   cutoff criterion for selecting the approximation
+* FPI     burnup correcting factor
+* CIRRA   burnup correction constant
+* HV*     coefficients of the Stora-Chenebault correlation
+* HK*     coefficients of the Comethe correlation
+*----
+      INTEGER NPAS,I,K
+      REAL T1,T2,DT,TM,DTMIN,T2T1,FPI,TT,TMK,TEMP,FTP,CINT,FP,TTK
+      REAL HV1, HV2, HV3
+      REAL HK1, HK2, HK4, HK5
+      REAL ZKELV,CIRRA
+*
+      PARAMETER ( ZKELV=273.15 )
+      PARAMETER ( HV1= 1.3324E-08 , HV2 = -4.3554E-05 ,
+     & HV3 = 5.8915E-02 )
+      PARAMETER ( HK1= 40.05 , HK2 = 129.4 , HK4 = 0.8 ,
+     & HK5 = 0.6416E-12 )
+      PARAMETER ( CIRRA= 0.124E-02 )
+*
+      REAL A
+      DATA NPAS /10/
+      DATA DTMIN /10./
+*
+      IF(MIN(T1K,T2K).LE.0.0) THEN
+         CALL XABORT('@THMCDI: NEGATIVE TEMPERATURE.')
+      ENDIF
+      T1=T1K-ZKELV
+      T2=T2K-ZKELV
+*
+      T2T1 = T2-T1
+      DT = T2T1/NPAS
+      TM = (T1+T2)/2.0
+      IF(ICONDF.EQ.1) THEN
+*        User-given conductivity, as a function of temperature
+         IF((ABS(T2T1).LT.DTMIN).OR.(IFRCDI.EQ.1)) THEN
+*           Use the average value approximation
+            THMCDI=0.0
+            IF(UCONDF.EQ.'KELVIN') THEN
+               TMK = TM + ZKELV
+               DO K=1,NCONDF+1
+                  THMCDI=THMCDI + KCONDF(K)*TMK**(K-1)
+               ENDDO
+               THMCDI=THMCDI + KCONDF(NCONDF+2)/(TMK-KCONDF(NCONDF+3))
+            ELSE
+               DO K=1,NCONDF+1
+                  THMCDI=THMCDI + KCONDF(K)*TM**(K-1)
+               ENDDO
+               THMCDI=THMCDI + KCONDF(NCONDF+2)/(TM-KCONDF(NCONDF+3))
+            ENDIF
+         ELSE
+*           Use the rectangle quadrature approximation
+            TT=T1-DT*0.5
+            CINT=0.
+            DO I=1,NPAS
+               TT=TT+DT
+               IF(UCONDF.EQ.'KELVIN') THEN
+                  TTK = TT + ZKELV
+                  DO K=1,NCONDF+1
+                     CINT=CINT + KCONDF(K)*TTK**(K-1)
+                  ENDDO
+                  CINT=CINT + KCONDF(NCONDF+2)/(TTK-KCONDF(NCONDF+3))
+               ELSE
+                  DO K=1,NCONDF+1
+                     CINT=CINT + KCONDF(K)*TT**(K-1)
+                  ENDDO
+                  CINT=CINT + KCONDF(NCONDF+2)/(TT-KCONDF(NCONDF+3))
+               ENDIF
+            ENDDO
+            THMCDI=CINT/NPAS
+         ENDIF
+      ELSE IF(FRACPU.GT.0.) THEN
+*        Use the Comethe correlation for MOX fuel
+         FPI=CIRRA*BURN
+         IF((ABS(T2T1).LT.DTMIN).OR.(IFRCDI.EQ.1)) THEN
+*           Use the average value approximation
+            IF(TM.GT.1000.0) THEN
+               A=2.0
+            ELSE
+               A=2.58-0.58E-03*TM
+            ENDIF
+            FP=(1.0-A*POROS)/(1.0-A*0.05)
+            TMK = TM + ZKELV
+            TEMP = HK2 + (1.0 + HK4*FRACPU*1.E-02) * TMK
+            FTP = FP * (HK1/TEMP + HK5*TMK*TMK*TMK) *100.0
+            IF(TM.EQ.0.) THEN
+               THMCDI=FTP
+            ELSE
+               THMCDI=1.0/(1.0/FTP+FPI/TM)
+            ENDIF
+         ELSE
+*           Use the rectangle quadrature approximation
+            TT=T1-DT*0.5
+            CINT=0.
+            DO I=1,NPAS
+               TT=TT+DT
+               IF(TT.GT.1000.0) THEN
+                  A=2.0
+               ELSE
+                  A=2.58-0.58E-03*TT
+               ENDIF
+               FP=(1.0-A*POROS)/(1.0-A*0.05)
+               TTK = TT + ZKELV
+               TEMP = HK2 + (1.0 + HK4*FRACPU*1.E-02) * TTK
+               FTP = FP * (HK1/TEMP  + HK5*TTK*TTK*TTK) *100.0
+               IF(TT.EQ.0.0) THEN
+                  CINT=CINT+FTP
+               ELSE
+                  CINT=CINT+1.0/(1.0/FTP+FPI/TT)
+               ENDIF
+            ENDDO
+            THMCDI=CINT/NPAS
+         ENDIF
+      ELSE
+*        Use the Stora-Chenebault correlation for UOX fuel
+*        (also called the "HGAP Variable 88" correlation)
+         FPI=CIRRA*BURN
+         IF((ABS(T2T1).LT.DTMIN).OR.(IFRCDI.EQ.1)) THEN
+*           Use the average value approximation
+            IF(TM.GT.1000.) THEN
+               A=2.0
+            ELSE
+               A=2.58-0.58E-03*TM
+            ENDIF
+            FP=(1.0-A*POROS)/(1.0-A*0.034)
+            FTP=FP*(HV3+HV2*TM+HV1*TM*TM)*100.0
+            IF(TM.EQ.0.0) THEN
+               THMCDI=FP*HV3*100.0
+            ELSE
+               THMCDI=1.0/(1.0/FTP+FPI/TM)
+            ENDIF
+         ELSE
+*           Use the rectangle quadrature approximation
+            TT=T1-DT*0.5
+            CINT=0.
+            DO I=1,NPAS
+               TT=TT+DT
+               IF(TT.GT.1000.) THEN
+                  A=2.0
+               ELSE
+                  A=2.58-0.58E-03*TT
+               ENDIF
+               FP=(1.0-A*POROS)/(1.0-A*0.034)
+               FTP=FP*(HV3+HV2*TT+HV1*TT*TT)*100.0
+               IF(TT.EQ.0.0) THEN
+                  CINT=CINT+FP*HV3*100.0
+               ELSE
+                  CINT=CINT+1.0/(1.0/FTP+FPI/TT)
+               ENDIF
+            ENDDO
+            THMCDI=CINT*DT/T2T1
+         ENDIF
+      ENDIF
+      RETURN
+      END
diff --git a/Donjon/src/THMDFM.f90 b/Donjon/src/THMDFM.f90
new file mode 100644
index 0000000..1e4e0ba
--- /dev/null
+++ b/Donjon/src/THMDFM.f90
@@ -0,0 +1,141 @@
+!DECK THMDFM
+      SUBROUTINE THMDFM(PCOOL,VCOOL,HMAVG,HD,TL,TSAT,IDFM,EPS,XFL,RHO,RHOL,RHOG, VGJ, VGJprime, C0, HLV)
+!
+!-----------------------------------------------------------------------
+!
+! Purpose:
+! Drift-flux Model for the computation of thermohydraulics parameters in two-phase flow
+!
+!Copyright:
+! Copyright (C) 2025 Ecole Polytechnique de Montreal.
+!
+!Author(s): 
+! M. Bellier
+!
+!Parameters: input
+! PCOOL   pressure in Pascal
+! VCOOL   coolant velocity in m/s
+! HMAVG   averaged enthalpy
+! HD      hydraulic diameter in m
+! TL      liquid temperature in K
+! TSAT    saturation temperature in K
+! IDFM    flag indicating if the drift flux model is to be used 
+!         (0=HEM1(no drift velocity)/1=EPRI/2=MODEBSTION/3=GERAMP/4=CHEXAL) 
+! EPS     input coolant void fraction
+!
+!
+!Parameters: output
+! XFL     coolant flow quality
+! RHO     coolant density in Kg/m^3
+! RHOL    liquid density in kg/m^3
+! RHOG    vapour density in kg/m^3
+! VGJ     drift velocity
+! C0      concentration parameter
+! VGJprime 
+! HLV     delta between liquid and vapour enthaply
+!
+!-----------------------------------------------------------------------
+!
+!----
+!  SUBROUTINE ARGUMENTS
+!----
+      REAL PCOOL,VCOOL,HMAVG,HD,TL,TSAT,EPS,XFL,RHO,RHOL,RHOG, VGJ, VGJprime, C0, HLV
+      INTEGER IDFM
+!----
+!  LOCAL VARIABLES
+!----
+      REAL EPSold, ERREPS, VLIQ, VVAP, TCALO, HLSAT, HGSAT, ZMUL, ZMUG, CPL, CPG, ZKL, ZKG, ZMU, REY
+      INTEGER NITER
+!----
+! INITIALIZE VARIABLES
+!----
+      VGJ = 0
+      C0 = 1
+      VGJprime = 0
+
+!----
+!  MAIN LOOP
+!----
+     NITER=0
+     ERREPS=1
+
+   10 CONTINUE
+!----
+!  SAVE THE OLD EPSILON VALUE
+!----
+      EPSold = EPS 
+      NITER = NITER+1
+
+!----
+! TEST ON ERR EPS
+!----
+      IF (NITER .GT. 150) GOTO 20
+      IF (ERREPS .LT. 1E-8) GOTO 20 
+
+!----
+!  COMPUTE DENSITIES
+!----
+      TCALO=EPS*TSAT+(1.0-EPS)*TL
+      CALL THMTX(TCALO,0.0,RHOL,HLSAT,ZKL,ZMUL,CPL)
+      CALL THMTX(TCALO,1.0,RHOG,HGSAT,ZKG,ZMUG,CPG)
+
+      RHO = RHOL*(1 - EPS)+ EPS*RHOG
+    
+!----
+!  COMPUTE PHASES VELOCITIES AND REYNOLDS
+!----
+      VLIQ = VCOOL - (1.0/(1.0- EPS) - RHOL/RHO) *VGJprime
+      VVAP = VCOOL + RHOL/RHO *VGJprime
+      ZMU = (ZMUL*ZMUG/ (ZMUL*(1.0-EPS) + ZMUG*EPS))
+      REY = RHO * ABS(VCOOL) * HD / ZMU
+
+!----
+!  COMPUTE FLOW QUALITY
+!----
+
+      IF (HLSAT .GT. HMAVG) THEN 
+        XFL = 0
+      ELSE IF (HMAVG .GT. HGSAT) THEN
+        XFL = 1
+      ELSE     
+        XFL = (HMAVG - HLSAT)/(HGSAT - HLSAT)
+      ENDIF
+
+!----
+!  COMPUTE VGJ, VGJprime AND C0 AFTER CHOSEN CORRELATION
+!----
+      CALL THMVGJ(VCOOL, RHO, PCOOL, ZMU, XFL, HD, RHOG, RHOL, EPS, IDFM, VGJ, C0)
+      VGJprime = VGJ + (C0-1)*VCOOL
+
+!----
+!  COMPUTE HLV
+!----
+      HLV=HGSAT-HLSAT
+!----
+!  COMPUTE NEW EPS VALUE
+!----
+      IF (XFL.EQ.0) THEN 
+        EPS = 0
+      ELSE IF (XFL.EQ.1) THEN
+        EPS = 1
+      ELSE 
+        EPS = XFL / (C0 * (XFL + (RHOG/RHOL) * (1 - XFL)) + (RHOG * VGJ) / (RHOL * VCOOL))
+      ENDIF
+!----
+!  COMPUTE DELTA BETWEEN EPSold AND EPS
+!----
+    ERREPS = ABS(EPSold - EPS)
+   GOTO 10
+
+
+!----
+! EXIT LOOP
+!----
+   20 CONTINUE
+
+      IF (NITER.GT.150) THEN
+        PRINT *, 'THMDFM: Maximum number of iterations reached (150)'
+      ELSE
+        PRINT *, 'THMDFM: Convergence reached in I = ', NITER, 'iterations'
+      ENDIF
+END
diff --git a/Donjon/src/THMDRV.f b/Donjon/src/THMDRV.f
new file mode 100644
index 0000000..ff642e3
--- /dev/null
+++ b/Donjon/src/THMDRV.f
@@ -0,0 +1,628 @@
+*DECK THMDRV
+      SUBROUTINE THMDRV(MPTHM,IMPX,IX,IY,NZ,XBURN,VOLXY,HZ,CFLUX,POROS,
+     > FNFU,NFD,NDTOT,IFLUID,SNAME,SCOMP,IGAP,IFUEL,FNAME,FCOMP,FCOOL,
+     > FFUEL,ACOOL,HD,PCH,RAD,
+     > MAXIT1,MAXITL,ERMAXT,SPEED,TINLET,POUTLET,
+     > FRACPU,ICONDF,NCONDF,KCONDF,UCONDF,ICONDC,NCONDC,KCONDC,UCONDC,
+     > IHGAP,KHGAP,IHCONV,KHCONV,WTEFF,IFRCDI,ISUBM,FRO,POW,IPRES,IDFM,
+     > TCOMB, DCOOL,TCOOL,TSURF,HCOOL,PCOOL)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Driver of the steady-state thermal-hydraulics calculation.
+*
+*Copyright:
+* Copyright (C) 2012 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* A. Hebert
+* C. Garrido 
+* 08/2023: Modifications to include Molten Salt heat transfer in coolant
+* C. Garrido 
+* 07/2024: Modifications to include Molten Salt heat transfer in static
+*          fuel
+* C. Huet
+* 02/2025: Modifications to include pressure drop calculation
+* R. Guasch & M. Bellier
+* 08/2025: Modifications to include mass+momentum+energy conservation equation
+*  solution using a Drift-Flux Model.
+*
+*Parameters: input
+* MPTHM   directory of the THM object containing steady-state
+*         thermohydraulics data.
+* IMPX    printing index (=0 for no print).
+* IX      position of mesh along X direction.
+* IY      position of mesh along Y direction.
+* NZ      number of meshes along Z direction (channel direction).
+* XBURN   burnup distribution in MWday/tonne.
+* VOLXY   mesh area in the radial plane.
+* HZ      Z-directed mesh widths.
+* CFLUX   critical heat flux in W/m^2.
+* POROS   oxyde porosity.
+* FNFU    number of active fuel rods in the fuel bundle.
+* NFD     number of discretization points in fuel region.
+* NDTOT   number of total discretization points in the the fuel
+*         pellet and the cladding.
+* IFLUID  type of fluid (0=H2O; 1=D2O; 2=SALT).
+* SNAME   Name of the molten salt (e.g. "LiF-BeF2")
+* SCOMP   Composition of the molten salt (e.g. "0.66-0.34")
+* FCOOL   power density fraction in coolant.
+* FFUEL   power density fraction in fuel.
+* ACOOL   coolant cross section area in m^2.
+* HD      hydraulic diameter of one assembly in m.
+* PCH     heating perimeter in m.
+* RAD     fuel and clad radii in m.
+* MAXIT1  maximum number of conduction iterations.
+* MAXITL  maximum number of center-pellet iterations.
+* ERMAXT  convergence criterion.
+* SPEED   inlet flow velocity in m/s.
+* TINLET  inlet temperature in K.
+* POUTLET outlet pressure in Pa.
+* FRACPU  plutonium fraction in fuel.
+* ICONDF  fuel conductivity flag (0=Stora-Chenebault or COMETHE/
+*         1=user-provided polynomial + inverse term).
+* NCONDF  degree of user-provided fuel conductivity polynomial.
+* KCONDF  polynomial coefficients for fuel conductivity in W/m/K^(k+1)
+*         (except for the two last coefficients which belongs to the
+*         inverse term).
+* UCONDF  required unit of temperature in polynomial for fuel
+*         conductivity (KELVIN or CELSIUS).
+* ICONDC  clad conductivity flag (0=default/1=user-provided
+*         polynomial).
+* NCONDC  degree of user-provided clad conductivity polynomial.
+* KCONDC  polynomial coefficients for clad conductivity in W/m/K^(k+1).
+* UCONDC  required unit of temperature in polynomial for clad
+*         conductivity (KELVIN or CELSIUS).
+* IHGAP   flag indicating HGAP chosen (0=default/1=user-provided).
+* KHGAP   fixed user-provided HGAP value in W/m^2/K.
+* IHCONV  flag indicating HCONV chosen (0=default/1=user-provided).
+* KHCONV  fixed user-provided HCONV value in W/m^2/K.
+* WTEFF   surface temperature's weighting factor in effective fuel
+*         temperature.
+* IFRCDI  flag indicating if average approximation is forced during
+*         fuel conductivity evaluation (0=default/1=average
+*         approximation forced).
+* ISUBM   subcooling model (0: one-phase; 1: Jens-Lottes model;
+*         2: Saha- Zuber model).
+* FRO     radial power form factors.
+* POW     power distribution in W.
+* IGAP    Flag indicating if the gap is considered (0=gap/1=no gap)
+* IFUEL   type of fuel (0=UO2/MOX; 1=SALT).
+* FNAME   Name of the molten salt (e.g. "LiF-BeF2")
+* FCOMP   Composition of the molten salt (e.g. "0.66-0.34")
+* IPRES   flag indicating if pressure is to be computed (0=nonstant/
+*         1=variable).
+* IDFM    flag indicating if the drift flux model is to be used 
+*         (0=Without modifications(Chexal correlation for epsilon, no drift flux model in the Navier-Stokes equations)
+*           /1=EPRI/2=MODEBSTION/3=GERAMP/4=HEM1(VGJ=0)) 
+*
+*Parameters: output
+* TCOMB   averaged fuel temperature distribution in K.
+* DCOOL   coolant density distribution in g/cc.
+* TCOOL   coolant temperature distribution in K.
+* TSURF   surface fuel temperature distribution in K.
+* HCOOL   coolant enthalpty distribution in J/kg.
+* PCOOL   coolant pressure distribution in Pa.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      USE t_saltdata
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) MPTHM
+      INTEGER IMPX,IX,IY,NZ,NFD,NDTOT,IFLUID,MAXIT1,MAXITL,IHGAP,IGAP,
+     > IFUEL,IPRES, IDFM
+      REAL XBURN(NZ),VOLXY,CFLUX,POROS,FRACPU,ERMAXT,
+     > SPEED,TINLET,POUTLET,
+     > FFUEL(NZ),ACOOL(NZ),RAD(NDTOT-1,NZ),FNFU(NZ),FCOOL(NZ),HZ(NZ),
+     > KCONDF(NCONDF+3),KCONDC(NCONDC+1),KHGAP,KHCONV,WTEFF,FRO(NFD-1),
+     > POW(NZ),TCOMB(NZ),DCOOL(NZ),TCOOL(NZ),TSURF(NZ),HCOOL(NZ),
+     > PCOOL(NZ),MUT(NZ), HD(NZ), PCH(NZ)
+      CHARACTER UCONDF*12,UCONDC*12
+*----
+*  LOCAL VARIABLES
+*----
+      TYPE(tpdata) STP,FTP
+      PARAMETER (KMAXO=100,MAXNPO=40)
+      REAL TRE11(MAXNPO),RADD(MAXNPO),ENT(4),MFLOW,TLC(NZ)
+      CHARACTER HSMG*131,SNAME*32,SCOMP*32,FNAME*32,FCOMP*32
+      REAL XS(4),TC1,PC(NZ),TP(NZ),RHOL,XFL(NZ),EPS(NZ),HINLET,
+     > TCLAD(NZ),ENTH(NZ),SLIP(NZ),AGM(NZ),QFUEL(NZ),QCOOL(NZ),K11,
+     > VLIQ(NZ),VVAP(NZ)
+      INTEGER KWA(NZ)
+      REAL XX2(MAXNPO),XX3(MAXNPO),ZF(2)
+      DATA XS/-0.861136,-0.339981,0.339981,0.861136/
+
+      REAL TBUL(NZ),VGJprime(NZ),HLV(NZ),DGCOOL(NZ),DLCOOL(NZ)
+
+      INTEGER I
+      REAL PINLET, ERRV, ERRP, ERRD, NORMV, NORMP, NORMD
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      REAL, ALLOCATABLE, DIMENSION(:) :: VCOOL,TCENT
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: TEMPT
+
+      REAL, ALLOCATABLE, DIMENSION(:) :: PTEMP, VTEMP, DTEMP
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(VCOOL(NZ),TEMPT(NDTOT,NZ),TCENT(NZ))
+      ALLOCATE(PTEMP(NZ), VTEMP(NZ), DTEMP(NZ))
+*----
+*  COMPUTE THE INLET FLOW ENTHALPY AND VELOCITY
+*   INITIALIZE PINLET TO POUTLET, WILL BE UPDATED IF IPRES=1
+*   ELSE PINLET = POUTLET
+*----
+      PINLET = POUTLET
+      IF(NDTOT.GT.MAXNPO) CALL XABORT('THMDRV: MAXNPO OVERFLOW.')
+      IF(IFLUID.EQ.0) THEN
+         CALL THMSAT(PINLET,TSAT)
+      ELSE IF(IFLUID.EQ.1) THEN
+         CALL THMHST(PINLET,TSAT)
+*CGT TODO: GET ALSO FREEZING??
+      ELSE IF(IFLUID.EQ.2) THEN
+         CALL THMSGT(SNAME,SCOMP,STP,IMPX)
+         CALL THMSST(STP,TSAT,IMPX)
+*CGT
+      ENDIF
+      IF (IFUEL.EQ.1) THEN
+         CALL THMSGT(FNAME,FCOMP,FTP,IMPX)
+      ENDIF
+
+      IF(TINLET.GT.TSAT) THEN
+         WRITE(HSMG,'(27HTHMDRV: INLET TEMPERATURE (,1P,E12.4,
+     >   40H K) GREATER THAN SATURATION TEMPERATURE.)') TINLET
+         CALL XABORT(HSMG)
+      ENDIF
+      IF(IFLUID.EQ.0) THEN
+        CALL THMPT(PINLET,TINLET,RHOIN,HINLET,R3,R4,R5)
+      ELSE IF(IFLUID.EQ.1) THEN
+        CALL THMHPT(PINLET,TINLET,RHOIN,HINLET,R3,R4,R5)
+      ELSE IF(IFLUID.EQ.2) THEN
+        CALL THMSPT(STP,TINLET,RHOIN,HINLET,R3,R4,R5,IMPX)
+      ENDIF
+      MFLOW=SPEED*RHOIN
+      HMSUP=HINLET
+*----
+*  INITIALIZE VALUES OF STEAM QUALITIES, VOID FRACTION AND DENSITY
+*  PRESSURE, VELOCITY AND TEMPERATURE OF THE COOLANT ALONG THE CHANNEL.
+*---
+      DO K=1,NZ
+         EPS(K)=0.0
+         XFL(K)=0.0
+         SLIP(K)=1.0
+         KWA(K)=0
+         MUT(K)=0.0
+         QFUEL(K)=0.0
+         VGJprime(K)=0.0
+         HLV(K)=0.0
+
+         PCOOL(K)=PINLET
+         VCOOL(K)=MFLOW/RHOIN
+         DCOOL(K)=RHOIN
+         DLCOOL(K)=RHOIN
+         DGCOOL(K)=0.0 
+         TCOOL(K)=TINLET
+         HCOOL(K)=HINLET
+*----
+*  COMPUTE THE SATURATION TEMPERATURE AND THE THERMODYNAMIC PROPERTIES
+*  IF THE PRESSURE DROP IS COMPUTED
+*---
+
+        IF (IPRES.EQ.1) THEN
+          IF(POW(K).EQ.0.0) CYCLE
+          IF(IFLUID.EQ.0) THEN
+            CALL THMSAT(PCOOL(K),TSAT)
+          ELSE IF(IFLUID.EQ.1) THEN
+            CALL THMHST(PCOOL(K),TSAT)
+          ENDIF
+
+          TB=TSAT-0.1
+          IF(TCOOL(K).LT.TB) THEN
+            IF(IFLUID.EQ.0) THEN
+              CALL THMPT(PCOOL(K),TCOOL(K),RHOIN,H11,K11,MUT(K),C11)
+            ELSE IF(IFLUID.EQ.1) THEN
+              CALL THMHPT(PCOOL(K),TCOOL(K),RHOIN,H11,K11,MUT(K),C11)
+            ELSE IF(IFLUID.EQ.2) THEN
+              CALL THMSPT(STP,TCOOL(K),R11,H11,K11,MUT(K),C11,IMPX)
+            ENDIF
+          ELSE
+            IF(IFLUID.EQ.0) THEN
+              CALL THMPT(PCOOL(K),TB,R11,H11,K11,MUT(K),C11)
+            ELSE IF(IFLUID.EQ.1) THEN
+              CALL THMHPT(PCOOL(K),TB,R11,H11,K11,MUT(K),C11)
+            ELSE IF(IFLUID.EQ.2) THEN
+              CALL THMSPT(STP,TB,R11,H11,K11,MUT(K),C11,IMPX)
+            ENDIF
+          ENDIF
+        ENDIF
+      ENDDO
+*----
+*  MAIN LOOP ALONG THE 1D CHANNEL.
+*----
+      ERRV = 1.0
+      ERRP = 1.0
+      ERRD = 1.0
+      NORMP = PINLET
+      NORMV = SPEED
+      NORMD = RHOIN
+      I=0
+      IF (IPRES .EQ. 0) GOTO 30
+   10 CONTINUE
+*----
+*  UPDATE HINLET FUNCTION OF INLET PRESSURE AND TEMPERATURE
+*----
+       HMSUP=HINLET
+       SPEED=MFLOW/DCOOL(1)
+*----
+*  WHILE LOOP FOR PRESSURE AND VELOCITY CONVERGENCE
+*  CHECK FOR CONVERGENCE
+*----
+        IF (I .GT. 1000) GOTO 20
+        IF ((ERRP.LT.5E-4).AND.(ERRV.LT.5E-4).AND.(IDFM.EQ.0)) GOTO 20
+
+        IF ((IDFM.GT.0).AND.(I.GT.3)) THEN
+        IF ((ERRP.LT.5E-4).AND.(ERRV.LT.5E-4).AND.(ERRD.LT.5E-4)) THEN
+        GOTO 20
+        ENDIF
+        ENDIF
+
+          I = I + 1
+
+          PTEMP = PCOOL
+          VTEMP = VCOOL
+          DTEMP = DCOOL
+
+          SPEED = MFLOW/DCOOL(1)
+          CALL THMPV(SPEED, PCOOL(NZ), VCOOL, DCOOL, 
+     >              PCOOL, TCOOL, MUT, XFL, HD, NZ,
+     >              HZ, EPS, DLCOOL,DGCOOL, VGJprime, IDFM, ACOOL)
+* Extrapolate from first two values of PCOOL to get PINLET at first face.
+* This ensures that computed HINLET is not HCOOL(1)
+          PINLET = (3.0/2.0)*PCOOL(1) - (1.0/2.0)*PCOOL(2)
+          IF (IFLUID.EQ.0) THEN
+            CALL THMPT(PINLET, TINLET, RHOIN, HINLET, R3, R4, R5)
+          ELSE IF(IFLUID.EQ.1) THEN
+            CALL THMHPT(PINLET,TINLET,RHOIN,HINLET,R3,R4,R5)
+          ELSE IF(IFLUID.EQ.2) THEN
+            CALL THMSPT(STP,TINLET,RHOIN,HINLET,R3,R4,R5,IMPX)
+          ENDIF
+*   Update inlet enthalpy based on computed inlet pressure.
+          HMSUP = HINLET
+   30 CONTINUE
+*----
+*  MAIN LOOP ALONG THE 1D CHANNEL.
+*----
+      K0=0 ! onset of nucleate boiling point
+      DO K=1,NZ
+        IF(POW(K).EQ.0.0) CYCLE
+        IF(IFLUID.EQ.0) THEN
+          CALL THMSAT(PCOOL(K),TSAT)
+        ELSE IF(IFLUID.EQ.1) THEN
+          CALL THMHST(PCOOL(K),TSAT)
+        ENDIF
+        TBUL(K)=TSAT
+*----
+*  COMPUTE THE LINEAR POWER, THE VOLUMIC POWER AND THE THERMAL EXCHANGE
+*  COEFFICIENT OF THE GAP
+*----
+        DV=VOLXY*HZ(K)
+*       linear power in W/m
+        POWLIN=(POW(K)/DV)*VOLXY/FNFU(K)
+*       volumic power in W/m^3
+        QFUEL(K)=POW(K)*FFUEL(K)/DV
+        QCOOL(K)=POW(K)*FCOOL(K)/DV
+*----
+*  INITIALIZATION OF PINCELL TEMPERATURES
+*----
+        IF(POW(K).EQ.0.0) CYCLE
+        IF(IMPX.GT.4) WRITE(6,190) K
+        DO L=1,NDTOT
+           TRE11(L)=TCOMB(K)
+        ENDDO
+        DO L=1,NDTOT-1
+           RADD(L)=RAD(L,K)
+        ENDDO
+*----
+*  COMPUTE THE POWER DENSITY AND HEAT FLOW ALONG THE CHANNEL
+*----
+*       out-of-clad heat flow in W/m2
+        IF(IMPX.GT.5) WRITE(6,'(15H THMDRV: QFUEL(,I5,2H)=,1P,E12.4,
+     >  6H W/m2.)') K,QFUEL(K)
+        PHI2=0.5*QFUEL(K)*RAD(NFD,K)**2/RAD(NDTOT-1,K)
+        IF(PHI2.GT.CFLUX) THEN
+          WRITE(HSMG,'(23HTHMDRV: THE HEAT FLUX (,1P,E12.4,5H) IS ,
+     >    37HGREATER THAN THE CRITICAL HEAT FLUX (,E12.4,2H).)')
+     >    PHI2,CFLUX
+          CALL XABORT(HSMG)
+        ENDIF
+*----
+*  COMPUTE FOUR VALUES OF ENTHALPY IN J/KG TO BE USED IN GAUSSIAN
+*  INTEGRATION. DELTH1 IS THE ENTHALPY INCREASE IN EACH AXIAL MESH.
+*---- 
+        IF (IDFM.EQ.0) THEN
+          DELTH1=(PCH(K)/ACOOL(K)*PHI2+QCOOL(K))*HZ(K)/MFLOW
+        ELSE
+          DELTH1= (PCH(K)/ACOOL(K)*PHI2+QCOOL(K))*HZ(K)*ACOOL(K)
+        ENDIF
+        IF ((K.GT.1).AND.(IDFM.GT.0)) THEN
+          DELTH1= (PCH(K)/ACOOL(K)*PHI2+QCOOL(K))*HZ(K)*ACOOL(K)
+          DELTH1 = DELTH1 + ((VCOOL(K-1) + EPS(K-1)*(DLCOOL(K-1)-
+     >      DGCOOL(K-1))/DCOOL(K-1)*VGJprime(K-1))
+     >      + (VCOOL(K) + EPS(K)*(DLCOOL(K)-DGCOOL(K))/
+     >      DCOOL(K)*VGJprime(K)))/2*(PCOOL(K-1)*ACOOL(K-1)-PCOOL(K)
+     >      *ACOOL(K))
+          DELTH1 = DELTH1 +(EPS(K-1)*DGCOOL(K-1)*(DLCOOL(K-1)/
+     >      DCOOL(K-1))*HLV(K-1)*VGJprime(K-1)*ACOOL(K-1))-(EPS(K)*
+     >      DGCOOL(K)*(DLCOOL(K)/DCOOL(K))*HLV(K)*VGJprime(K)*ACOOL(K))   
+          DELTH1 = DELTH1/MFLOW/ACOOL(K)
+        ENDIF
+        DO I1=1,4
+          POINT=(1.0+XS(I1))/2.0
+          ENT(I1)=HMSUP+POINT*DELTH1
+        ENDDO
+        HMSUP=HMSUP+DELTH1
+*----
+*  COMPUTE THE VALUE OF THE DENSITY AND THE CLAD-COOLANT HEAT TRANSFER
+*  COEFFICIENT
+*----
+        IF(K.GT.1) THEN
+          XFL(K)=XFL(K-1)
+          EPS(K)=EPS(K-1)
+          SLIP(K)=SLIP(K-1)
+        ENDIF
+*CGT
+        IF ((IFLUID.EQ.0).OR.(IFLUID.EQ.1)) THEN
+          CALL THMH2O(0,IX,IY,K,K0,PCOOL(K),MFLOW,HMSUP,ENT,HD(K),
+     >    IFLUID,IHCONV,KHCONV,ISUBM,RAD(NDTOT-1,K),ZF,VCOOL(K),
+     >    IDFM,PHI2,XFL(K),EPS(K),SLIP(K),ACOOL(K),PCH(K),HZ(K),TCALO,
+     >    RHO,RHOL,RHOG,TRE11(NDTOT),KWA(K),VGJprime(K),HLV(K))
+        ELSEIF (IFLUID.EQ.2) THEN
+          CALL THMSAL(IMPX,0,IX,IY,K,K0,MFLOW,HMSUP,ENT,HD(K),STP,
+     >    IHCONV,KHCONV,ISUBM,RAD(NDTOT-1,K),ZF,PHI2,XFL(K),
+     >    EPS(K),SLIP(K),HZ(K),TCALO,RHO,RHOL,TRE11(NDTOT),
+     >    KWA(K))
+        ENDIF
+*CGT
+*----
+*  STEADY-STATE SOLUTION OF THE CONDUCTION EQUATIONS IN A FUEL PIN.
+*----
+        DTINV=0.0
+        IF(IGAP.EQ.0) THEN
+          CALL THMROD(IMPX,NFD,NDTOT-1,MAXIT1,MAXITL,ERMAXT,DTINV,RADD,
+     >    TRE11,TRE11,QFUEL(K),FRO,TRE11(NDTOT),POWLIN,XBURN(K),
+     >    POROS,FRACPU,ICONDF,NCONDF,KCONDF,UCONDF,ICONDC,NCONDC,
+     >    KCONDC,UCONDC,IHGAP,KHGAP,IFRCDI,TC1,XX2,XX3,ZF)
+        ELSE
+          CALL THMRNG(IMPX,NFD,NDTOT-1,MAXIT1,MAXITL,ERMAXT,DTINV,RADD,
+     >    TRE11,TRE11,QFUEL(K),FRO,TRE11(NDTOT),XBURN(K),
+     >    POROS,FRACPU,ICONDF,NCONDF,KCONDF,UCONDF,ICONDC,NCONDC,
+     >    KCONDC,UCONDC,IFRCDI,IFUEL,FTP,TC1,XX2,XX3,ZF)
+        ENDIF
+*
+        DO K1=1,NDTOT-1
+          TRE11(K1)=XX2(K1)+TRE11(NDTOT)*XX3(K1)
+        ENDDO
+*----
+*  RECOVER MESHWISE TEMPERATURES AND FLUID DENSITY. BY DEFAULT, USE THE
+*  ROWLANDS FORMULA TO COMPUTE THE EFFECTIVE FUEL TEMPERATURE, OTHERWISE
+*  USE USER-SPECIFIED WEIGHTING FACTOR.
+*----  
+        TCOMB(K)=(1.0-WTEFF)*TC1+WTEFF*TRE11(NFD)
+        TCENT(K)=TC1
+        TSURF(K)=TRE11(NFD)
+        TCLAD(K)=TRE11(NDTOT)
+        TCOOL(K)=TCALO
+        DCOOL(K)=RHO
+        DLCOOL(K)=RHOL
+        HCOOL(K)=HMSUP
+        PC(K)=PINLET
+        TP(K)=TCLAD(K)
+        TLC(K)=TCOOL(K)
+        ENTH(K)=HCOOL(K)
+        AGM(K)=MFLOW ! constant flow rate
+        DO K2=1,NDTOT
+          TEMPT(K2,K)=TRE11(K2)
+        ENDDO
+        IF (IPRES .EQ. 0) THEN
+          PCOOL(K)=PINLET
+          VCOOL(K)=MFLOW/DCOOL(K)
+        ENDIF
+*----
+*  COMPUTE THE SATURATION TEMPERATURE AND THE THERMODYNAMIC PROPERTIES
+*  IF THE PRESSURE DROP IS COMPUTED
+*---
+        IF (IPRES.EQ.1) THEN
+          IF(POW(K).EQ.0.0) CYCLE
+          IF(IFLUID.EQ.0) THEN
+            CALL THMSAT(PCOOL(K),TSAT)
+          ELSE IF(IFLUID.EQ.1) THEN
+            CALL THMHST(PCOOL(K),TSAT)
+          ENDIF
+ 
+          TB=TSAT-0.1
+          IF(TCOOL(K).LT.TB) THEN
+            IF(IFLUID.EQ.0) THEN
+             CALL THMPT(PCOOL(K),TCOOL(K),RHOIN,H11,K11,MUT(K),C11)
+            ELSE IF(IFLUID.EQ.1) THEN
+             CALL THMHPT(PCOOL(K),TCOOL(K),RHOIN,H11,K11,MUT(K),C11)
+            ELSE IF(IFLUID.EQ.2) THEN
+             CALL THMSPT(STP,TCOOL(K),R11,H11,K11,MUT(K),C11,IMPX)
+            ENDIF
+          ELSE
+            IF(IFLUID.EQ.0) THEN
+             CALL THMPT(PCOOL(K),TB,R11,H11,K11,MUT(K),C11)
+            ELSE IF(IFLUID.EQ.1) THEN
+             CALL THMHPT(PCOOL(K),TB,R11,H11,K11,MUT(K),C11)
+            ELSE IF(IFLUID.EQ.2) THEN
+             CALL THMSPT(STP,TB,R11,H11,K11,MUT(K),C11,IMPX)
+            ENDIF
+          ENDIF
+         ENDIF
+      ENDDO
+*----
+* IF THE PRESSURE DROP IS COMPUTED, COMPUTE THE 
+* THE PRESSURE AND VELOCITY RESIDUALS
+* IF DFM IS ACTIVATED, COMPUTE DCOOL RESIDUALS
+*----
+      IF (IPRES .EQ. 0) GOTO 20
+      ERRV = 0.0
+      ERRP = 0.0
+      ERRD = 0.0
+      NORMV = 0.0
+      NORMP = 0.0
+      NORMD = 0.0
+
+      DO K=1,NZ
+*         Under relaxation of coolant pressure and velocity.
+          VCOOL(K) = 0.40*VCOOL(K) + (1.00-0.40)*VTEMP(K)
+          PCOOL(K) = 0.40*PCOOL(K) + (1.00-0.40)*PTEMP(K)
+          ERRV = ERRV + (VCOOL(K)-VTEMP(K))**2
+          NORMV = NORMV + VCOOL(K)**2
+          ERRP = ERRP + (PCOOL(K)-PTEMP(K))**2
+          NORMP = NORMP + PCOOL(K)**2
+        IF (IDFM.GT.0) THEN
+*         Under relaxation of coolant density.
+          DCOOL(K) = 0.40*DCOOL(K) + (1.00-0.40)*DTEMP(K)
+          ERRD = ERRD + (DCOOL(K) - DTEMP(K))**2
+          NORMD = NORMD + DCOOL(K)**2
+        ENDIF
+      ENDDO
+      NORMV = SQRT(NORMV)
+      NORMP = SQRT(NORMP)
+      ERRV = SQRT(ERRV) / NORMV
+      ERRP = SQRT(ERRP) / NORMP
+      IF (IDFM.GT.0) THEN
+        NORMD = SQRT(NORMD)
+        ERRD = SQRT(ERRD) / NORMD
+      ENDIF
+      GO TO 10
+
+   20 CONTINUE
+
+      IF (I.GE.1000) THEN
+        PRINT *, 'ERRV =', ERRV
+        PRINT *, 'ERRP =', ERRP
+        PRINT *, 'ERRD =', ERRD
+        CALL XABORT('THMDRV: MAXIMUM NB OF ITERATIONS REACHED.')
+      ELSE IF(IMPX.GT.0) THEN
+        WRITE(6,'(37H THMDRV: CONVERGENCE REACHED AT ITER=,I5,1H.)') I
+      ENDIF
+
+*----
+* RECONSTRUCT THE PHASE VELOCITIES FROM VCOOL, EPS and VGJ
+*----
+      DO K=1,NZ
+        IF (IDFM .GT. 0) THEN
+          VLIQ(K) = VCOOL(K) - (1.0/(1.0- EPS(K)) - DLCOOL(K)/DCOOL(K))
+     >     * VGJprime(K)
+          VVAP(K) = VCOOL(K) + DLCOOL(K)/DCOOL(K) *VGJprime(K)
+        ELSE
+          VLIQ(K) = VCOOL(K)
+          VVAP(K) = VCOOL(K) 
+        ENDIF
+      ENDDO     
+*----
+* PRINT THE THERMOHYDRAULICAL PARAMETERS
+*----
+      IF(IMPX.GT.4) THEN
+        WRITE(6,250) 'POW', POW(:NZ)
+        WRITE(6,250) 'PCOOL', PCOOL(:NZ)
+        WRITE(6,250) 'VCOOL', VCOOL(:NZ)
+        WRITE(6,250) 'DCOOL', DCOOL(:NZ)
+        WRITE(6,250) 'TCOOL', TCOOL(:NZ)
+        WRITE(6,250) 'EPS', EPS(:NZ)
+        WRITE(6,250) 'XFL', XFL(:NZ)
+        WRITE(6,250) 'TSAT', TBUL(:NZ)
+        WRITE(6,250) 'MUT', MUT(:NZ)
+      ENDIF
+*----
+*  PRINT THE OUTLET THERMOHYDRAULICAL PARAMETERS
+*----
+      IF(IMPX.GT.3) THEN
+        WRITE(6,'(/16H THMDRV: CHANNEL,2I6/1X,27(1H-))') IX,IY
+        WRITE(6,210) ' ____________________________________________',
+     >          '_____________________________________________________',
+     >          '_____________________________________________________',
+     >          '______________'
+        WRITE(6,210) '|     |   TCOMB    |   TSURF    |    DCOOL ',
+     >          '   |    TCOOL    |    PCOOL    |    HCOOL    |    ',
+     >          'QFUEL    |    QCOOL    |    VOID   |     QUAL    |',
+     >          '     SLIP    |  FLOW  |',
+     >          '|     |     K      |     K      |    Kg/m3    |   ',
+     >          '   K      |     Pa      |    J/Kg     |    W/m3   ',
+     >          '  |    W/m3     |           |             |       ',
+     >          '      | REGIME |'
+        WRITE(6,210) '|_____|____________|____________|____________',
+     >          '_|_____________|_____________|_____________|_________',
+     >          '____|_____________|___________|_____________|________',
+     >          '_____|________|'
+        DO L=NZ,1,-1
+          IF(L.EQ.1) THEN
+            WRITE(6,220) '| BOT |',TCOMB(L),' |',TSURF(L),
+     >            ' |',DCOOL(L),' |',TCOOL(L),' |',PCOOL(L),
+     >            ' |',HCOOL(L),' |',QFUEL(L),' |',QCOOL(L),' |',
+     >            EPS(L),' |',XFL(L),' |',SLIP(L),' |',KWA(L),' |'
+          ELSEIF(L.EQ.NZ) THEN
+            WRITE(6,220) '| TOP |',TCOMB(L),' |',TSURF(L),
+     >            ' |',DCOOL(L),' |',TCOOL(L),' |',PCOOL(L),
+     >            ' |',HCOOL(L),' |',QFUEL(L),' |',QCOOL(L),' |',
+     >            EPS(L),' |',XFL(L),' |',SLIP(L),' |',KWA(L),' |'
+          ELSE
+            WRITE(6,230) '| ',L,' |',TCOMB(L),' |',TSURF(L),
+     >            ' |',DCOOL(L),' |',TCOOL(L),' |',PCOOL(L),
+     >            ' |',HCOOL(L),' |',QFUEL(L),' |',QCOOL(L),' |',
+     >            EPS(L),' |',XFL(L),' |',SLIP(L),' |',KWA(L),' |'
+          ENDIF
+        ENDDO
+        WRITE(6,210) '|_____|____________|____________|____________',
+     >          '_|_____________|_____________|_____________|_________',
+     >          '____|_____________|___________|_____________|________',
+     >          '_____|________|'
+        WRITE(6,240) MFLOW
+      ENDIF
+*----
+*  MODIFICATION OF THE VECTORS TO FIT THE GEOMETRY OF THE CHANNELS AND
+*  THE BUNDLES AND WRITE THE DATA IN LCM OBJECT THM 
+*----
+      CALL LCMPUT(MPTHM,'PRESSURE',NZ,2,PCOOL)
+      CALL LCMPUT(MPTHM,'DENSITY',NZ,2,DCOOL)
+      CALL LCMPUT(MPTHM,'LIQUID-DENS',NZ,2,DLCOOL)
+      CALL LCMPUT(MPTHM,'ENTHALPY',NZ,2,HCOOL)
+      CALL LCMPUT(MPTHM,'VELOCITIES',NZ,2,VCOOL)
+      CALL LCMPUT(MPTHM,'V-LIQ',NZ,2,VLIQ)
+      CALL LCMPUT(MPTHM,'V-VAP',NZ,2,VVAP)
+      CALL LCMPUT(MPTHM,'EPSILON',NZ,2,EPS)
+      CALL LCMPUT(MPTHM,'EPSOUT',1,2,EPS(NZ))
+      CALL LCMPUT(MPTHM,'XFL',NZ,2,XFL)
+      CALL LCMPUT(MPTHM,'CENTER-TEMPS',NZ,2,TCENT)
+      CALL LCMPUT(MPTHM,'COOLANT-TEMP',NZ,2,TCOOL)
+      CALL LCMPUT(MPTHM,'POWER',NZ,2,POW)
+      CALL LCMPUT(MPTHM,'TEMPERATURES',NDTOT*NZ,2,TEMPT)
+      CALL LCMPUT(MPTHM,'PINLET',1,2,PINLET)
+      CALL LCMPUT(MPTHM,'TINLET',1,2,TINLET)
+      CALL LCMPUT(MPTHM,'VINLET',1,2,SPEED)
+      CALL LCMPUT(MPTHM,'POULET',1,2,POUTLET)
+      CALL LCMPUT(MPTHM,'RADII',(NDTOT-1)*NZ,2,RAD)
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(TCENT,TEMPT,VCOOL)
+      DEALLOCATE(PTEMP, VTEMP, DTEMP)
+      RETURN
+*
+  190 FORMAT(/21H THMDRV: AXIAL SLICE=,I5)
+  210 FORMAT(1X,A,A,A,A)
+  220 FORMAT(1X,A,F11.2,A,F11.2,A,F12.4,A,F12.2,A,3P,E12.4,
+     >       A,1P,E12.4,A,1P,E12.4,A,1P,E12.4,A,0P,F10.4,A,E12.4,A,
+     >       E12.4,A,I5,2X,A)
+  230 FORMAT(1X,A,I3,A,F11.2,A,F11.2,A,F12.4,A,F12.2,A,3P,E12.4,
+     >       A,1P,E12.4,A,1P,E12.4,A,1P,E12.4,A,0P,F10.4,A,E12.4,A,
+     >       E12.4,A,I5,2X,A)
+  240 FORMAT(7H MFLXT=,1P,E12.4,8H Kg/m2/s)
+  250 FORMAT(9H THMDRV: ,A6,1H:,1P,11E12.4/(4X,12E12.4))
+      END
diff --git a/Donjon/src/THMFRI.f b/Donjon/src/THMFRI.f
new file mode 100644
index 0000000..cc413e3
--- /dev/null
+++ b/Donjon/src/THMFRI.f
@@ -0,0 +1,53 @@
+*DECK THMFRI
+      SUBROUTINE THMFRI(REY,EPS,HD,FRIC)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute the value of the friction factor coefficient with :
+* - Laminar flow correlation based on condition on Reynolds number
+* - Muller Steinhagen correlation formula (single phase)
+* - Churchill's correlation in two phase flows
+*
+*Copyright:
+* Copyright (C) 2013 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* P. Gallet (creation)
+* 07/08/2025 : Modified by M. Bellier to include Churchill
+*
+*Parameters: input
+* REY     reynolds number 
+* EPS     void fraction
+* HD      hydraulic diameter
+*
+*Parameters: output
+* FRIC    friction factor coefficient
+*
+*-----------------------------------------------------------------------
+*
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      REAL REY,FRIC,HD,EPS,R
+*----
+*  COMPUTE VALUE OF THE FRICTION FACTOR COEFFICIENT AS FUNCTION OF THE 
+*  REYNOLDS NUMBER
+*----
+
+! Laminar flow
+      IF (REY.LE.1187.0) THEN
+            FRIC=64.0/REY
+! Blasius-like correlation used by C. Huet in his python prototype
+      ELSE IF (EPS.LT.0.002) THEN
+            FRIC=0.3164/(REY**0.25)
+! Churchill's correlation
+      ELSE
+            R = 0.0000004/HD !Relative roughness=Roughness/Hydraulic Diameter
+            FRIC=8*(((8.0/REY)**12)+((2.475*LOG(((7/REY)**0.9)+0.27*R))
+     >      **16+(37530/REY)**16)**(-1.5))**(0.0833333)
+      ENDIF
+
+      RETURN
+      END
diff --git a/Donjon/src/THMGAP.f b/Donjon/src/THMGAP.f
new file mode 100644
index 0000000..1ca6149
--- /dev/null
+++ b/Donjon/src/THMGAP.f
@@ -0,0 +1,95 @@
+*DECK THMGAP
+      SUBROUTINE THMGAP(POWLIN,BURN,HGAP)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute the heat exchange coefficient of the gap.
+*
+*Copyright:
+* Copyright (C) 2012 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* POWLIN  linear power in W/m
+* BURN    fuel burnup in MWday/tonne
+*
+*Parameters: output
+* HGAP    heat exchange coefficient of the gap in W/m^2/K. Values with
+*         POWLIN greater than 400 W/cm or BURN greater than 50000
+*         MWday/ton and up to 90000 MWday/ton are extrapolated.
+*         After 90000 MWday/ton, the setting of a constant HGAP value
+*         is required and the thermal mechanic model below is by-passed. 
+*
+*-----------------------------------------------------------------------
+*
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      REAL POWLIN,BURN,HGAP
+*----
+*  LOCAL VARIABLES
+*----
+      CHARACTER HSMG*300
+      REAL TAB1(19),TAB2(11),C(19,11),TERP1(19),TERP2(11),WK1(3,19),
+     > WK2(3,11)
+      INTEGER I1,I2
+*
+      DATA TAB1/0.,5000.,10000.,15000.,20000.,25000.,30000.,35000.,
+     >          40000.,45000.,50000.,55000.,60000.,65000.,70000.,
+     >          75000.,80000.,85000.,90000./
+      DATA TAB2/0.,30.,100.,170.,240.,310.,380.,400.,420.,440.,460./
+      DATA C/0.657,0.702,0.814,0.987,1.311,2.114,2.445,2.415,2.324,2.229
+     >      ,2.137,2.048,1.962,1.880,1.786,1.697,1.608,1.519,1.430
+     >      ,0.678,0.726,0.848,1.043,1.444,2.465,2.810,2.790,2.718,2.640
+     >      ,2.562,2.484,2.406,2.328,2.250,2.172,2.094,2.016,1.938
+     >      ,0.727,0.783,0.927,1.173,1.755,3.283,3.661,3.666,3.637,3.598
+     >      ,3.554,3.505,3.453,3.397,3.356,3.307,3.259,3.211,3.163
+     >      ,0.787,0.854,1.032,1.373,2.322,3.800,3.790,3.780,3.769,3.756
+     >      ,3.741,3.724,3.706,3.687,3.673,3.656,3.640,3.623,3.607
+     >      ,0.861,0.949,1.185,1.725,3.385,3.873,3.863,3.854,3.842,3.829
+     >      ,3.814,3.797,3.779,3.760,3.746,3.729,3.713,3.696,3.680
+     >      ,0.949,1.068,1.415,2.385,3.925,3.910,3.900,3.891,3.879,3.865
+     >      ,3.850,3.834,3.817,3.800,3.785,3.769,3.754,3.738,3.722
+     >      ,1.071,1.248,1.843,3.686,3.957,3.941,3.929,3.915,3.898,3.875
+     >      ,3.847,3.814,3.779,3.742,3.711,3.678,3.644,3.611,3.578
+     >      ,1.114,1.317,2.033,3.981,3.964,3.946,3.931,3.911,3.885,3.851
+     >      ,3.807,3.754,3.697,3.638,3.589,3.535,3.481,3.428,3.374
+     >      ,1.161,1.396,2.264,4.153,4.002,3.950,3.926,3.897,3.856,3.804
+     >      ,3.735,3.651,3.560,3.469,3.390,3.306,3.221,3.137,3.052
+     >      ,1.212,1.485,2.542,4.155,4.090,3.953,3.913,3.869,3.806,3.729
+     >      ,3.624,3.495,3.356,3.219,3.098,2.969,2.841,2.712,2.583
+     >      ,1.268,1.586,2.873,3.938,4.243,3.956,3.889,3.826,3.731,3.620
+     >      ,3.465,3.273,3.067,2.867,2.687,2.497,2.306,2.116,1.926/
+*
+      IF(BURN.GT.90000.) THEN
+        WRITE(HSMG,'(22HTHMGAP: BURNUP VALUE (,1P,E11.4,
+     >      35H) TOO HIGH FOR THE THERMAL MECHANIC,
+     >      41H MODEL COMPUTING THE HEAT EXCHANGE OF THE,
+     >      38H FUEL-CLADDING GAP (LIMIT 90000MWd/t).,
+     >      45H ALTERNATIVELY, YOU CAN SET THE HGAP CONSTANT,
+     >      19H IN THE THM MODULE.)') BURN
+        CALL XABORT(HSMG)
+      ENDIF
+
+      CALL ALTERP(.TRUE.,19,TAB1(1),BURN,.FALSE.,TERP1(1),WK1(1,1))
+      HGAP=0.0
+      IF(POWLIN.LE.460.E2) THEN
+        CALL ALTERP(.TRUE.,11,TAB2(1),POWLIN/1.0E2,.FALSE.,TERP2(1),
+     >  WK2(1,1))
+        DO I1=1,19
+          DO I2=1,11
+            HGAP=HGAP+TERP1(I1)*TERP2(I2)*C(I1,I2)
+          ENDDO
+        ENDDO
+      ELSE
+        DO I1=1,19
+          HGAP=HGAP+TERP1(I1)*C(I1,11)
+        ENDDO
+      ENDIF
+      HGAP=HGAP*1.0E4
+      RETURN
+      END
diff --git a/Donjon/src/THMGCD.f b/Donjon/src/THMGCD.f
new file mode 100644
index 0000000..8a0ffa7
--- /dev/null
+++ b/Donjon/src/THMGCD.f
@@ -0,0 +1,58 @@
+*DECK THMCCD
+      REAL FUNCTION THMGCD(TEMP)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute the product of the heat capacity of cladding (in J/Kg/K) times
+* its density (in Kg/m^3).
+*
+*Copyright:
+* Copyright (C) 2013 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* P. Gallet
+*
+*Parameters: input
+* TEMP    cladding temperature in Kelvin.
+* 
+*Parameters: output
+* THMGCD  product of the heat capacity of the cladding times its density
+*         (in J/K/m^3).
+*         
+*-----------------------------------------------------------------------
+*
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      REAL TEMP
+*----
+*  LOCAL VARIABLES
+*  CP:   cladding heat capacity in J/Kg/K
+*  RO:   cladding density with zero porosity in kg/m^3
+*----
+      REAL CP,RO,DKELV,T0,T1,T2
+      PARAMETER (DKELV=273.15,T0=1090.0,T1=1169.0,T2=1243.0)
+*
+*     calculation of the density of the cladding with the value of the
+*     temperature
+      RO=6690.0-0.1855*TEMP
+*     calculation of the heat capacity of the cladding in J/kg/K
+      IF(TEMP.LE.T0) THEN
+*        for : T<1090.0
+         CP=226.7+0.2066*TEMP-0.6492E-04*TEMP**2.0
+      ELSE IF(TEMP.LE.T1) THEN
+*        for : 1090<=T<1169.0
+         CP=6.94*TEMP-7189.0
+      ELSE IF(TEMP.LE.T2) THEN
+*        for : 1169<=T<1243.0
+         CP=9312.9-7.177*TEMP
+      ELSE
+*        for T>=1243.0
+         CP=356.0
+      ENDIF
+*     calculation of internal energy of the cladding in J/m^3/K
+      THMGCD=RO*CP
+      RETURN
+      END
diff --git a/Donjon/src/THMGDI.f b/Donjon/src/THMGDI.f
new file mode 100644
index 0000000..ef4781f
--- /dev/null
+++ b/Donjon/src/THMGDI.f
@@ -0,0 +1,76 @@
+*DECK THMGDI
+      FUNCTION THMGDI(T2K,T1K,ICONDC,NCONDC,KCONDC,UCONDC)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute the average thermal conductivity of the cladding
+*
+*Copyright:
+* Copyright (C) 2013 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* P. Gallet, V. Salino
+*
+*Parameters: input
+* T2K     final temperature in Kelvin.
+* T1K     initial temperature in Kelvin.
+* ICONDC  clad conductivity flag (0=default/1=user-provided
+*         polynomial).
+* NCONDC  degree of user-provided clad conductivity polynomial.
+* KCONDC  polynomial coefficients for clad conductivity in W/m/K^(k+1).
+* UCONDC  required unit of temperature in polynomial for clad
+*         conductivity (KELVIN or CELSIUS).
+*
+*Parameters: output
+* THMGDI  thermal conductivity of the cladding in W/m/K.
+*
+*Reference:
+* A. Poncot, "Assimilation de donnees pour la dynamique du xenon dans
+* les coeurs de centrale nucleaire", Ph.D Thesis, Universite de
+* Toulouse, France, 2008.
+* 
+*-----------------------------------------------------------------------
+*
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER ICONDC,NCONDC
+      REAL T1K,T2K,KCONDC(NCONDC+1),THMGDI
+      CHARACTER UCONDC*12
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER K
+      REAL T1,T2,TM,TMK,ZKELV
+*
+      PARAMETER ( ZKELV=273.15 )
+*
+      IF(MIN(T1K,T2K).LE.0.0) THEN
+         CALL XABORT('@THMGDI: NEGATIVE TEMPERATURE.')
+      ENDIF
+      T1=T1K-ZKELV
+      T2=T2K-ZKELV
+*
+      TM=(T1+T2)*0.5
+      IF(ICONDC.EQ.1) THEN
+*        User-given conductivity, as a polynomial of temperature
+         THMGDI=0.0
+         IF(UCONDC.EQ.'KELVIN') THEN
+            TMK = TM + ZKELV
+            DO K=1,NCONDC+1
+               THMGDI = THMGDI + KCONDC(K)*TMK**(K-1)
+            ENDDO
+         ELSE
+            DO K=1,NCONDC+1
+               THMGDI = THMGDI + KCONDC(K)*TM**(K-1)
+            ENDDO
+         ENDIF
+      ELSE
+*        thermal conductivity of the cladding in W/m/K
+         THMGDI=12.0+1.25E-2*TM
+      ENDIF
+      
+      RETURN
+      END
diff --git a/Donjon/src/THMH2O.f b/Donjon/src/THMH2O.f
new file mode 100644
index 0000000..eb22012
--- /dev/null
+++ b/Donjon/src/THMH2O.f
@@ -0,0 +1,389 @@
+*DECK THMH2O
+      SUBROUTINE THMH2O(ITIME,I,J,K,K0,PINLET,MFLOW,HMAVG,ENT,HD,IFLUID,
+     >   IHCONV,KHCONV,ISUBM,RADCL,ZF,VCOOL,IDFM,PHI,XFL,EPS,SLIP,
+     >   ACOOL,PCH,DZ,TCALO,RHO,RHOLAV,RHOG,TSCLAD,KWA,VGJprime,HLV)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Nucleate boiling correlations along a single coolant channel.
+*
+*Copyright:
+* Copyright (C) 2012 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* A. Hebert, P. Gallet
+*
+*Parameters: input
+* ITIME   type of calculation  (0=steady-state; 1=transient).
+* I       position of channel alon X-axis
+* J       position of channel alon Y-axis
+* K       position of channel alon Z-axis
+* K0      onser of nuclear boiling point
+* PINLET  pressure in Pascal
+* MFLOW   massic coolant flow rate in Kg/m^2/s
+* HMAVG   averaged enthalpy
+* ENT     four values of enthalpy in J/Kg to be used in Gaussian
+*         integration
+* HD      hydraulic diameter in m
+* IFLUID  type of fluid (0=H2O; 1=D2O).
+* IHCONV  flag indicating HCONV chosen (0=default/1=user-provided).
+* KHCONV  fixed user-provided HCONV value in W/m^2/K.
+* ISUBM   subcooling model (0: one-phase; 1: Jens-Lottes model;
+*         2: Saha-Zuber model).
+* RADCL   outer clad radius in m
+* ZF      parameters used to compute heat flux on clad surface in
+*         transient cases.
+* PHI     heat flow exchanged between clad and fluid in W/m^2.
+*         Given in steady-state cases.
+* XFL     input coolant flow quality
+* EPS     input coolant void fraction
+* SLIP    input slip ratio of vapor phase speed to liquid phase speed.
+* ACOOL   coolant cross section area in m^2.
+* PCH     heating perimeter in m.
+* DZ      axial mesh width in m.
+* VCOOL   local coolant velocity
+* IDFM    flag indicating if the drift flux model is to be used 
+*         (0=HEM1(no drift velocity)/1=EPRI/2=MODEBSTION/3=GERAMP/4=CHEXAL)
+*
+*Parameters: output
+* PHI     heat flow exchanged between clad and fluid in W/m^2.
+*         Computed in transient cases.
+* XFL     output coolant flow quality
+* EPS     output coolant void fraction
+* SLIP    output slip ratio of vapor phase speed to liquid phase speed.
+* TCALO   coolant temperature in K
+* RHO     coolant density in Kg/m^3
+* RHOLAV  liquid density in kg/m^3
+* RHOG    vapour density in kg/m^3
+* TSCLAD  clad temperature in K
+* KWA     flow regime (=0: single-phase; =1: subcooled; =2: nucleate
+*         boiling; =3 superheated steam)
+* VGJ     drift velocity in m/s
+* VGJprime 
+* HLV     delta between liquid and vapour enthalpies
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER I,J,K,K0,IFLUID,IHCONV,ISUBM,KWA
+      REAL PINLET,MFLOW,HMAVG,ENT(4),HD,KHCONV,RADCL,ZF(2),PHI,TCALO,
+     > RHO,RHOLAV,TSCLAD,XFL,EPS,SLIP,ACOOL,PCH,DZ,VCOOL,VGJprime
+*----
+*  LOCAL VARIABLES
+*----
+      REAL W(4),HL(4),JL,JG,REL,PRL,VGJ,UL
+      CHARACTER HSMG*131
+      LOGICAL LFIRST
+*----
+*  SAVE VARIABLES
+*----
+      SAVE DHSUB,DSAT,W
+      DATA W /0.347855,0.652145,0.652145,0.347855/
+*----
+*  COMPUTE THE PROPERTIES OF THE SATURATED STEAM
+*----
+      IF(HMAVG.LT.0.0) CALL XABORT('THMH2O: NEGATIVE INPUT ENTHALPY.')
+      IF(IFLUID.EQ.0) THEN
+         CALL THMSAT(PINLET,TSAT)
+         CALL THMTX(TSAT,0.0,RHOL,HLSAT,ZKL,ZMUL,CPL)
+         CALL THMTX(TSAT,1.0,RHOG,HGSAT,ZKG,ZMUG,CPG)
+      ELSE IF(IFLUID.EQ.1) THEN
+         CALL THMHST(PINLET,TSAT)
+         CALL THMHTX(TSAT,0.0,RHOL,HLSAT,ZKL,ZMUL,CPL)
+         CALL THMHTX(TSAT,1.0,RHOG,HGSAT,ZKG,ZMUG,CPG)
+      ENDIF
+*----
+*  COMPUTE THE DENSITY AND TEMPERATURE OF THE LIQUID
+*----
+      HL(1)=MIN1(ENT(1),HLSAT)
+      HL(2)=MIN1(ENT(2),HLSAT)
+      HL(3)=MIN1(ENT(3),HLSAT)
+      HL(4)=MIN1(ENT(4),HLSAT)
+      CALL THMPH(IFLUID,PINLET,HL(1),R11,TL1)
+      CALL THMPH(IFLUID,PINLET,HL(2),R11,TL2)
+      CALL THMPH(IFLUID,PINLET,HL(3),R11,TL3)
+      CALL THMPH(IFLUID,PINLET,HL(4),R11,TL4)
+      IF(IFLUID.EQ.0) THEN
+        CALL THMPT(PINLET,TL1,RHO1,R2,R3,R4,CP1)
+        CALL THMPT(PINLET,TL2,RHO2,R2,R3,R4,CP2)
+        CALL THMPT(PINLET,TL3,RHO3,R2,R3,R4,CP3)
+        CALL THMPT(PINLET,TL4,RHO4,R2,R3,R4,CP4)
+        IF(ABS(TSAT-TL1).LT.0.1) CALL THMTX(TSAT,0.0,RHO1,R2,R3,R4,CP1)
+        IF(ABS(TSAT-TL2).LT.0.1) CALL THMTX(TSAT,0.0,RHO2,R2,R3,R4,CP2)
+        IF(ABS(TSAT-TL3).LT.0.1) CALL THMTX(TSAT,0.0,RHO3,R2,R3,R4,CP3)
+        IF(ABS(TSAT-TL4).LT.0.1) CALL THMTX(TSAT,0.0,RHO4,R2,R3,R4,CP4)
+      ELSE IF(IFLUID.EQ.1) THEN
+        CALL THMHPT(PINLET,TL1,RHO1,R2,R3,R4,CP1)
+        CALL THMHPT(PINLET,TL2,RHO2,R2,R3,R4,CP2)
+        CALL THMHPT(PINLET,TL3,RHO3,R2,R3,R4,CP3)
+        CALL THMHPT(PINLET,TL4,RHO4,R2,R3,R4,CP4)
+        IF(ABS(TSAT-TL1).LT.0.1) CALL THMHTX(TSAT,0.0,RHO1,R2,R3,R4,CP1)
+        IF(ABS(TSAT-TL2).LT.0.1) CALL THMHTX(TSAT,0.0,RHO2,R2,R3,R4,CP2)
+        IF(ABS(TSAT-TL3).LT.0.1) CALL THMHTX(TSAT,0.0,RHO3,R2,R3,R4,CP3)
+        IF(ABS(TSAT-TL4).LT.0.1) CALL THMHTX(TSAT,0.0,RHO4,R2,R3,R4,CP4)
+      ENDIF
+      TL=0.5*(W(1)*TL1+W(2)*TL2+W(3)*TL3+W(4)*TL4)
+      RHOLAV=0.5*(W(1)*RHO1+W(2)*RHO2+W(3)*RHO3+W(4)*RHO4)
+      CPLAV=0.5*(W(1)*CP1+W(2)*CP2+W(3)*CP3+W(4)*CP4)
+*----
+*  COMPUTE THE STEAM FLOW QUALITY AND LIQUID ENTHALPY
+*  Reference: R. T. Lahey Jr. and F. J. Moody, "The thermal hydraulics
+*  of a Boiling water nuclear reactor," American Nuclear Society, 1977.
+*  Equation (5.177), page 224
+*  F2: Thermodynamic quality
+*----
+      TSCLAD=600.0
+      IF(K0.GT.0) TSCLAD=TSAT+DSAT
+      XFL0=XFL
+      EPS0=EPS
+      SLIP0=SLIP
+      LFIRST=.TRUE.
+      HLAVG=HMAVG
+      F2=0.0
+      F3=0.0
+      IF(K0.GT.0) THEN
+        HLV=HGSAT-HLSAT
+        IF((HLV.GT.0.0).AND.(DHSUB.GT.0.0)) THEN
+          F2=(HMAVG-HLSAT)/HLV
+          F3=(DHSUB/HLV)*EXP(-(HMAVG-HLSAT)/DHSUB-1.0)
+        ENDIF
+        IF(HMAVG.GE.HGSAT) THEN
+          XFL=1.0
+          EPS=1.0
+          SLIP=1.0
+          HLAVG=0.0
+        ELSE
+          IF(ISUBM.EQ.1) THEN
+*           Use the Paul Gallet thesis model.
+            PI=RHOLAV*CPLAV*(TSCLAD-TL)/(RHOG*HLV)
+            XFL=XFL0+PCH*PHI*DZ/(MFLOW*ACOOL*HLV)/(1.0+PI)
+          ELSE IF(ISUBM.EQ.2) THEN
+*           Use a profile fit model.
+            XFL=MAX(XFL0,(F2+F3)/(1.0+F3))
+          ENDIF
+          HLAVG=MIN(HLSAT,(HMAVG-XFL*HGSAT)/(1.0-XFL))
+        ENDIF
+*----
+*  RECOMPUTE THE LIQUID PROPERTIES
+*----
+        IF(HLAVG.GT.0.0) THEN
+          CALL THMPH(IFLUID,PINLET,HLAVG,RHOL,TL)
+          IF(IFLUID.EQ.0) THEN
+            CALL THMPT(PINLET,TL,R1,R2,ZKL,ZMUL,CPL)
+          ELSE IF(IFLUID.EQ.1) THEN
+            CALL THMHPT(PINLET,TL,R1,R2,ZKL,ZMUL,CPL)
+          ENDIF
+*----
+*  COMPUTE THE COOLANT VOID FRACTION AND SLIP RATIO
+*  A drift-flux model is proposed by means of the concentration
+*  parameter CO and the drift velocity VGJ (their correspondent 
+*  correlations are supposed to work fine under different flow regimes.
+*----
+          IF(HGSAT.GT.HLSAT) THEN
+            CO=1.13
+            PR=PINLET/10**6
+            SIGM=-7.2391E-6*PR**3+2.8345E-4*PR**2-5.1566E-3*PR+4.2324E-2
+            VGJ=1.18*((SIGM*9.81*(RHOL-RHOG))/RHOL**2)**0.25
+            F4=CO*((XFL*RHOL)+((1.0-XFL)*RHOG))+(RHOL*RHOG*VGJ/MFLOW)
+            EPS=(XFL*RHOL)/F4
+            JL=(1.0-XFL)*MFLOW/RHOL
+            JG=XFL*MFLOW/RHOG
+            IF(EPS.NE.0) SLIP=JG*(1.0-EPS)/(JL*EPS)
+          ENDIF
+        ELSE
+*         superheated steam
+          CALL THMPH(IFLUID,PINLET,HMAVG,RHOG,TCALO)
+          IF(IFLUID.EQ.0) THEN
+            CALL THMPT(PINLET,TCALO,R1,R2,ZKG,ZMUG,CPG)
+          ELSE IF(IFLUID.EQ.1) THEN
+            CALL THMHPT(PINLET,TCALO,R1,R2,ZKG,ZMUG,CPG)
+          ENDIF
+        ENDIF
+      ENDIF
+*----
+*  COMPUTE THE FLUID PROPERTIES
+*  RHO: fluid density
+*  REL: Reynolds number of liquid phase
+*  PRL: Prandtl number of liquid phase
+*----
+      IF(XFL.EQ.0.0) THEN
+*       One phase liquid
+        TB=TSAT-0.1
+        IF(TL.LT.TB) THEN
+          TCALO=TL
+        ELSE
+          TCALO=TB
+        ENDIF
+        IF(IFLUID.EQ.0) THEN
+          CALL THMPT(PINLET,TCALO,R1,R2,ZKONE,ZMUONE,CPONE)
+        ELSE IF(IFLUID.EQ.1) THEN
+          CALL THMHPT(PINLET,TCALO,R1,R2,ZKONE,ZMUONE,CPONE)
+        ENDIF
+        RHO=RHOLAV
+        REL=MFLOW*HD/ZMUONE
+        PRL=ZMUONE*CPONE/ZKONE
+      ELSE IF(HMAVG.LT.HGSAT) THEN
+*       Two-phase flow
+        IF((IFLUID.EQ.0).AND.(IDFM.GT.0)) THEN
+            CALL THMDFM(PINLET,VCOOL,HMAVG,HD,TL,TSAT,IDFM,EPS,XFL,
+     >       RHO,RHOL,RHOG,VGJ,VGJprime,C0,HLV)
+            CALL THMTX(TCALO, 0.0, RHO11, H11, ZK11, ZMUL, CPL)
+            UL = VCOOL - (EPS / (1.0 - EPS))*RHOG/RHO * VGJprime
+            REL = ABS(UL*RHOL) * HD / ZMUL
+            PRL = ZMUL*CPL/ZKL
+        ELSE
+            REL=MFLOW*(1.0-XFL)*HD/ZMUL
+            PRL=ZMUL*CPL/ZKL
+        ENDIF
+        TCALO=EPS*TSAT+(1.0-EPS)*TL
+        ZKONE=ZKL
+        CPONE=CPL
+        RHO=EPS*RHOG+(1.0-EPS)*RHOL 
+        JL=(1.0-XFL)*MFLOW/RHOL
+        JG=XFL*MFLOW/RHOG
+        IF(EPS.NE.0) THEN
+        SLIP=JG*(1.0-EPS)/(JL*EPS) 
+        ENDIF
+      ELSE
+*       superheated steam
+        RHO=RHOG
+        REL=MFLOW*HD/ZMUG
+        PRL=ZMUG*CPG/ZKG
+      ENDIF
+*----
+*  THERMAL EXCHANGE BETWEEN CLAD AND FLUID USING THE DITTUS AND BOELTER
+*  CORRELATION (SINGLE PHASE) OR CHEN CORRELATION (SATURATED BOILING)
+*----
+      IF(IHCONV.EQ.0) THEN
+        ITER=0
+        KWA=99
+        DO
+          ITER=ITER+1
+          IF(ITER.GT.500) THEN
+            WRITE(HSMG,'(30HTHMH2O: HCONV FAILURE IN SLICE,I5,1H.)') K
+            CALL XABORT(HSMG)
+          ENDIF
+          HA=0.023*(ZKONE/HD)*REL**0.8*PRL**0.4
+          F=1.0
+          S=1.0
+          IF((XFL.EQ.XFL0).OR.(TSCLAD.LE.TSAT).OR.(KWA.EQ.0)) THEN
+*           Single-phase convection. Use Dittus-Boelter correlation
+            KWA=0
+            HB=0.0
+            K0=0
+            XFL=XFL0
+            EPS=EPS0
+            SLIP=SLIP0
+          ELSE IF(HMAVG.LT.HGSAT) THEN
+*           Subcooled convection. Use Dittus-Boelter and Forster-Zuber
+*           correlations
+*           XM: Martinelli parameter
+*           F: Reynolds number factor
+*           S: nucleate boiling suppression factor
+*           SIGM: surface tension in N/m
+*           HA: Dittus-Boelter coefficient
+*           HB: Forster-Zuber coefficient
+*
+            IF(HMAVG.LT.HLSAT) THEN
+              KWA=1
+            ELSE
+              KWA=2
+            ENDIF
+            XM=(XFL/(1.0-XFL))**0.9*(RHOL/RHOG)**0.5*(ZMUG/ZMUL)**0.1
+            IF(XM.LE.0.100207) THEN
+              F=1.0
+            ELSE
+              F=2.35*(0.213+XM)**0.736
+            ENDIF
+            RE=REL*F**1.25
+            S=1.0/(1.0+2.53E-6*RE**1.17)
+            PR=PINLET/10**6
+            SIGM=-7.2391E-6*PR**3+2.8345E-4*PR**2-5.1566E-3*PR+4.2324E-2
+            HA=0.023*(ZKL/HD)*REL**0.8*PRL**0.4
+            DTSAT=TSCLAD-TSAT
+            IF(IFLUID.EQ.0) THEN
+              CALL THMSAP(PW, TSCLAD)
+            ELSE
+              CALL THMHSP(PW, TSCLAD)
+            ENDIF
+            DP=PW-PINLET
+*           Forster-Zuber equation
+            HLV=HGSAT-HLSAT
+            HB=0.00122*ZKL**0.79*CPL**0.45*RHOL**0.49/(ZMUL**0.29*
+     >      SIGM**0.5*HLV**0.24*RHOG**0.24)*DTSAT**0.24*DP**0.75
+          ELSE
+*           Superheated steam. Use Mokry correlation
+            KWA=3
+            IF(IFLUID.EQ.0) THEN
+              CALL THMPT(PINLET,TSCLAD,RHOW,R2,R3,R4,R5)
+            ELSE IF(IFLUID.EQ.1) THEN
+              CALL THMHPT(PINLET,TSCLAD,RHOW,R2,R3,R4,R5)
+            ENDIF
+            HA=0.0061*(ZKG/HD)*REL**0.904*PRL**0.684*(RHOW/RHO)**0.564
+            HB=0.0
+          ENDIF
+*         Chen correlation
+          HCONV=F*HA+S*HB
+          IF(HCONV.LE.0.0) THEN
+            WRITE(HSMG,'(34HTHMH2O: DRY OUT REACHED IN CHANNEL,3I5)')
+     >      I,J,K
+            CALL XABORT(HSMG)
+          ENDIF
+          IF(ITIME.EQ.0) THEN
+            TWAL=(PHI+S*HB*TSAT+F*HA*TCALO)/(S*HB+F*HA)
+          ELSE
+            ZNUM=ZF(1)+RADCL*S*HB*TSAT+RADCL*F*HA*TCALO
+            ZDEN=ZF(2)+RADCL*S*HB+RADCL*F*HA
+            TWAL=MAX(273.15,ZNUM/ZDEN)
+            PHI=MAX(0.0,(ZF(1)-TWAL*ZF(2))/RADCL)
+          ENDIF
+          IF(ABS(TSCLAD-TWAL).GT.1.0E-5*TSCLAD) THEN
+            TSCLAD=TWAL
+          ELSE
+            EXIT
+          ENDIF
+        ENDDO
+      ELSE IF(IHCONV.EQ.1) THEN
+        IF(ITIME.EQ.0) THEN
+          TSCLAD=TCALO+PHI/KHCONV
+        ELSE
+          RCHC=RADCL*KHCONV
+          TSCLAD=MAX(273.15,(ZF(1)+RCHC*TCALO)/(ZF(2)+RCHC))
+          PHI=(ZF(1)-TSCLAD*ZF(2))/RADCL
+        ENDIF
+      ENDIF
+*----
+*  COMPUTE INITIAL BULK LIQUID ENTHALPY SUBCOOLING DHSUB
+*----
+      IF((ISUBM.GT.0).AND.(K0.EQ.0).AND.LFIRST) THEN
+        DTSUB=0.0
+        IF(ISUBM.EQ.1) THEN
+*         Bowring correlation
+*         Reference: R. W. Bowring, "Physical Model, Based on Bubble
+*         Detachment, and Calculation of Steam Voidage in the Subcooled
+*         Region of a Heated Channel," OECD Report HPR-10, 1962.
+*         Equation3 (3) and (17)
+          VC=MFLOW/RHOL
+          ETA=14.0+0.1*PINLET/1.01325E+05
+          DTSUB=ETA*PHI/VC*1.0E-6
+         ELSE IF(ISUBM.EQ.2) THEN
+*         Saha-Zuber subcooling model
+*         PE: Peclet number
+          PE=MFLOW*CPL*HD/ZKL
+          IF(PE.LE.70000.0) THEN
+            DTSUB=PHI*HD/(455.0*ZKL)
+          ELSE
+*           reactor conditions
+            DTSUB=154.0*PHI/(MFLOW*CPL)
+          ENDIF
+        ENDIF
+        IF(TCALO.GE.TSAT-DTSUB) K0=K
+        DSAT=TSCLAD-TCALO-DTSUB
+        DHSUB=CPL*DTSUB
+        LFIRST=.FALSE.
+      ENDIF
+      RETURN
+      END
diff --git a/Donjon/src/THMINP.f b/Donjon/src/THMINP.f
new file mode 100644
index 0000000..19c38c5
--- /dev/null
+++ b/Donjon/src/THMINP.f
@@ -0,0 +1,64 @@
+*DECK THMINP
+      SUBROUTINE THMINP(HNAME,NCH,VECT)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Read channel-dependent data.
+*
+*Copyright:
+* Copyright (C) 2018 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* HNAME   character*8 name of the data
+* NCH     number of channels
+*
+*Parameters: output
+* VECT    data vector
+*
+*-----------------------------------------------------------------------
+*
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      CHARACTER*(*) HNAME
+      INTEGER NCH
+      REAL VECT(NCH)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER ITYP,NITMA,ICH
+      REAL FLOT
+      CHARACTER TEXT*8,HSMG*131
+      DOUBLE PRECISION DFLOT
+*
+      CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.EQ.1) THEN
+        FLOT=REAL(NITMA)
+        VECT(:NCH)=FLOT
+      ELSE IF(ITYP.EQ.2) THEN
+        VECT(:NCH)=FLOT
+      ELSE IF((ITYP.EQ.3).AND.(TEXT.EQ.'CHAN')) THEN
+        DO ICH=1,NCH
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+          IF(ITYP.EQ.1) THEN
+            VECT(ICH)=REAL(NITMA)
+          ELSE IF(ITYP.EQ.2) THEN
+            VECT(ICH)=FLOT
+          ELSE
+             WRITE(HSMG,'(14H@THMINP: NAME=,A,21H. INTEGER OR REAL VAL,
+     >       12HUE EXPECTED.)') HNAME
+             CALL XABORT(HSMG)
+          ENDIF
+        ENDDO
+      ELSE
+        WRITE(HSMG,'(14H@THMINP: NAME=,A,26H. SINGLE INTEGER OR REAL V,
+     >  30HALUE OR CHAN KEYWORD EXPECTED.)') HNAME
+        CALL XABORT(HSMG)
+      ENDIF
+      RETURN
+      END
diff --git a/Donjon/src/THMPH.f b/Donjon/src/THMPH.f
new file mode 100644
index 0000000..487262e
--- /dev/null
+++ b/Donjon/src/THMPH.f
@@ -0,0 +1,100 @@
+*DECK THMPH
+      SUBROUTINE THMPH(IFLUID,PP,HH,RHO,TEMP)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Backwards inversion of steam tables to find water density and
+* temperature.
+*
+*Copyright:
+* Copyright (C) 2012 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* A. Hebert, P. Gallet
+*
+*Parameters: input
+* IFLUID  type of fluid (0=H2O; 1=D2O).
+* PP      pressure (Pa)
+* HH      enthalpy (J/Kg)
+*
+*Parameters: output
+* RHO     water density (Kg/m^3)
+* TEMP    temperature (K)
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER IFLUID
+      REAL PP,HH,RHO,TEMP
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(DT=-0.01,ZKELV=273.15,S=1.0)
+      REAL A(15),R1,R3,R4,R5,RV,HSAT,HV,XTH
+      DATA A/
+     > 0.2873E+03,-0.5098E+00,-0.3459E+00,0.1910E+00,-0.2840E-01,
+     > 0.8266E+02,0.1141E+01,-0.2724E+01,0.1077E+00,-0.1144E+02,
+     > 0.9500E+01,-0.2715E+01,-0.1290E+02,0.9148E+01,-0.8093E+01 /
+*----
+*  INITIAL APPROXIMATION OF T1
+*----
+      IF(IFLUID.EQ.0) THEN
+         CALL THMSAT(PP,TSAT)
+         CALL THMTX(TSAT,1.0,RV,HV,R3,R4,R5)
+         CALL THMTX(TSAT,0.0,R1,HSAT,R3,R4,R5)
+      ELSE IF(IFLUID.EQ.1) THEN
+         CALL THMHST(PP,TSAT)
+         CALL THMHTX(TSAT,1.0,RV,HV,R3,R4,R5)
+         CALL THMHTX(TSAT,0.0,R1,HSAT,R3,R4,R5)
+      ENDIF
+      IF((ABS(HSAT-HH)/HSAT).LE.1.0E-5) THEN
+         T1=TSAT
+         GO TO 20
+      ELSEIF(HH.LE.HSAT) THEN
+         T=(HH-1270.0E3)/420.0E3
+         P=(PP-140.0E5)/30.0E5
+         H1=A(1)+P*(A(2)+P*(A(3)+P*(A(4)+P*A(5))))
+         H2=A(6)+P*(A(7)+P*(A(8)+P*(A(9))))
+         H3=A(10)+P*(A(11)+P*(A(12)))
+         H4=A(13)+P*A(14)
+         H5=A(15)
+         T1=H1+T*(H2+T*(H3+T*(H4+T*(H5))))+ZKELV
+* INLET TEMPERATURE WAS VERIFIED TO BE GREATER THAN 0 C. T1 INITIAL
+* GUESS LOWER THAN THAT SHOULD BE INTERPRETED AS FLAWED (FAR FROM
+* FITTING REGION). CORRECTING WITH AN ABOVE-0 C GUESS.
+         IF(T1.LT.ZKELV) T1=10.0+ZKELV
+      ELSEIF(HH.LE.HV) THEN
+*        saturated steam
+         TEMP=TSAT
+         XTH=(HH-HSAT)/(HV-HSAT)
+         RHO=1.0/(XTH/RV+(1.0-XTH)/R1)
+         GO TO 30
+      ELSE
+*        superheated steam
+         T1=TSAT
+      ENDIF
+*----
+*  NEWTON ITERATIONS
+*----
+      ITER=0
+   10 ITER=ITER+1
+      IF(ITER.GT.30) CALL XABORT('THMPH: CONVERGENCE FAILURE.')
+      IF(IFLUID.EQ.0) THEN
+         CALL THMPT(PP,T1,R1,H1,R3,R4,R5)
+         CALL THMPT(PP,T1+DT,R1,H1P,R3,R4,R5)
+      ELSE IF(IFLUID.EQ.1) THEN
+         CALL THMHPT(PP,T1,R1,H1,R3,R4,R5)
+         CALL THMHPT(PP,T1+DT,R1,H1P,R3,R4,R5)
+      ENDIF
+      IF(ABS((HH-H1)/HH).LT.1.E-05) GO TO 20
+      T1=T1+(HH-H1)*DT/(H1P-H1)
+      IF((HH.LE.HSAT).AND.(T1.GE.TSAT)) T1=TSAT
+      IF((HH.GE.HV).AND.(T1.LE.TSAT)) T1=TSAT
+      GO TO 10
+   20 RHO=R1
+      TEMP=T1
+   30 RETURN
+      END
diff --git a/Donjon/src/THMPLO.f b/Donjon/src/THMPLO.f
new file mode 100644
index 0000000..236c6ec
--- /dev/null
+++ b/Donjon/src/THMPLO.f
@@ -0,0 +1,56 @@
+*DECK THMPLO
+      SUBROUTINE THMPLO(P,X,PHIL0)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute the value of the corrective factor for two phase calculation
+* of frictional pressure loss based on an homogeneous flow correlation
+*
+*Copyright:
+* Copyright (C) 2014 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* P. Gallet
+* C. Huet
+* 02/2025: C. Huet - Preparation to future models
+* 08/2025: M. Bellier - Implmentation of Lockhart-Martinelli correlation
+*
+*Parameters: input
+* P       pressure (Pa)
+* X       steam quality   
+*
+*Parameters: output
+* PHIL0   corrective factor for two phase pressure loss calculation
+*
+*-----------------------------------------------------------------------
+*
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      REAL P,X,PHIL0
+*----
+*  LOCAL VARIABLES
+*----
+      REAL TSAT,MUL,MUG,TG,TL,R1,R2,R3, RHOL,RHOG,XLM
+*----
+*  COMPUTE VALUE OF THE CORRECTIVE FACTOR USING DENSITIES AND
+*  VISCOSITIES OF BOTH SATURATED WATER AND DRY SATURATED STEAM
+*----
+*     compute the values of the thermodynamic parameters of steam and
+*     liquid phases using freesteam steam tables
+      CALL THMSAT(P,TSAT)
+      TG=TSAT+0.01
+      TL=TSAT-0.01
+      CALL THMPT(P,TL,RHOL,R1,R2,MUL,R3)
+      CALL THMPT(P,TG,RHOG,R1,R2,MUG,R3)
+*- CORRELATION = ? 
+*     PHIL0=(1+X*(RHOL/RHOG-1))/((1+X*(MUL/MUG-1))**0.25)
+*- 
+* - LOCKHART-MARTINELLI CORRELATION
+      XLM = ((1-X)/X)**0.9*(RHOG/RHOL)**0.5*(MUG/MUL)**0.1
+      PHIL0 = (1.0 + 20/XLM + 1.0/XLM**2)**0.5
+
+      RETURN
+      END
\ No newline at end of file
diff --git a/Donjon/src/THMPV.f90 b/Donjon/src/THMPV.f90
new file mode 100644
index 0000000..97d0382
--- /dev/null
+++ b/Donjon/src/THMPV.f90
@@ -0,0 +1,203 @@
+SUBROUTINE THMPV(SPEED, POULET, VCOOL, DCOOL, PCOOL, TCOOL, MUT, XFL, HD, NZ, HZ, EPS, RHOL, RHOG, VGJ, IDFM, ACOOL)
+!
+!-----------------------------------------------------------------------
+!
+!Purpose:
+! Update the pressure and velocity vectors in the THM model to model the
+! pressure drop and the velocity of the fluid in the channel
+!
+!Copyright:
+! Copyright (C) 2025 Ecole Polytechnique de Montreal
+!
+!Author(s): C. Huet
+! 02/2025: C. Huet - Creation
+!
+!Parameters: input
+! SPEED   inlet velocity of the fluid in the channel
+! POULET  Pressure at the outlet
+! VCOOL   velocity of the fluid in the channel
+! DCOOL   density of the fluid in the channel
+! PCOOL   pressure of the fluid in the channel
+! TCOOL   temperature of the fluid in the channel
+! MUT     dynamic viscosity of the fluid in the channel
+! XFL     quality of the fluid in the channel
+! HD      hydraulic diameter of the channel
+! NZ      number of nodes in the channel
+! HZ      height of the channel
+! EPS     coolant void fraction in the channel
+! RHOL    density of the liquid fraction
+! RHOG    density of the vapour fraction
+! VGJ     drift velocity in the channel
+! IDFM    flag for the use of the drift flux model
+! ACOOL   cross-sectional area of the channel
+!
+!Parameters: output
+! VCOOL   velocity of the fluid in the channel
+! PCOOL   pressure of the fluid in the channel
+!
+!-----------------------------------------------------------------------
+!
+    USE GANLIB
+    IMPLICIT NONE
+!----
+!   SUBROUTINE ARGUMENTS
+!----
+    INTEGER NZ, IDFM
+    REAL SPEED, POULET, VCOOL(NZ), DCOOL(NZ), PCOOL(NZ), TCOOL(NZ), MUT(NZ), XFL(NZ)
+    REAL HZ(NZ),VGJ(NZ),RHOL(NZ), RHOG(NZ), EPS(NZ), HD(NZ), ACOOL(NZ) 
+!----
+!   LOCAL VARIABLES
+!----
+    REAL g
+    REAL(kind=8), ALLOCATABLE, DIMENSION(:,:) :: A
+
+    INTEGER K, I, J, IER
+    REAL PHIL0, TPMULT, TPMULT0
+    REAL REY, REY0, FRIC,FRIC0,DELTA, UL
+    REAL CP11, H11, K11, RHO11, MUL
+
+    g = 9.81 !gravity
+    ALLOCATE(A(2*NZ,2*NZ+1))
+    FORALL (I=1:2*NZ, J=1:2*NZ+1) A(I, J) = 0.0
+
+!----
+!   MATRIX FILLING FOR THE PRESSURE AND VELOCITY CALCULATION
+!----
+!   BOTTOM OF THE CHANNEL
+!----
+    PRINT *, 'THMPV: Filling the matrix for pressure and velocity calculation'
+    PRINT *, 'THMPV: NZ = ', NZ
+    PRINT *, 'POULET = ', POULET
+    DO K = 1, NZ 
+        IF (K .EQ. 1) THEN
+            IF(IDFM.GT.0) THEN
+    !       COMPUTE MUL, UL and Reynolds AT K
+                CALL THMTX(TCOOL(K), 0.0, RHO11, H11, K11, MUL, CP11)
+                UL = VCOOL(K) - (EPS(K) / (1.0 - EPS(K)))*RHOG(K)/DCOOL(K) * VGJ(K)
+                REY0 = ABS(UL*RHOL(K)) * HD(K) / MUL
+    !       COMPUTE MUL, UL and Reynolds AT K+1
+                CALL THMTX(TCOOL(K+1), 0.0, RHO11, H11, K11, MUL, CP11)
+                UL = VCOOL(K+1) - (EPS(K+1) / (1.0 - EPS(K+1)))*RHOG(K+1)/DCOOL(K+1) * VGJ(K+1)
+                REY = ABS(UL*RHOL(K+1)) * HD(K+1) / MUL
+            ELSE 
+                REY = ABS(VCOOL(K+1)*DCOOL(K+1)) * (1.0 - XFL(K+1)) * HD(K+1) / MUT(K+1)
+                REY0 = ABS(VCOOL(K)*DCOOL(K)) * (1.0 - XFL(K)) * HD(K) / MUT(K)
+            ENDIF
+            
+            
+            CALL THMFRI(REY,EPS(K+1),HD(K+1),FRIC)!MUT à isoler vapeur/liquide : passer par THMTX(TCOOL, X=0)
+            CALL THMFRI(REY0,EPS(K),HD(K),FRIC0)
+
+            IF (XFL(K) .GT. 0.0) THEN
+                CALL THMPLO(PCOOL(K), XFL(K), PHIL0)
+                TPMULT0 = PHIL0
+                CALL THMPLO(PCOOL(K+1), XFL(K+1), PHIL0)
+                TPMULT = PHIL0
+            ELSE
+                TPMULT = 1.0
+                TPMULT0 = 1.0
+            ENDIF
+            A(1,1) = 1.0
+!   MOMENTUM CONSERVATION EQUATION
+            IF (IDFM .GT. 0) THEN
+                DELTA = ((EPS(K)/1-EPS(K))*RHOL(K)*RHOG(K)/DCOOL(K)*VGJ(K)**2) - &
+            ((EPS(K+1)/1-EPS(K+1))*RHOL(K+1)*RHOG(K+1)/DCOOL(K+1)*VGJ(K+1)* &
+            ACOOL(K+1)/ACOOL(K)**2)
+            ELSE
+                DELTA = 0.0
+            ENDIF
+            A(K+NZ,K) = - (VCOOL(K)*DCOOL(K))*(1.0 - (TPMULT0*FRIC0*HZ(K))/(2.0*HD(K)))
+            A(K+NZ,K+1) = (VCOOL(K+1)*DCOOL(K+1))*(1.0 + (TPMULT*FRIC*HZ(K))/ &
+             (2.0*HD(K+1)))*ACOOL(K+1)/ACOOL(K)
+            A(K+NZ, 2*NZ+1) =  - ((DCOOL(K+1)* HZ(K+1)*ACOOL(K+1)/ACOOL(K) + DCOOL(K)* HZ(K)) &
+               * g ) /2 + DELTA
+            A(K+NZ,K-1+NZ) = 0.0
+            A(K+NZ,K+NZ) = -1.0
+            A(K+NZ,K+1+NZ) = ACOOL(K+1)/ACOOL(K)
+
+!    MASS CONSERVATION EQUATION
+            A(1, 2*NZ+1) = SPEED
+
+!----
+!   TOP OF THE CHANNEL
+!----
+        ELSE IF (K .EQ. NZ) THEN
+!   MASS CONSERVATION EQUATION
+            A(K,K-1) = - DCOOL(K-1)*ACOOL(K-1)/ACOOL(K)
+            A(K,K) = DCOOL(K)
+!   MOMENTUM CONSERVATION EQUATION
+            A(K, 2*NZ+1) = 0.0
+            A(2*NZ, 2*NZ+1) = POULET
+            A(2*NZ, 2*NZ) = 1.0
+!----
+!   MIDDLE OF THE CHANNEL
+!----
+        ELSE
+            IF (IDFM.GT.0) THEN
+!       COMPUTE MUL, UL and Reynolds AT K
+                CALL THMTX(TCOOL(K), 0.0, RHO11, H11, K11, MUL, CP11)
+                UL = VCOOL(K) - (EPS(K) / (1.0 - EPS(K)))*RHOG(K)/DCOOL(K) * VGJ(K)
+                REY0 = ABS(UL*RHOL(K)) * HD(K) / MUL
+!       COMPUTE MUL, UL and Reynolds AT K+1
+                CALL THMTX(TCOOL(K+1), 0.0, RHO11, H11, K11, MUL, CP11)
+                UL = VCOOL(K+1) - (EPS(K+1) / (1.0 - EPS(K+1)))*RHOG(K+1)/DCOOL(K+1) * VGJ(K+1)
+                REY = ABS(UL*RHOL(K+1)) * HD(K+1) / MUL
+            ELSE
+                REY = ABS(VCOOL(K+1)*DCOOL(K+1)) * (1.0 - XFL(K+1)) * HD(K+1) / MUT(K+1)
+                REY0 = ABS(VCOOL(K)*DCOOL(K)) * (1.0 - XFL(K)) * HD(K) / MUT(K)
+            ENDIF        
+            CALL THMFRI(REY,EPS(K+1),HD(K+1),FRIC)
+            CALL THMFRI(REY0,EPS(K),HD(K),FRIC0)
+
+            IF (XFL(K) .GT. 0.0) THEN
+                CALL THMPLO(PCOOL(K+1), XFL(K+1), PHIL0)
+                TPMULT = PHIL0
+                CALL THMPLO(PCOOL(K), XFL(K), PHIL0)
+                TPMULT0 = PHIL0
+            ELSE
+                TPMULT = 1.0
+                TPMULT0 = 1.0
+            ENDIF
+!   MASS CONSERVATION EQUATION
+            A(K,K-1) = - DCOOL(K-1)*ACOOL(K-1)/ACOOL(K)
+            A(K,K) = DCOOL(K)
+            A(K,K+1) = 0.0
+            A(K, 2*NZ+1) = 0.0 
+!----
+!   MOMENTUM CONSERVATION EQUATION  
+!----
+            IF (IDFM .GT. 0) THEN
+                DELTA = ((EPS(K)/1-EPS(K))*RHOL(K)*RHOG(K)/DCOOL(K)*VGJ(K)**2) - &
+            ((EPS(K+1)/1-EPS(K+1))*RHOL(K+1)*RHOG(K+1)/DCOOL(K+1)*VGJ(K+1)**2*ACOOL(K+1) &
+            /ACOOL(K))
+            ELSE
+                DELTA = 0.0
+            ENDIF
+            A(K+NZ,K) = - (VCOOL(K)*DCOOL(K))*(1.0 - (TPMULT0*FRIC0*HZ(K))/(2.0*HD(K)))
+            A(K+NZ,K+1) = (VCOOL(K+1)*DCOOL(K+1))*(1.0 + (TPMULT*FRIC*HZ(K))/ &
+             (2.0*HD(K+1)))*ACOOL(K+1)/ACOOL(K)
+            A(K+NZ, 2*NZ+1) =  - ((DCOOL(K+1)* HZ(K+1)*ACOOL(K+1)/ACOOL(K) + DCOOL(K)* &
+             HZ(K)) * g ) /2 + DELTA
+            A(K+NZ,K-1+NZ) = 0.0
+            A(K+NZ,K+NZ) = -1.0
+            A(K+NZ,K+1+NZ) = ACOOL(K+1)/ACOOL(K)
+        ENDIF
+    END DO
+!----
+!   SOLVING THE LINEAR SYSTEM
+!----
+    call ALSBD(2*NZ, 1, A, IER, 2*NZ)
+
+    if (IER /= 0) CALL XABORT('THMPV: SINGULAR MATRIX.')
+!----
+!   RECOVER THE PRESSURE AND VELOCITY VECTORS
+!----
+    DO K = 1, NZ
+        VCOOL(K) = REAL(A(K, 2*NZ+1))
+        PCOOL(K) = REAL(A(K+NZ, 2*NZ+1))
+    END DO
+
+    DEALLOCATE(A)
+    
+    RETURN
+    END
\ No newline at end of file
diff --git a/Donjon/src/THMRNG.f b/Donjon/src/THMRNG.f
new file mode 100644
index 0000000..fa8ed5b
--- /dev/null
+++ b/Donjon/src/THMRNG.f
@@ -0,0 +1,278 @@
+*DECK THMRNG
+      SUBROUTINE THMRNG(IMPX,NFD,NDTOT,MAXIT1,MAXIT2,ERMAXT,DTINV,
+     1 RAD,XX0,XX1,QFUEL,FRO,TSURF,BURN,POROS,FRACPU,ICONDF,
+     2 NCONDF,KCONDF,UCONDF,ICONDC,NCONDC,KCONDC,UCONDC,
+     3 IFRCDI,IFUEL,FTP,TC1,XX2,XX3,ZF)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Solution of the discretized thermal conduction equations in a single
+* fuel rod in an axial slice of the fuel channel. Version without gap
+*
+*Copyright:
+* Copyright (C) 2024 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* C. Garrido based on THMROD by A. Hebert
+*
+*Parameters: input
+* IMPX    print parameter.
+* NFD     number of fuel discretized points in the cladded fuel rod.
+*         The last point of the discretization (i=NFD) is taken at the
+*         surface of the fuel pellet.
+* NDTOT   total number of discretized points in the cladded fuel rod
+*         with the radial zones in the cladding. The points which are
+*         located at i=NFD+1 and i=NDTOT are respectively taken at the
+*         inner surface of clad and in the center of external clad ring.
+* MAXIT1  maximum number of conduction iterations.
+* MAXIT2  maximum number of center-pellet iterations.
+* ERMAXT  convergence criterion.
+* DTINV   inverse time step. Equal to 1/DT in transient cases. Equal to
+*         0 in steady-state cases.
+* RAD     fuel and clad radii (m).
+* XX0     temperatures at time n-1 (K).
+* XX1     estimate of the temperatures at time n (K).
+* QFUEL   volumic power in fuel at time n (W/m^3).
+* FRO     radial power form factors. All components are set to 1.0 for
+*         a constant power source in fuel.
+* TSURF   estimate of the external clad surface temperature at
+*         time n (K).
+* BURN    fuel burnup in MWday/tonne.
+* POROS   fuel porosity.
+* FRACPU  plutonium percent fraction.
+* ICONDF  fuel conductivity flag (0=Stora-Chenebault or COMETHE/
+*         1=user-provided polynomial + inverse term).
+* NCONDF  degree of user-provided fuel conductivity polynomial.
+* KCONDF  polynomial coefficients for fuel conductivity in W/m/K^(k+1)
+*         (except for the two last coefficients which belongs to the
+*         inverse term).
+* UCONDF  required unit of temperature in polynomial for fuel
+*         conductivity (KELVIN or CELSIUS).
+* ICONDC  clad conductivity flag (0=default/1=user-provided
+*         polynomial).
+* NCONDC  degree of user-provided clad conductivity polynomial.
+* KCONDC  polynomial coefficients for clad conductivity in W/m/K^(k+1).
+* UCONDC  required unit of temperature in polynomial for clad
+*         conductivity (KELVIN or CELSIUS).
+* IFRCDI  flag indicating if average approximation is forced during
+*         fuel conductivity evaluation (0=default/1=average
+*         approximation forced).
+* IFUEL   type of fuel (0=UO2/MOX; 1=SALT).
+* FTP     tpdata object with correlations to obtain properties of 
+*         molten salt.
+*
+*Parameters: output
+* TC1     estimate of center-pellet temperature at time n (K).
+* XX1     estimate of the temperatures at time n (K).
+* XX2     first component of temperatures at time n (K).
+* XX3     second component of temperatures at time n. The actual
+*         temperatures are given as XX2(:)+TSURF*XX3(:) where TSURF
+*         is the temperature of the external clad surface.
+* ZF      components of the linear power transmitted from clad to fluid.
+*         The linear power (W/m) is given as 2*PI*(ZF(1)-TSURF*ZF(2)).
+*
+*-----------------------------------------------------------------------
+      USE t_saltdata
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(tpdata) FTP
+      INTEGER IMPX,NFD,NDTOT,MAXIT1,MAXIT2,ICONDF,NCONDF,ICONDC,NCONDC,
+     1 IFRCDI,IFUEL
+      REAL ERMAXT,DTINV,RAD(NDTOT),XX0(NDTOT),XX1(NDTOT),QFUEL,
+     1 FRO(NFD-1),TSURF,BURN,POROS,FRACPU,KCONDF(NCONDF+3),
+     2 KCONDC(NCONDC+1),TC1,XX2(NDTOT),XX3(NDTOT),ZF(2)
+      CHARACTER UCONDF*12,UCONDC*12
+*----
+*  LOCAL VARIABLES
+*----
+      REAL COEF(3)
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      REAL, ALLOCATABLE, DIMENSION(:) :: DAR,ZK,CONDXA
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: TRID
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(DAR(NDTOT),ZK(NDTOT),CONDXA(NDTOT),TRID(NDTOT,NDTOT+2))
+*----
+*  COMPUTE ARs AND VOLUMES
+*----
+      DAR(:NDTOT)=0.0
+      ARF=0.5*RAD(NFD)**2    ! at fuel radius/clad interface
+      ARCE=0.5*RAD(NDTOT)**2 ! at external clad radius
+      DO I=1,NFD
+        DAR(I)=0.5*(RAD(I+1)**2-RAD(I)**2)
+      ENDDO
+      DO I=NFD+1,NDTOT
+        DAR(I)=0.5*(RAD(I)**2-RAD(I-1)**2)
+      ENDDO
+*----
+*  COMPUTE THE THERMAL CONDUCTIVITY INTEGRALS AT TIME n-1
+*----
+      ZK(:NDTOT)=0.0
+      DO I=1,NFD
+        IF(IFUEL.EQ.0) THEN
+          ZK(I)=THMCDI(XX0(I),XX0(I+1),BURN,POROS,FRACPU,ICONDF,NCONDF,
+     >    KCONDF,UCONDF,IFRCDI)
+        ELSE
+          ZK(I)=THMSDI(XX0(I),XX0(I+1),FTP,IFRCDI,IMPX)
+        ENDIF
+      ENDDO
+      DO I=NFD+1,NDTOT-1
+        ZK(I)=THMGDI(XX0(I),XX0(I+1),ICONDC,NCONDC,KCONDC,UCONDC)
+      ENDDO
+      ZK(NDTOT)=THMGDI(XX0(NDTOT),TSURF,ICONDC,NCONDC,KCONDC,UCONDC)
+*----
+*  COMPUTE CONDXA
+*----
+      CONDXA(:NDTOT)=0.0
+      COEF(1)=0.0
+      COEF(2)=0.0
+      COEF(3)=0.0
+      DO I=1,NDTOT
+        IF(I.LE.NFD) THEN
+          IF(IFUEL.EQ.0) THEN
+            CONDXA(I)=THMCCD(XX0(I),POROS,FRACPU)*DTINV*XX0(I)*DAR(I)
+          ELSE 
+            CONDXA(I)=THMSCD(XX0(I),FTP,IMPX)*DTINV*XX0(I)*DAR(I)
+          ENDIF
+        ELSE IF(I.GE.NFD+1) THEN
+          CONDXA(I)=THMGCD(XX0(I))*DTINV*XX0(I)*DAR(I)
+        ENDIF
+      ENDDO
+*----
+*  ITERATIVE PROCEDURE
+*----
+      ITERT=0
+   10 ITERT=ITERT+1
+      IF(ITERT.GT.MAXIT1) CALL XABORT('THMRNG: CONVERGENCE FAILURE(1).')
+*----
+*  COMPUTE THE THERMAL CONDUCTIVITY INTEGRALS AT TIME n
+*----
+      ZK(:NDTOT)=0.0
+      DO I=1,NFD
+        IF(IFUEL.EQ.0) THEN
+          ZK(I)=THMCDI(XX1(I),XX1(I+1),BURN,POROS,FRACPU,ICONDF,NCONDF,
+     >    KCONDF,UCONDF,IFRCDI)
+        ELSE 
+          ZK(I)=THMSDI(XX1(I),XX1(I+1),FTP,IFRCDI,IMPX)
+        ENDIF
+      ENDDO
+      DO I=NFD+1,NDTOT-1
+        ZK(I)=THMGDI(XX1(I),XX1(I+1),ICONDC,NCONDC,KCONDC,UCONDC)
+      ENDDO
+      ZK(NDTOT)=THMGDI(XX1(NDTOT),TSURF,ICONDC,NCONDC,KCONDC,UCONDC)
+*----
+*  BUILD THE TRIDIAGONAL SYSTEM
+*----
+      TRID(:NDTOT,:NDTOT+2)=0.0
+      COEF(1)=0.0
+      COEF(2)=0.0
+      COEF(3)=0.0
+      DO I=1,NDTOT
+        TRID(I,NDTOT+1)=CONDXA(I)
+        IF(I.LE.NFD-2) THEN
+          ARI=0.5*RAD(I+1)**2
+          COEF(3)=4.0*ARI*ZK(I)/(DAR(I)+DAR(I+1))
+          TRID(I,NDTOT+1)=TRID(I,NDTOT+1)+QFUEL*FRO(I)*DAR(I)
+        ELSE IF(I.EQ.NFD-1) THEN
+          ARI=0.5*RAD(I+1)**2
+          COEF(3)=4.0*ARI*ZK(I)/(DAR(I)+DAR(I+1))
+          TRID(I,NDTOT+1)=TRID(I,NDTOT+1)+QFUEL*FRO(I)*DAR(I)
+        ELSE IF(I.EQ.NFD) THEN
+          ARI=0.5*RAD(I+1)**2
+          COEF(3)=4.0*ARI*ZK(I)/DAR(I)
+          TRID(I,NDTOT+1)=TRID(I,NDTOT+1)+QFUEL*FRO(NFD-1)*DAR(I)
+        ELSE IF(I.LE.NDTOT-1) THEN
+          ARI=0.5*RAD(I)**2
+          COEF(3)=4.0*ARI*ZK(I)/(DAR(I)+DAR(I+1))
+        ELSE IF(I.EQ.NDTOT) THEN
+          COEF(3)=4.0*ARCE*ZK(I)/DAR(I)
+          TRID(I,NDTOT+2)=TRID(I,NDTOT+2)+COEF(3)
+        ENDIF
+        COEF(2)=COEF(1)+COEF(3)
+        IF(I.GT.1) TRID(I,I-1)=-COEF(1)
+        IF(I.LE.NFD) THEN
+          IF(IFUEL.EQ.0) THEN
+            TRID(I,I)=THMCCD(XX1(I),POROS,FRACPU)*DTINV*DAR(I)
+          ELSE 
+            TRID(I,I)=THMSCD(XX1(I),FTP,IMPX)*DTINV*DAR(I)
+          ENDIF
+        ELSE IF(I.GE.NFD+1) THEN
+          TRID(I,I)=THMGCD(XX1(I))*DTINV*DAR(I)
+        ENDIF
+        TRID(I,I)=TRID(I,I)+COEF(2)
+        IF(I.LT.NDTOT) THEN
+          TRID(I,I+1)=-COEF(3)
+          COEF(1)=COEF(3)
+        ENDIF
+      ENDDO
+      ZWORK=COEF(3)
+*----
+*  SOLVE LINEAR SYSTEM
+*----
+      CALL ALSB(NDTOT,2,TRID,IER,NDTOT)
+      IF(IER.NE.0) CALL XABORT('THMRNG: SINGULAR MATRIX')
+*----
+*  SET TEMPERATURE AT TIME n
+*----
+      ERR=0.0
+      IMAX=0
+      DO I=1,NDTOT
+        TNEW=TRID(I,NDTOT+1)+TSURF*TRID(I,NDTOT+2)
+        IF(ABS(XX1(I)-TNEW).GT.ERR) THEN
+          ERR=ABS(XX1(I)-TNEW)
+          IMAX=I
+        ENDIF
+        IF(ITERT.LE.20) THEN
+          XX1(I)=TNEW
+        ELSE
+*         perform under-relaxation
+          XX1(I)=0.5*(TNEW+XX1(I))
+        ENDIF
+      ENDDO
+      ZF(1)=ZWORK*TRID(NDTOT,NDTOT+1)
+      ZF(2)=ZWORK*(1.0-TRID(NDTOT,NDTOT+2))
+      IF(IMPX.GT.4) WRITE(6,100) ITERT,ERR,ERMAXT,IMAX
+      IF((ERR.LT.ERMAXT).AND.(ITERT.NE.1)) GO TO 20
+      GO TO 10
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+   20 DO I=1,NDTOT
+        XX2(I)=TRID(I,NDTOT+1)
+        XX3(I)=TRID(I,NDTOT+2)
+      ENDDO
+      DEALLOCATE(TRID,CONDXA,ZK,DAR)
+*----
+*  COMPUTE THE CENTER-PELLET TEMPERATURE.
+*----
+      TC=0.5*(XX1(1)+XX1(2))
+      ITERC=0
+   30 ITERC=ITERC+1
+      IF(ITERC.GT.MAXIT2) CALL XABORT('THMRNG: CONVERGENCE FAILURE(2).')
+      TCOLD=TC
+      IF(IFUEL.EQ.0) THEN
+        CC1=THMCDI(XX1(1),TC,BURN,POROS,FRACPU,ICONDF,NCONDF,KCONDF,
+     >   UCONDF,IFRCDI)
+        CC2=THMCDI(TC,XX1(2),BURN,POROS,FRACPU,ICONDF,NCONDF,KCONDF,
+     >   UCONDF,IFRCDI)
+      ELSE 
+        CC1=THMSDI(XX1(1),TC,FTP,IFRCDI,IMPX)
+        CC2=THMSDI(TC,XX1(2),FTP,IFRCDI,IMPX)
+      ENDIF
+      TC=(CC1*XX1(1)+CC2*XX1(2))/(CC1+CC2)
+      IF(ITERT.GT.20) TC=0.5*(TC+TCOLD)
+      DELTAA=ABS(TC-TCOLD)
+      IF(IMPX.GT.4) WRITE(6,110) ITERC,DELTAA,ERMAXT
+      IF((DELTAA.LT.ERMAXT).AND.(ITERC.NE.1)) GO TO 40
+      GO TO 30
+   40 TC1=2.0*XX1(1)-TC
+      RETURN
+  100 FORMAT(/15H THMRNG: ITERT=,I5,1P,7H ERROR=,E12.4,5H EPS=,E12.4,
+     > 5H POS=,I5)
+  110 FORMAT(/15H THMRNG: ITERC=,I5,1P,7H ERROR=,E12.4,5H EPS=,E12.4)
+      END
diff --git a/Donjon/src/THMROD.f b/Donjon/src/THMROD.f
new file mode 100644
index 0000000..03b2e9d
--- /dev/null
+++ b/Donjon/src/THMROD.f
@@ -0,0 +1,263 @@
+*DECK THMROD
+      SUBROUTINE THMROD(IMPX,NFD,NDTOT,MAXIT1,MAXIT2,ERMAXT,DTINV,
+     1 RAD,XX0,XX1,QFUEL,FRO,TSURF,POWLIN,BURN,POROS,FRACPU,ICONDF,
+     2 NCONDF,KCONDF,UCONDF,ICONDC,NCONDC,KCONDC,UCONDC,IHGAP,KHGAP,
+     3 IFRCDI,TC1,XX2,XX3,ZF)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Solution of the discretized thermal conduction equations in a single
+* fuel rod in an axial slice of the fuel channel.
+*
+*Copyright:
+* Copyright (C) 2018 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IMPX    print parameter.
+* NFD     number of fuel discretized points in the cladded fuel rod.
+*         The last point of the discretization (i=NFD) is taken at the
+*         surface of the fuel pellet.
+* NDTOT   total number of discretized points in the cladded fuel rod
+*         with the radial zones in the cladding. The points which are
+*         located at i=NFD+1 and i=NDTOT are respectively taken at the
+*         inner surface of clad and in the center of external clad ring.
+* MAXIT1  maximum number of conduction iterations.
+* MAXIT2  maximum number of center-pellet iterations.
+* ERMAXT  convergence criterion.
+* DTINV   inverse time step. Equal to 1/DT in transient cases. Equal to
+*         0 in steady-state cases.
+* RAD     fuel and clad radii (m).
+* XX0     temperatures at time n-1 (K).
+* XX1     estimate of the temperatures at time n (K).
+* QFUEL   volumic power in fuel at time n (W/m^3).
+* FRO     radial power form factors. All components are set to 1.0 for
+*         a constant power source in fuel.
+* TSURF   estimate of the external clad surface temperature at
+*         time n (K).
+* POWLIN  estimate of the linear power at time n (W/m).
+* BURN    fuel burnup in MWday/tonne.
+* POROS   fuel porosity.
+* FRACPU  plutonium percent fraction.
+* ICONDF  fuel conductivity flag (0=Stora-Chenebault or COMETHE/
+*         1=user-provided polynomial + inverse term).
+* NCONDF  degree of user-provided fuel conductivity polynomial.
+* KCONDF  polynomial coefficients for fuel conductivity in W/m/K^(k+1)
+*         (except for the two last coefficients which belongs to the
+*         inverse term).
+* UCONDF  required unit of temperature in polynomial for fuel
+*         conductivity (KELVIN or CELSIUS).
+* ICONDC  clad conductivity flag (0=default/1=user-provided
+*         polynomial).
+* NCONDC  degree of user-provided clad conductivity polynomial.
+* KCONDC  polynomial coefficients for clad conductivity in W/m/K^(k+1).
+* UCONDC  required unit of temperature in polynomial for clad
+*         conductivity (KELVIN or CELSIUS).
+* IHGAP   flag indicating HGAP chosen (0=default/1=user-provided).
+* KHGAP   fixed user-provided HGAP value in W/m^2/K.
+* IFRCDI  flag indicating if average approximation is forced during
+*         fuel conductivity evaluation (0=default/1=average
+*         approximation forced).
+*
+*Parameters: output
+* TC1     estimate of center-pellet temperature at time n (K).
+* XX1     estimate of the temperatures at time n (K).
+* XX2     first component of temperatures at time n (K).
+* XX3     second component of temperatures at time n. The actual
+*         temperatures are given as XX2(:)+TSURF*XX3(:) where TSURF
+*         is the temperature of the external clad surface.
+* ZF      components of the linear power transmitted from clad to fluid.
+*         The linear power (W/m) is given as 2*PI*(ZF(1)-TSURF*ZF(2)).
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER IMPX,NFD,NDTOT,MAXIT1,MAXIT2,ICONDF,NCONDF,ICONDC,NCONDC,
+     1 IHGAP,IFRCDI
+      REAL ERMAXT,DTINV,RAD(NDTOT),XX0(NDTOT),XX1(NDTOT),QFUEL,
+     1 FRO(NFD-1),TSURF,POWLIN,BURN,POROS,FRACPU,KCONDF(NCONDF+3),
+     2 KCONDC(NCONDC+1),KHGAP,TC1,XX2(NDTOT),XX3(NDTOT),ZF(2)
+      CHARACTER UCONDF*12,UCONDC*12
+*----
+*  LOCAL VARIABLES
+*----
+      REAL COEF(3)
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      REAL, ALLOCATABLE, DIMENSION(:) :: DAR,ZK,CONDXA
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: TRID
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(DAR(NDTOT),ZK(NDTOT),CONDXA(NDTOT),TRID(NDTOT,NDTOT+2))
+*----
+*  COMPUTE ARs AND VOLUMES
+*----
+      DAR(:NDTOT)=0.0
+      ARF=0.5*RAD(NFD)**2    ! at fuel radius
+      ARCI=0.5*RAD(NFD+1)**2 ! at internal clad radius
+      ARCE=0.5*RAD(NDTOT)**2 ! at external clad radius
+      DO I=1,NFD-1
+        DAR(I)=0.5*(RAD(I+1)**2-RAD(I)**2)
+      ENDDO
+      DO I=NFD+2,NDTOT
+        DAR(I)=0.5*(RAD(I)**2-RAD(I-1)**2)
+      ENDDO
+*----
+*  COMPUTE THE THERMAL CONDUCTIVITY INTEGRALS AT TIME n-1
+*----
+      ZK(:NDTOT)=0.0
+      DO I=1,NFD-1
+        ZK(I)=THMCDI(XX0(I),XX0(I+1),BURN,POROS,FRACPU,ICONDF,NCONDF,
+     >  KCONDF,UCONDF,IFRCDI)
+      ENDDO
+      DO I=NFD+1,NDTOT-1
+        ZK(I)=THMGDI(XX0(I),XX0(I+1),ICONDC,NCONDC,KCONDC,UCONDC)
+      ENDDO
+      ZK(NDTOT)=THMGDI(XX0(NDTOT),TSURF,ICONDC,NCONDC,KCONDC,UCONDC)
+*----
+*  COMPUTE CONDXA
+*----
+      CONDXA(:NDTOT)=0.0
+      COEF(1)=0.0
+      COEF(2)=0.0
+      COEF(3)=0.0
+      DO I=1,NDTOT
+        IF(I.LE.NFD-1) THEN
+          CONDXA(I)=THMCCD(XX0(I),POROS,FRACPU)*DTINV*XX0(I)*DAR(I)
+        ELSE IF(I.GE.NFD+2) THEN
+          CONDXA(I)=THMGCD(XX0(I))*DTINV*XX0(I)*DAR(I)
+        ENDIF
+      ENDDO
+*----
+*  ITERATIVE PROCEDURE
+*----
+      ITERT=0
+   10 ITERT=ITERT+1
+      IF(ITERT.GT.MAXIT1) CALL XABORT('THMROD: CONVERGENCE FAILURE(1).')
+*----
+*  COMPUTE THE THERMAL CONDUCTIVITY INTEGRALS AT TIME n
+*----
+      ZK(:NDTOT)=0.0
+      DO I=1,NFD-1
+        ZK(I)=THMCDI(XX1(I),XX1(I+1),BURN,POROS,FRACPU,ICONDF,NCONDF,
+     >  KCONDF,UCONDF,IFRCDI)
+      ENDDO
+      DO I=NFD+1,NDTOT-1
+        ZK(I)=THMGDI(XX1(I),XX1(I+1),ICONDC,NCONDC,KCONDC,UCONDC)
+      ENDDO
+      ZK(NDTOT)=THMGDI(XX1(NDTOT),TSURF,ICONDC,NCONDC,KCONDC,UCONDC)
+      IF(IHGAP.EQ.0) THEN
+         CALL THMGAP(POWLIN,BURN,HGAP)
+      ELSE IF(IHGAP.EQ.1) THEN
+         HGAP=KHGAP
+      ENDIF
+*----
+*  BUILD THE TRIDIAGONAL SYSTEM
+*----
+      TRID(:NDTOT,:NDTOT+2)=0.0
+      COEF(1)=0.0
+      COEF(2)=0.0
+      COEF(3)=0.0
+      DO I=1,NDTOT
+        TRID(I,NDTOT+1)=CONDXA(I)
+        IF(I.LE.NFD-2) THEN
+          ARI=0.5*RAD(I+1)**2
+          COEF(3)=4.0*ARI*ZK(I)/(DAR(I)+DAR(I+1))
+          TRID(I,NDTOT+1)=TRID(I,NDTOT+1)+QFUEL*FRO(I)*DAR(I)
+        ELSE IF(I.EQ.NFD-1) THEN
+          ARI=0.5*RAD(I+1)**2
+          COEF(3)=4.0*ARI*ZK(I)/DAR(I)
+          TRID(I,NDTOT+1)=TRID(I,NDTOT+1)+QFUEL*FRO(I)*DAR(I)
+        ELSE IF(I.EQ.NFD) THEN
+          RAVG=2.0*RAD(NFD)*RAD(NFD+1)/(RAD(NFD)+RAD(NFD+1))
+          COEF(3)=RAVG*HGAP
+        ELSE IF(I.EQ.NFD+1) THEN
+          COEF(3)=4.0*ARCI*ZK(I)/DAR(I+1)
+        ELSE IF(I.LE.NDTOT-1) THEN
+          ARI=0.5*RAD(I)**2
+          COEF(3)=4.0*ARI*ZK(I)/(DAR(I)+DAR(I+1))
+        ELSE IF(I.EQ.NDTOT) THEN
+          COEF(3)=4.0*ARCE*ZK(I)/DAR(I)
+          TRID(I,NDTOT+2)=TRID(I,NDTOT+2)+COEF(3)
+        ENDIF
+        COEF(2)=COEF(1)+COEF(3)
+        IF(I.GT.1) TRID(I,I-1)=-COEF(1)
+        IF(I.LE.NFD-1) THEN
+          TRID(I,I)=THMCCD(XX1(I),POROS,FRACPU)*DTINV*DAR(I)
+        ELSE IF(I.GE.NFD+2) THEN
+          TRID(I,I)=THMGCD(XX1(I))*DTINV*DAR(I)
+        ENDIF
+        TRID(I,I)=TRID(I,I)+COEF(2)
+        IF(I.LT.NDTOT) THEN
+          TRID(I,I+1)=-COEF(3)
+          COEF(1)=COEF(3)
+        ENDIF
+      ENDDO
+      ZWORK=COEF(3)
+*----
+*  SOLVE LINEAR SYSTEM
+*----
+      CALL ALSB(NDTOT,2,TRID,IER,NDTOT)
+      IF(IER.NE.0) CALL XABORT('THMROD: SINGULAR MATRIX')
+*----
+*  SET TEMPERATURE AT TIME n
+*----
+      ERR=0.0
+      IMAX=0
+      DO I=1,NDTOT
+        TNEW=TRID(I,NDTOT+1)+TSURF*TRID(I,NDTOT+2)
+        IF(ABS(XX1(I)-TNEW).GT.ERR) THEN
+          ERR=ABS(XX1(I)-TNEW)
+          IMAX=I
+        ENDIF
+        IF(ITERT.LE.20) THEN
+          XX1(I)=TNEW
+        ELSE
+*         perform under-relaxation
+          XX1(I)=0.5*(TNEW+XX1(I))
+        ENDIF
+      ENDDO
+      ZF(1)=ZWORK*TRID(NDTOT,NDTOT+1)
+      ZF(2)=ZWORK*(1.0-TRID(NDTOT,NDTOT+2))
+      IF(IMPX.GT.4) WRITE(6,100) ITERT,ERR,ERMAXT,IMAX
+      IF((ERR.LT.ERMAXT).AND.(ITERT.NE.1)) GO TO 20
+      GO TO 10
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+   20 DO I=1,NDTOT
+        XX2(I)=TRID(I,NDTOT+1)
+        XX3(I)=TRID(I,NDTOT+2)
+      ENDDO
+      DEALLOCATE(TRID,CONDXA,ZK,DAR)
+*----
+*  COMPUTE THE CENTER-PELLET TEMPERATURE.
+*----
+      TC=0.5*(XX1(1)+XX1(2))
+      ITERC=0
+   30 ITERC=ITERC+1
+      IF(ITERC.GT.MAXIT2) CALL XABORT('THMROD: CONVERGENCE FAILURE(2).')
+      TCOLD=TC
+      CC1=THMCDI(XX1(1),TC,BURN,POROS,FRACPU,ICONDF,NCONDF,KCONDF,
+     > UCONDF,IFRCDI)
+      CC2=THMCDI(TC,XX1(2),BURN,POROS,FRACPU,ICONDF,NCONDF,KCONDF,
+     > UCONDF,IFRCDI)
+      TC=(CC1*XX1(1)+CC2*XX1(2))/(CC1+CC2)
+      IF(ITERT.GT.20) TC=0.5*(TC+TCOLD)
+      DELTAA=ABS(TC-TCOLD)
+      IF(IMPX.GT.4) WRITE(6,110) ITERC,DELTAA,ERMAXT
+      IF((DELTAA.LT.ERMAXT).AND.(ITERC.NE.1)) GO TO 40
+      GO TO 30
+   40 TC1=2.0*XX1(1)-TC
+      RETURN
+  100 FORMAT(/15H THMROD: ITERT=,I5,1P,7H ERROR=,E12.4,5H EPS=,E12.4,
+     > 5H POS=,I5)
+  110 FORMAT(/15H THMROD: ITERC=,I5,1P,7H ERROR=,E12.4,5H EPS=,E12.4)
+      END
diff --git a/Donjon/src/THMSAL.f b/Donjon/src/THMSAL.f
new file mode 100644
index 0000000..2121395
--- /dev/null
+++ b/Donjon/src/THMSAL.f
@@ -0,0 +1,198 @@
+*DECK THMSAL
+      SUBROUTINE THMSAL(IMPX,ITIME,I,J,K,K0,MFLOW,HMAVG,ENT,HD,STP,
+     > IHCONV,KHCONV,ISUBM,RADCL,ZF,PHI,XFL,EPS,SLIP,DZ,TCALO,
+     > RHO,RHOLAV,TSCLAD,KWA)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Adaptation of THMH2O.f for convection of Molten Salts using Gnielinski
+* correlation.
+*
+*Copyright:
+* Copyright (C) 2023 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* Cristian Garrido Tamm (cristian.garrido@idom.com)
+*
+*Parameters: input
+* IMPX    printing index (=0 for no print).
+* ITIME   type of calculation  (0=steady-state; 1=transient).
+* I       position of channel alon X-axis
+* J       position of channel alon Y-axis
+* K       position of channel alon Z-axis
+* K0      onser of nuclear boiling point
+* MFLOW   massic coolant flow rate in Kg/m^2/s
+* HMAVG   averaged enthalpy
+* ENT     four values of enthalpy in J/Kg to be used in Gaussian
+*         integration
+* HD      hydraulic diameter in m
+* STP     tpdata object with correlations to obtain properties of molten salt.
+* IHCONV  flag indicating HCONV chosen (0=default/1=user-provided).
+* KHCONV  fixed user-provided HCONV value in W/m^2/K.
+* ISUBM   subcooling model (0: one-phase; 1: Jens-Lottes model;
+*         2: Saha-Zuber model).
+* RADCL   outer clad radius in m
+* ZF      parameters used to compute heat flux on clad surface in
+*         transient cases.
+* PHI     heat flow exchanged between clad and fluid in W/m^2.
+*         Given in steady-state cases.
+* XFL     input coolant flow quality
+* EPS     input coolant void fraction
+* SLIP    input slip ratio of vapor phase speed to liquid phase speed.
+* DZ      axial mesh width in m.
+*
+*Parameters: output
+* PHI     heat flow exchanged between clad and fluid in W/m^2.
+*         Computed in transient cases.
+* XFL     output coolant flow quality
+* EPS     output coolant void fraction
+* SLIP    output slip ratio of vapor phase speed to liquid phase speed.
+* TCALO   coolant temperature in K
+* RHO     coolant density in Kg/m^3
+* RHOLAV  liquid density in kg/m^3
+* TSCLAD  clad temperature in K
+* KWA     flow regime (=0: single-phase; =1: subcooled; =2: nucleate
+*         boiling; =3 superheated steam)
+*
+*-----------------------------------------------------------------------
+*
+      USE t_saltdata
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(tpdata) STP
+      INTEGER I,J,K,K0,IHCONV,ISUBM,KWA
+      REAL MFLOW,HMAVG,ENT(4),HD,KHCONV,RADCL,ZF(2),PHI,TCALO,RHO,
+     > RHOLAV,TSCLAD,XFL,EPS,SLIP,DZ
+*----
+*  LOCAL VARIABLES
+*----
+      REAL W(4),HL(4)
+      CHARACTER HSMG*131
+*----
+*  SAVE VARIABLES
+*----
+      SAVE W
+      DATA W /0.347855,0.652145,0.652145,0.347855/
+*----
+*  COMPUTE THE DENSITY AND TEMPERATURE OF THE LIQUID
+*----
+      IF(HMAVG.LT.0.0) CALL XABORT('THMSAL: NEGATIVE INPUT ENTHALPY.')
+      IF(ISUBM.NE.0) CALL XABORT('THMSAL: NOT A ONE PHASE FLOW.')
+      CALL THMSST(STP,TSAT,IMPX)
+      HL(1)=ENT(1)
+      HL(2)=ENT(2)
+      HL(3)=ENT(3)
+      HL(4)=ENT(4)
+      CALL THMSH(STP,HL(1),R11,TL1,IMPX)
+      CALL THMSH(STP,HL(2),R11,TL2,IMPX)
+      CALL THMSH(STP,HL(3),R11,TL3,IMPX)
+      CALL THMSH(STP,HL(4),R11,TL4,IMPX)
+      CALL THMSPT(STP,TL1,RHO1,R2,R3,R4,CP1,IMPX)
+      CALL THMSPT(STP,TL2,RHO2,R2,R3,R4,CP2,IMPX)
+      CALL THMSPT(STP,TL3,RHO3,R2,R3,R4,CP3,IMPX)
+      CALL THMSPT(STP,TL4,RHO4,R2,R3,R4,CP4,IMPX)
+      TL=0.5*(W(1)*TL1+W(2)*TL2+W(3)*TL3+W(4)*TL4)
+      RHOLAV=0.5*(W(1)*RHO1+W(2)*RHO2+W(3)*RHO3+W(4)*RHO4)
+      CPLAV=0.5*(W(1)*CP1+W(2)*CP2+W(3)*CP3+W(4)*CP4)
+*----
+*  COMPUTE THE FLUID PROPERTIES
+*  RHO: fluid density
+*  REL: Reynolds number of liquid phase
+*  PRL: Prandtl number of liquid phase
+*----
+      IF(XFL.NE.0.0) THEN
+        CALL XABORT('THMSAL: INVALID VALUE OF FLOW QUALITY')
+      ENDIF
+*     One phase liquid
+      TB=TSAT
+      IF(TL.LT.TB) THEN
+        TCALO=TL
+      ELSE
+        TCALO=TB
+      ENDIF
+      CALL THMSPT(STP,TCALO,R1,R2,ZKONE,ZMUONE,CPONE,IMPX)
+      RHO=RHOLAV
+      REL=MFLOW*HD/ZMUONE
+      PRL=ZMUONE*CPONE/ZKONE
+      ZKL=ZKONE
+      XFL0=XFL
+      EPS0=EPS
+      SLIP0=SLIP
+*----
+*  THERMAL EXCHANGE BETWEEN CLAD AND FLUID USING THE DITTUS AND BOELTER
+*  CORRELATION (SINGLE PHASE) OR CHEN CORRELATION (SATURATED BOILING)
+*----
+      IF(IHCONV.EQ.0) THEN
+        ITER=0
+        KWA=99
+*CGT CHECK IF REYNOLDS AND PRANDTL ARE IN RANGE OF VALIDITY OF
+*    GNIELINSKI CORRELATION
+        TSCLAD=TCALO
+        IF((REL.LT.2300).OR.(REL.GT.1E6)) THEN
+          WRITE(6,*) "  THMSAL: ***WARNING*** REYNOLDS OUT RANGE."
+        ENDIF
+        IF((PRL.LT.0.6).OR.(PRL.GT.1E5)) THEN
+          WRITE(6,*) "  THMSAL: ***WARNING*** PRANDTL OUT RANGE."
+        ENDIF
+        DO
+          ITER=ITER+1
+          IF(ITER.GT.50) THEN
+            WRITE(HSMG,'(30HTHMSAL: HCONV FAILURE IN SLICE,I5,1H.)') K
+            CALL XABORT(HSMG)
+          ENDIF
+*CGT Changed Dittus-Boelter by Gnielinski correlation
+*CGT PRW: Prandtl number of liquid at wall temperature
+          CALL THMSPT(STP,TSCLAD,R1,R2,ZKONE,ZMUONE,CPONE,IMPX)
+          PRW=ZMUONE*CPONE/ZKONE
+          HA=(ZKL/HD)*0.012*(REL**0.87-280)*PRL**0.8*(1+(HD/DZ)
+     >    **(2.0/3.0))*(PRL/PRW)**0.11
+          IF(IMPX.GT.4) THEN
+            WRITE(6,*) 'THMSAL: REL,PRL,PRW,HA=',REL,PRL,PRW,HA
+          ENDIF
+          F=1.0
+          S=1.0
+          IF((XFL.EQ.XFL0).OR.(TSCLAD.LE.TSAT).OR.(KWA.EQ.0)) THEN
+*           Single-phase convection. Use Gnielinski correlation
+            KWA=0
+            HB=0.0
+            K0=0
+            XFL=XFL0
+            EPS=EPS0
+            SLIP=SLIP0
+          ELSE 
+            CALL XABORT('THMSAL: INVALID HEAT TRANSFER REGIME')
+          ENDIF
+*         Chen correlation
+          HCONV=F*HA+S*HB
+          IF(HCONV.LE.0.0) THEN
+            WRITE(HSMG,'(34HTHMSAL: DRY OUT REACHED IN CHANNEL,3I5)')
+     >      I,J,K
+            CALL XABORT(HSMG)
+          ENDIF
+          IF(ITIME.EQ.0) THEN
+            TWAL=(PHI+S*HB*TSAT+F*HA*TCALO)/(S*HB+F*HA)
+          ELSE
+            ZNUM=ZF(1)+RADCL*S*HB*TSAT+RADCL*F*HA*TCALO
+            ZDEN=ZF(2)+RADCL*S*HB+RADCL*F*HA
+            TWAL=MAX(273.15,ZNUM/ZDEN)
+            PHI=MAX(0.0,(ZF(1)-TWAL*ZF(2))/RADCL)
+          ENDIF
+          IF(ABS(TSCLAD-TWAL).GT.1.0E-5*TSCLAD) THEN
+            TSCLAD=TWAL
+          ELSE
+            EXIT
+          ENDIF
+        ENDDO
+      ELSE IF(IHCONV.EQ.1) THEN
+        IF(ITIME.EQ.0) THEN
+          TSCLAD=TCALO+PHI/KHCONV
+        ELSE
+          RCHC=RADCL*KHCONV
+          TSCLAD=MAX(273.15,(ZF(1)+RCHC*TCALO)/(ZF(2)+RCHC))
+          PHI=(ZF(1)-TSCLAD*ZF(2))/RADCL
+        ENDIF
+      ENDIF
+      RETURN
+      END
diff --git a/Donjon/src/THMSCD.f b/Donjon/src/THMSCD.f
new file mode 100644
index 0000000..83a8187
--- /dev/null
+++ b/Donjon/src/THMSCD.f
@@ -0,0 +1,45 @@
+*DECK THMSCD
+      REAL FUNCTION THMSCD(TEMP,FTP,IMPX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute the product of the heat capacity of fuel (in J/Kg/K) times
+* its density (in Kg/m^3). Version for molten salts.
+*
+*Copyright:
+* Copyright (C) 2024 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* C. Garrido
+*
+*Parameters: input
+* TEMP    fuel temperature in Kelvin.
+* FTP     tpdata object with correlations to obtain properties of 
+*         molten salt.
+* 
+*Parameters: output
+* THMSCD  product of the heat capacity of fuel times its density
+*         (in J/K/m^3).
+*
+*-----------------------------------------------------------------------
+*
+      USE t_saltdata
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(tpdata) FTP
+      REAL TEMP
+      INTEGER IMPX
+*----
+*  LOCAL VARIABLES
+*  CP:    heat capacity in J/Kg/K
+*  RHO: fuel density Kg/m^3
+*----
+      REAL CP,RHO,R2,R3,R4
+*
+      CALL THMSPT(FTP,TEMP,RHO,R2,R3,R4,CP,IMPX)
+      THMSCD=RHO*CP
+      RETURN
+      END
diff --git a/Donjon/src/THMSDI.f b/Donjon/src/THMSDI.f
new file mode 100644
index 0000000..3c4951b
--- /dev/null
+++ b/Donjon/src/THMSDI.f
@@ -0,0 +1,81 @@
+*DECK THMSDI
+      FUNCTION THMSDI(T2K,T1K,FTP,IFRCDI,IMPX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute the thermal conductivity integral of UOX or MOX fuel.
+*
+*Copyright:
+* Copyright (C) 2024 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* C. Garrido
+*
+*Parameters: input
+* T2K     final temperature in Kelvin.
+* T1K     initial temperature in Kelvin.
+* FTP     tpdata object with correlations to obtain properties of molten salt.
+* IFRCDI  flag indicating if average approximation is forced during
+*         fuel conductivity evaluation (0=default/1=average
+*         approximation forced).
+* IMPX    printing index (=0 for no print).
+*
+*Parameters: output
+* THMSDI  thermal conductivity integral in Watt/m/K.
+*
+*Reference:
+* A. Poncot, "Assimilation de donnees pour la dynamique du xenon dans
+* les coeurs de centrale nucleaire", Ph.D Thesis, Universite de
+* Toulouse, France, 2008.
+*
+*-----------------------------------------------------------------------
+*
+      USE t_saltdata
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(tpdata) FTP
+      INTEGER IFRCDI,IMPX
+      REAL T1K,T2K,THMSDI
+*----
+*  LOCAL VARIABLES
+* NPAS    number of rectangles in the quadrature
+* DT      rectangle width
+* T2T1    temperature difference
+* DTMIN   cutoff criterion for selecting the approximation
+*----
+      INTEGER NPAS,I
+      REAL T1,T2,DT,TM,DTMIN,T2T1,TT
+      REAL R1,R2,ZKONE,ZMUONE,CPONE,CINT
+      DATA NPAS /10/
+      DATA DTMIN /10./
+*
+      IF(MIN(T1K,T2K).LE.0.0) THEN
+         CALL XABORT('@THMSDI: NEGATIVE TEMPERATURE.')
+      ENDIF
+      T1=T1K
+      T2=T2K
+*
+      T2T1 = T2-T1
+      DT = T2T1/NPAS
+      TM = (T1+T2)/2.0
+*     User-given conductivity, as a function of temperature
+      IF((ABS(T2T1).LT.DTMIN).OR.(IFRCDI.EQ.1)) THEN
+*        Use the average value approximation
+         CALL THMSPT(FTP,TM,R1,R2,ZKONE,ZMUONE,CPONE,IMPX)
+         THMSDI=ZKONE
+      ELSE
+*        Use the rectangle quadrature approximation
+         TT=T1-DT*0.5
+         CINT=0.
+         DO I=1,NPAS
+            TT=TT+DT
+            CALL THMSPT(FTP,TT,R1,R2,ZKONE,ZMUONE,CPONE,IMPX)
+            CINT=CINT + ZKONE
+         ENDDO
+         THMSDI=CINT/NPAS
+      ENDIF
+      RETURN
+      END
diff --git a/Donjon/src/THMTRS.f b/Donjon/src/THMTRS.f
new file mode 100644
index 0000000..43b0caa
--- /dev/null
+++ b/Donjon/src/THMTRS.f
@@ -0,0 +1,570 @@
+*DECK THMTRS
+      SUBROUTINE THMTRS(MPTHMI,MPTHM,IMPX,IX,IY,NZ,XBURN,VOLXY,HZ,DTIME,
+     > CFLUX,POROS,FNFU,NFD,NDTOT,IFLUID,SNAME,SCOMP,
+     > IGAP,IFUEL,FNAME,FCOMP,FCOOL,FFUEL,ACOOL,
+     > HD,PCH,MAXITC,MAXIT1,MAXITL,ERMAXT,ERMAXC,SPDIN,TINLET,POULET,
+     > FRACPU,ICONDF,NCONDF,KCONDF,UCONDF,ICONDC,NCONDC,KCONDC,UCONDC,
+     > IHGAP,KHGAP,IHCONV,KHCONV,WTEFF,IFRCDI,ISUBM,FRO,POW,TCOMB,DCOOL,
+     > TCOOL,TSURF)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Driver of the transient thermal-hydraulics module for a single time
+* iteration
+*
+*Copyright:
+* Copyright (C) 2013 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* P. Gallet and A. Hebert
+*
+* 08/2023: C. Garrido Modifications to include Molten Salt heat transfer in
+*          coolant
+* 07/2024: C. Garrido Modifications to include Molten Salt heat transfer
+*          in static fuel
+*
+*Parameters: input
+* MPTHMI  directory of the THM object containing steady-state
+*         thermohydraulics data at t-1.
+* MPTHM   directory of the THM object containing steady-state
+*         thermohydraulics data at t.
+* IMPX    printing index (=0 for no print).
+* IX      position of mesh along X direction.
+* IY      position of mesh along Y direction.
+* NZ      number of meshes along Z direction (channel direction).
+* XBURN   burnup distribution in MWday/tonne.
+* VOLXY   mesh area in the radial plane.
+* HZ      Z-directed mesh widths.
+* DTIME   time step in s.
+* CFLUX   critical heat flux in W/m^2.
+* POROS   oxyde porosity.
+* FNFU    number of active fuel rods in the fuel bundle.
+* NFD     number of discretisation points in fuel regions.
+* NDTOT   number of total discretization points in the the fuel
+*         pellet and the cladding.
+* IFLUID  type of fluid (0=H2O; 1=D2O).
+* FCOOL   power density fraction in coolant.
+* FFUEL   power density fraction in fuel.
+* ACOOL   coolant cross section area in m^2.
+* HD      hydraulic diameter of one assembly in m.
+* PCH     heating perimeter in m.
+* MAXITC  maximum number of flow iterations.
+* MAXIT1  maximum number of conduction iterations.
+* MAXITL  maximum number of center-pellet iterations.
+* ERMAXT  convergence criterion for temperature in fuel pin in K.
+* ERMAXC  convergence criterion for coolant parameters (relative error).
+* SPDIN   inlet flow velocity at t in m/s.
+* TINLET  inlet temperature at t in K.
+* POULET  outlet pressure at t in Pa.
+* FRACPU  plutonium fraction in fuel.
+* ICONDF  fuel conductivity flag (0=Stora-Chenebault or COMETHE/
+*         1=user-provided polynomial + inverse term).
+* NCONDF  degree of user-provided fuel conductivity polynomial.
+* KCONDF  polynomial coefficients for fuel conductivity in W/m/K^(k+1)
+*         (except for the two last coefficients which belongs to the
+*         inverse term).
+* UCONDF  required unit of temperature in polynomial for fuel
+*         conductivity (KELVIN or CELSIUS).
+* ICONDC  clad conductivity flag (0=default/1=user-provided
+*         polynomial).
+* NCONDC  degree of user-provided clad conductivity polynomial.
+* KCONDC  polynomial coefficients for clad conductivity in W/m/K^(k+1).
+* UCONDC  required unit of temperature in polynomial for clad
+*         conductivity (KELVIN or CELSIUS).
+* IHGAP   flag indicating HGAP chosen (0=default/1=user-provided).
+* KHGAP   fixed user-provided HGAP value in W/m^2/K.
+* IHCONV  flag indicating HCONV chosen (0=default/1=user-provided).
+* KHCONV  fixed user-provided HCONV value in W/m^2/K.
+* WTEFF   surface temperature's weighting factor in effective fuel
+*         temperature.
+* IFRCDI  flag indicating if average approximation is forced during
+*         fuel conductivity evaluation (0=default/1=average
+*         approximation forced).
+* ISUBM   subcooling model (0: one-phase; 1: Bowring model; 2: Saha-
+*         Zuber model).
+* FRO     radial power form factors.
+* POW     power distribution at t in W.
+* IGAP    Flag indicating if the gap is considered (0=gap/1=no gap)
+* IFUEL   type of fuel (0=UO2/MOX; 1=SALT).
+* FNAME   Name of the molten salt (e.g. "LiF-BeF2")
+* FCOMP   Composition of the molten salt (e.g. "0.66-0.34")
+*
+*Parameters: output
+* TCOMB   averaged fuel temperature distribution in K.
+* DCOOL   averaged coolant density distribution in g/cc.
+* TCOOL   averaged coolant temperature distribution in K.
+* TSURF   surface fuel temperature distribution in K.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      USE t_saltdata
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) MPTHMI,MPTHM
+      INTEGER IMPX,IX,IY,NZ,NFD,NDTOT,IFLUID,MAXITC,MAXIT1,MAXITL,IHGAP,
+     > IGAP,IFUEL 
+      REAL XBURN(NZ),VOLXY,HZ(NZ),DTIME,CFLUX,POROS,FNFU(NZ),FFUEL(NZ),
+     > ERMAXT,ERMAXC,FCOOL(NZ),SPDIN,TINLET,POULET,FRACPU,
+     > KCONDF(NCONDF+3),KCONDC(NCONDC+1),KHGAP,KHCONV,WTEFF,FRO(NFD-1),
+     > POW(NZ),TCOMB(NZ),DCOOL(NZ),TCOOL(NZ),TSURF(NZ),DGCOOL(NZ),
+     > HLV(NZ),ACOOL(NZ),PCH(NZ),HD(NZ)
+      CHARACTER UCONDF*12,UCONDC*12
+*----
+*  LOCAL VARIABLES
+*----
+      TYPE(tpdata) STP,FTP
+      PARAMETER(KMAXO=100,MAXNPO=40,PES=9.81)
+      REAL ENT(4),RHOINL,MFLXIN,RHOIN0,MFLXIN0,HINLET,HINLE0,MUIN,
+     > DV(NZ),PARAM1,PARAM2,PARAM3,ERRG,ERRP,ERRH,ERR,DELTH,HMINF,
+     > POWLIN(NZ),PHI(NZ),MUT(NZ),RESM(NZ),RESP(NZ),RESH(NZ),QFUEL(NZ),
+     > QCOOL(NZ),TC1,AGM(NZ),PC(NZ),TSAT,PHIC(NZ),TP(NZ),TLC(NZ),
+     > HZC(NZ),XFL(NZ),EPS(NZ),TB,HGSAT,TCLAD(NZ),MFLXT0(NZ),ENTH(NZ),
+     > MFLXT(NZ),SLIP(NZ),K11
+      INTEGER KWA(NZ)
+      REAL TRE10(MAXNPO),TRE11(MAXNPO),RADD(MAXNPO),XX2(MAXNPO),
+     > XX3(MAXNPO),ZF(2)
+      CHARACTER HSMG*131,SNAME*32,SCOMP*32,FNAME*32,FCOMP*32
+      REAL XS(4)
+      DATA XS/-0.861136,-0.339981,0.339981,0.861136/
+      INTEGER IDFM
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      REAL, ALLOCATABLE, DIMENSION(:) :: VELOT0,DCOOL0,PREST0,ENTHT0,
+     > DLIQT0,VELOT,PREST,ENTHT,TCENTT,DLIQT
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: RAD,TEMPT0,TEMPT
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(RAD(NDTOT-1,NZ),VELOT0(NZ),DCOOL0(NZ),PREST0(NZ),
+     > ENTHT0(NZ),TEMPT0(NDTOT,NZ),DLIQT0(NZ),VELOT(NZ),PREST(NZ),
+     > ENTHT(NZ),TEMPT(NDTOT,NZ),TCENTT(NZ),DLIQT(NZ))
+*----
+*  RECOVER DATA FROM FORMER TIME STEP OR STEADY-STATE CALCULATION IN THM
+*----
+      CALL LCMGET(MPTHMI,'DENSITY',DCOOL0)
+      CALL LCMGET(MPTHMI,'PRESSURE',PREST0)
+      CALL LCMGET(MPTHMI,'ENTHALPY',ENTHT0)
+      CALL LCMGET(MPTHMI,'VELOCITIES',VELOT0)
+      CALL LCMGET(MPTHMI,'TEMPERATURES',TEMPT0)
+      CALL LCMGET(MPTHMI,'LIQUID-DENS',DLIQT0)
+      CALL LCMGET(MPTHMI,'POULET',POUT0)
+      CALL LCMGET(MPTHMI,'TINLET',TIN0)
+      CALL LCMGET(MPTHMI,'RADII',RAD)
+      IDFM = 0
+*----
+*  CALCULATE THE INVERSE TIME STEP
+*----
+      IF(DTIME.EQ.0.0) THEN
+        CALL XABORT('THMTRS: TIME STEP NOT DEFINED')
+      ELSE
+        DTINV=1.0/DTIME
+      ENDIF
+*----
+*  COMPUTE THE INLET FLOW ENTHALPY AND MASS FLOW RATE
+*----
+      IF(IFLUID.EQ.0) THEN
+         CALL THMSAT(POULET,TSAT)
+      ELSE IF(IFLUID.EQ.1) THEN
+         CALL THMHST(POULET,TSAT)
+*CGT TODO: GET SATURATION TEMPERATURE FROM MSTPDB. GET ALSO FREEZING??
+      ELSE IF(IFLUID.EQ.2) THEN
+         CALL THMSGT(SNAME,SCOMP,STP,IMPX)
+         CALL THMSST(STP,TSAT,IMPX)
+      ENDIF
+      IF(IFUEL.EQ.1) THEN
+         CALL THMSGT(FNAME,FCOMP,FTP,IMPX)
+      ENDIF
+      IF(TINLET.GT.TSAT) THEN
+         WRITE(HSMG,'(28HTHMTRS: OUTLET TEMPERATURE (,1P,E12.4,
+     1   40H K) GREATER THAN SATURATION TEMPERATURE.)') TINLET
+         CALL XABORT(HSMG)
+      ENDIF
+      RHOIN0=0.0
+      IF(IFLUID.EQ.0) THEN
+        CALL THMPT(POUT0,TIN0,RHOIN0,HINLE0,R3,R4,R5)
+      ELSE IF(IFLUID.EQ.1) THEN
+        CALL THMHPT(POUT0,TIN0,RHOIN0,HINLE0,R3,R4,R5)
+      ELSE IF(IFLUID.EQ.2) THEN
+        CALL THMSPT(STP,TINLET,RHOIN0,HINLE0,R3,R4,R5,IMPX)
+      ENDIF
+      MFLXIN0=SPDIN*RHOIN0
+      IF(IFLUID.EQ.0) THEN
+        CALL THMPT(POULET,TINLET,RHOINL,HINLET,R3,MUIN,CPVIN)
+      ELSE IF(IFLUID.EQ.1) THEN
+        CALL THMHPT(POULET,TINLET,RHOINL,HINLET,R3,MUIN,CPVIN)
+      ELSE IF(IFLUID.EQ.2) THEN
+        CALL THMSPT(STP,TINLET,RHOINL,HINLET,R3,MUIN,CPVIN,IMPX)
+      ENDIF
+      MFLXIN=SPDIN*RHOINL
+      IF(NDTOT.GT.MAXNPO) CALL XABORT('THMTRS: MAXNPO OVERFLOW')
+*----
+*  MAIN LOOP ALONG THE 1D CHANNEL.
+      DO K=1,NZ
+*----
+*  COMPUTE THE LINEAR POWER, THE VOLUMIC POWER, THE THERMAL EXCHANGE
+*  COEFFICIENT OF THE GAP AND THE THERMAL HEAT FLUX ALONG THE CHANNEL
+*----
+         DV(K)=VOLXY*HZ(K)
+*        linear power in W/m.
+         POWLIN(K)=(POW(K)/DV(K))*VOLXY/FNFU(K)
+*        volumic power in W/m^3.
+         QFUEL(K)=POW(K)*FFUEL(K)/DV(K)
+         QCOOL(K)=POW(K)*FCOOL(K)/DV(K)
+*----
+*  INITIALIZATION OF THE THERMO-HYDRAULICAL PROPERTIES OF THE FLUID
+*----
+         DCOOL(K)=DCOOL0(K)
+         MUT(K)=MUIN
+         VELOT(K)=VELOT0(K)
+         MFLXT0(K)=DCOOL0(K)*VELOT(K)
+         MFLXT(K)=MFLXT0(K)
+         PREST(K)=PREST0(K)
+         ENTHT(K)=ENTHT0(K)
+         DLIQT(K)=DLIQT0(K)
+         DO L=1,NDTOT
+           TEMPT(L,K)=TEMPT0(L,K)
+         ENDDO
+         RESM(K)=MFLXT(K)
+         RESP(K)=PREST(K)
+         RESH(K)=ENTHT(K)
+      ENDDO
+*----
+*  ITERATIVE PROCEDURE FOR EACH CHANNEL
+*----
+      DO K=1,NZ
+         XFL(K)=0.0
+         EPS(K)=0.0
+         XFL(K)=0.0
+         MFLXT(K)=0.0
+         SLIP(K)=1.0
+         KWA(K)=0
+      ENDDO
+      KMIN=1
+      DO K=1,NZ
+        IF(POW(K).NE.0.0) THEN
+          KMIN=K
+          EXIT
+        ENDIF
+      ENDDO
+      ITERC=0
+   20 ITERC=ITERC+1
+      IF(ITERC.GT.MAXITC) THEN
+         CALL XABORT('THMTRS: CONVERGENCE FAILURE IN FLOW CALCULATION.')
+      ENDIF
+*----
+*  MAIN LOOP ALONG THE 1D CHANNEL.
+*----
+      K0=0 ! onset of nuclear boiling point
+      DO K=KMIN,NZ
+        IF(POW(K).EQ.0.0) CYCLE
+        IF(IMPX.GT.4) WRITE(6,190) K
+*----
+*  SOLVE THE CONDUCTION EQUATIONS INSIDE THE FUEL ROD
+*----
+        DO L=1,NDTOT-1
+          TRE10(L)=TEMPT0(L,K)
+          TRE11(L)=TEMPT(L,K)
+          RADD(L)=RAD(L,K)
+        ENDDO
+        TSCLAD=TEMPT(NDTOT,K)
+        IF(IGAP.EQ.0) THEN
+          CALL THMROD(IMPX,NFD,NDTOT-1,MAXIT1,MAXITL,ERMAXT,DTINV,
+     1    RADD,TRE10,TRE11,QFUEL(K),FRO,TSCLAD,POWLIN(K),XBURN(K),
+     2    POROS,FRACPU,ICONDF,NCONDF,KCONDF,UCONDF,ICONDC,NCONDC,
+     3    KCONDC,UCONDC,IHGAP,KHGAP,IFRCDI,TC1,XX2,XX3,ZF)
+        ELSE
+          CALL THMRNG(IMPX,NFD,NDTOT-1,MAXIT1,MAXITL,ERMAXT,DTINV,
+     1    RADD,TRE10,TRE11,QFUEL(K),FRO,TSCLAD,POWLIN(K),XBURN(K),
+     2    POROS,FRACPU,ICONDF,NCONDF,KCONDF,UCONDF,ICONDC,NCONDC,
+     3    KCONDC,UCONDC,IFRCDI,IFUEL,FTP
+     4    TC1,XX2,XX3,ZF)
+        ENDIF
+*----
+*  COMPUTE THE HEAT FLUX FROM CLAD TO COOLANT IN W/m^2
+*----
+        PHI(K)=(ZF(1)-TSCLAD*ZF(2))/RAD(NDTOT-1,K)
+        IF(PHI(K).GT.CFLUX) THEN
+          WRITE(HSMG,'(23HTHMTRS: THE HEAT FLUX (,1P,E12.4,5H) IS ,
+     >    37HGREATER THAN THE CRITICAL HEAT FLUX (,E12.4,2H).)')
+     >    PHI(K),CFLUX
+          WRITE(6,'(/1X,A)') HSMG
+        ENDIF
+*----
+*  FLOW RATE CALCULATION WITH MASS CONSERVATION EQUATION
+*----
+        PARAM1=0.5*(DCOOL0(K)-DCOOL(K))*DTINV*HZ(K)
+        IF(K.EQ.KMIN) THEN
+          PARAM1=PARAM1+0.5*(RHOIN0-RHOINL)*DTINV*HZ(K)
+          MFLXT(K)=MFLXIN+PARAM1
+        ELSE
+          PARAM1=PARAM1+0.5*(DCOOL0(K-1)-DCOOL(K-1))*DTINV*HZ(K)
+          MFLXT(K)=MFLXT(K-1)+PARAM1
+        ENDIF
+*----
+*  ENTHALPY VECTOR CALCULATION WITH ENERGY CONSERVATION EQUATION
+*----
+        PARAM1=0.5*DCOOL(K)*DTINV*HZ(K)+MFLXT(K)
+        PARAM2=0.5*DCOOL0(K)*ENTHT0(K)*DTINV*HZ(K)
+        PARAM3=(QCOOL(K)+PHI(K)*PCH(K)/ACOOL(K))*HZ(K)
+        IF(K.EQ.KMIN) THEN
+          PARAM2=PARAM2+0.5*(RHOIN0*HINLE0-RHOINL*HINLET)*DTINV*HZ(K)
+          PARAM2=PARAM2+MFLXIN*HINLET
+          HMINF=HINLET
+        ELSE
+          PARAM2=PARAM2+0.5*(DCOOL0(K-1)*ENTHT0(K-1)-
+     1    DCOOL(K-1)*ENTHT(K-1))*DTINV*HZ(K)
+          PARAM2=PARAM2+MFLXT(K-1)*ENTHT(K-1)
+          HMINF=ENTHT(K-1)
+        ENDIF
+        ENTHT(K)=(PARAM2+PARAM3)/PARAM1
+        DELTH=ENTHT(K)-HMINF
+*----
+*  COMPUTE THE COOLANT TEMPERATURE AND THE OUTER CLADDING TEMPERATURE
+*----
+        DO I1=1,4
+          POINT=(1.0+XS(I1))/2.0
+          ENT(I1)=HMINF+POINT*DELTH
+        ENDDO
+        IF(K.GT.1) THEN
+          XFL(K)=XFL(K-1)
+          EPS(K)=EPS(K-1)
+          SLIP(K)=SLIP(K-1)
+        ENDIF
+*CGT
+        IF ((IFLUID.EQ.0).OR.(IFLUID.EQ.1)) THEN
+          CALL THMH2O(1,IX,IY,K,K0,PREST(K),MFLXT(K),ENTHT(K),ENT,HD(K),
+     >    IFLUID,IHCONV,KHCONV,ISUBM,RAD(NDTOT-1,K),ZF,VELOT(K),
+     >    IDFM,PHI(K),XFL(K),EPS(K),SLIP(K),ACOOL(K),PCH(K),HZ(K),TCALO,
+     >    DCOOL(K),DLIQT(K),DGCOOL(K),TRE11(NDTOT),
+     >    KWA(K),VGJprime,HLV(K))
+     
+        ELSEIF (IFLUID.EQ.2) THEN
+          CALL THMSAL(IMPX,1,IX,IY,K,K0,MFLXT(K),ENTHT(K),ENT,HD(K),
+     >    STP,IHCONV,KHCONV,ISUBM,RAD(NDTOT-1,K),ZF,PHI(K),
+     >    XFL(K),
+     >    EPS(K),SLIP(K),HZ(K),TCALO,DCOOL(K),DLIQT(K),
+     >    TRE11(NDTOT),KWA(K))
+        ENDIF
+*CGT
+        DO L=1,NDTOT-1
+          TRE11(L)=XX2(L)+TRE11(NDTOT)*XX3(L)
+          TEMPT(L,K)=TRE11(L)
+        ENDDO
+        TEMPT(NDTOT,K)=TRE11(NDTOT)
+*----
+*  RECOVER MESHWISE TEMPERATURES AND FLUID DENSITY. BY DEFAULT, USE THE
+*  ROWLANDS FORMULA TO COMPUTE THE EFFECTIVE FUEL TEMPERATURE, OTHERWISE
+*  USE USER-SPECIFIED WEIGHTING FACTOR.
+*----
+        TCOMB(K)=(1.0-WTEFF)*TC1+WTEFF*TRE11(NFD)
+        TCOOL(K)=TCALO
+        TCENTT(K)=TC1
+        TSURF(K)=TRE11(NFD)
+        TCLAD(K)=TRE11(NDTOT)
+      ENDDO
+*----
+*  MOMENTUM VECTOR CALCULATION WITH MOMENTUM CONSERVATION EQUATION
+*----
+*      DO K=NZ,1,-1
+*        IF(POW(K).EQ.0.0) CYCLE
+*        RET=ABS(MFLXT(K))*(1.0-XFL(K))*HD/MUT(K)
+*        PARAM1=0.5*(MFLXT(K)-MFLXT0(K))*DTINV*HZ(K)
+*        PARAM2=MFLXT(K)**2.0/DCOOL(K)
+*        CALL THMFRI(RET,F)
+*        IF(XFL(K).GT.0.0) THEN
+*          CALL THMPLO(PREST(K),XFL(K),PHIL0)
+*        ELSE
+*          PHIL0=1.0
+*        ENDIF
+*        PARAM31=DCOOL(K)*PES
+*        PARAM32=0.5*F*MFLXT(K)**2.0/HD/DLIQT0(K)*PHIL0
+*        PARAM3=(PARAM31+PARAM32)*HZ(K)
+*        IF(K.EQ.1) THEN
+*          PARAM1=PARAM1+0.5*(MFLXIN-MFLXIN0)*DTINV*HZ(1)
+*          PARAM2=PARAM2-MFLXIN**2.0/RHOINL
+*          PREST(1)=PREST(2)+PARAM1+PARAM2+PARAM3
+*        ELSE IF(K.LT.NZ) THEN
+*          PARAM1=PARAM1+0.5*(MFLXT(K-1)-MFLXT0(K-1))*DTINV*
+*     1    HZ(K)
+*          PARAM2=PARAM2-MFLXT(K-1)**2.0/DCOOL(K-1)
+*          PREST(K)=PREST(K+1)+PARAM1+PARAM2+PARAM3
+*        ELSE IF(K.EQ.NZ) THEN
+*          PARAM1=PARAM1+0.5*(MFLXT(NZ-1)-MFLXT0(NZ-1))*DTINV*
+*     1    HZ(NZ)
+*          PARAM2=PARAM2-MFLXT(K-1)**2.0/DCOOL(K-1)
+*          PREST(NZ)=POULET+PARAM1+PARAM2+PARAM3
+*        ENDIF
+*      ENDDO
+      PINLET=PREST(KMIN)
+*----
+*  CALCULATE THE VOID FRACTION COEFFICIENT AND THE STEAM QUALITY
+*----
+      DO K=1,NZ
+        HZC(K)=HZ(K)
+        PHIC(K)=PHI(K)
+        TP(K)=TCLAD(K)
+        TLC(K)=TCOOL(K)
+        ENTH(K)=ENTHT(K)    
+        AGM(K)=MFLXT(K)
+        PC(K)=PREST(K)
+      ENDDO
+*----
+*  COMPUTE NEW VALUES OF DENSITIES AND VELOCITIES OVER CHANNEL
+*----
+       DO K=1,NZ
+         IF(EPS(K).GT.0.0) THEN
+           IF(IFLUID.EQ.0) THEN
+             CALL THMSAT(PREST(K),TSAT)
+             CALL THMTX(TSAT,1.0,RGSAT,HGSAT,R3,R4,R5)
+           ELSE IF(IFLUID.EQ.1) THEN
+             CALL THMHST(PREST(K),TSAT)
+             CALL THMHTX(TSAT,1.0,RGSAT,HGSAT,R3,R4,R5)
+           ENDIF
+           DCOOL(K)=DLIQT(K)*(1.0-EPS(K))+EPS(K)*RGSAT
+         ELSE
+           DCOOL(K)=DLIQT(K)
+         ENDIF
+         VELOT(K)=MFLXT(K)/DCOOL(K)
+       ENDDO
+*----
+*  CONVERGENCE TEST FOR THE ENTHALPY, PRESSURE DENSITY AND
+*  MASS FLUX CALCULATION.
+*----
+      ERRG=0.0
+      ERRP=0.0
+      ERRH=0.0
+      ERR=0.0
+      ERX=0.0
+      DO K=1,NZ
+        IF(POW(K).EQ.0.0) CYCLE
+        IF(IFLUID.EQ.0) THEN
+          CALL THMSAT(PREST(K),TSAT)
+        ELSE IF(IFLUID.EQ.1) THEN
+          CALL THMHST(PREST(K),TSAT)
+        ENDIF
+        TB=TSAT-0.1
+        IF(TCOOL(K).LT.TB) THEN
+          IF(IFLUID.EQ.0) THEN
+           CALL THMPT(PREST(K),TCOOL(K),R11,H11,K11,MUT(K),C11)
+          ELSE IF(IFLUID.EQ.1) THEN
+           CALL THMHPT(PREST(K),TCOOL(K),R11,H11,K11,MUT(K),C11)
+          ELSE IF(IFLUID.EQ.2) THEN
+           CALL THMSPT(STP,TCOOL(K),R11,H11,K11,MUT(K),C11,IMPX)
+          ENDIF
+        ELSE
+          IF(IFLUID.EQ.0) THEN
+           CALL THMPT(PREST(K),TB,R11,H11,K11,MUT(K),C11)
+          ELSE IF(IFLUID.EQ.1) THEN
+           CALL THMHPT(PREST(K),TB,R11,H11,K11,MUT(K),C11)
+          ELSE IF(IFLUID.EQ.2) THEN
+           CALL THMSPT(STP,TB,R11,H11,K11,MUT(K),C11,IMPX)
+          ENDIF
+        ENDIF
+        ERRG=MAX(ERRG,ABS(MFLXT(K)-RESM(K))/MFLXT(K))
+        ERRP=MAX(ERRP,ABS(PREST(K)-RESP(K))/PREST(K))
+        ERRH=MAX(ERRH,ABS(ENTHT(K)-RESH(K))/ENTHT(K))
+        RESM(K)=MFLXT(K)
+        RESP(K)=PREST(K)
+        RESH(K)=ENTHT(K)
+      ENDDO
+      ERR=MAX(ERRG,ERRP,ERRH)
+      IF(IMPX.GT.1) WRITE(6,200) ITERC,ERRG,ERRP,ERRH
+      IF(IFLUID.EQ.0) THEN
+        CALL THMPT(PINLET,TINLET,RHOINL,HINLET,R3,MUIN,CPVIN)
+      ELSE IF(IFLUID.EQ.1) THEN
+        CALL THMHPT(PINLET,TINLET,RHOINL,HINLET,R3,MUIN,CPVIN)
+      ELSE IF(IFLUID.EQ.2) THEN
+        CALL THMSPT(STP,TINLET,RHOINL,HINLET,R3,MUIN,CPVIN,IMPX)
+      ENDIF
+      IF((ERR.LT.ERMAXC).AND.(ITERC.GT.1)) THEN
+        GO TO 30
+      ELSE
+        GO TO 20
+      ENDIF
+*----
+*  PRINT THE OUTLET THERMOHYDRAULICAL PARAMETERS
+*----
+   30 IF(IMPX.GT.3) THEN
+         WRITE(6,'(/16H THMTRS: CHANNEL,2I6/1X,27(1H-))') IX,IY
+         WRITE(6,210) ' ___________________________________________',
+     >          '____________________________________________________',
+     >          '____________________________________________________',
+     >          '_______________________________'
+         WRITE(6,210) '|     |   TFUEL    |   TSURF    |    MFLXT  ',
+     >          '  |    DCOOL    |    TCOOL    |    PCOOL    |    HCO',
+     >          'OL    |    QFUEL    |    QCOOL    |    VOID   |     ',
+     >          'QUAL    |     SLIP    |  FLOW  |',
+     >          '|     |     K      |     K      |   Kg/m2/s   |    K',
+     >          'g/m3    |      K      |     Pa      |    J/Kg     | ',
+     >          '   W/m3     |    W/m3     |           |             ',
+     >          '|             | REGIME |'
+         WRITE(6,210) '|_____|____________|____________|___________',
+     >          '__|_____________|_____________|_____________|_______',
+     >          '______|_____________|_____________|___________|_____',
+     >          '________|_____________|________|'
+         DO L=NZ,1,-1
+           IF(L.EQ.1) THEN
+             WRITE(6,220) '| BOT |',TCOMB(L),' |',TSURF(L),
+     >            ' |',MFLXT(L),' |',DCOOL(L),' |',TCOOL(L),
+     >            ' |',PREST(L),' |',ENTHT(L),' |',QFUEL(L),
+     >            ' |',QCOOL(L),' |',EPS(L),' |',XFL(L),' |',SLIP(L),
+     >            ' |',KWA(L),' |'
+           ELSEIF(L.EQ.NZ) THEN
+             WRITE(6,220) '| TOP |',TCOMB(L),' |',TSURF(L),
+     >            ' |',MFLXT(L),' |',DCOOL(L),' |',TCOOL(L),
+     >            ' |',PREST(L),' |',ENTHT(L),' |',QFUEL(L),
+     >            ' |',QCOOL(L),' |',EPS(L),' |',XFL(L),' |',SLIP(L),
+     >            ' |',KWA(L),' |'
+           ELSE
+             WRITE(6,225) '| ',L,' |',TCOMB(L),' |',TSURF(L),
+     >            ' |',MFLXT(L),' |',DCOOL(L),' |',TCOOL(L),
+     >            ' |',PREST(L),' |',ENTHT(L),' |',QFUEL(L),
+     >            ' |',QCOOL(L),' |',EPS(L),' |',XFL(L),' |',SLIP(L),
+     >            ' |',KWA(L),' |'
+           ENDIF
+         ENDDO
+         WRITE(6,210) '|_____|____________|____________|___________',
+     >          '__|_____________|_____________|_____________|_______',
+     >          '______|_____________|_____________|___________|_____',
+     >          '________|_____________|________|'
+
+      ENDIF
+*----
+*  MODIFICATION OF THE VECTORS TO FIT THE GEOMETRY OF THE CHANNELS AND
+*  THE BUNDLES AND WRITE THE DATA IN LCM OBJECT THM 
+*----
+      CALL LCMPUT(MPTHM,'PRESSURE',NZ,2,PREST)
+      CALL LCMPUT(MPTHM,'DENSITY',NZ,2,DCOOL)
+      CALL LCMPUT(MPTHM,'ENTHALPY',NZ,2,ENTHT)
+      CALL LCMPUT(MPTHM,'VELOCITIES',NZ,2,VELOT)
+      CALL LCMPUT(MPTHM,'CENTER-TEMPS',NZ,2,TCENTT)
+      CALL LCMPUT(MPTHM,'COOLANT-TEMP',NZ,2,TCOOL)
+      CALL LCMPUT(MPTHM,'LIQUID-DENS',NZ,2,DLIQT)
+      CALL LCMPUT(MPTHM,'PINLET',1,2,PINLET)
+      CALL LCMPUT(MPTHM,'TINLET',1,2,TINLET)
+      CALL LCMPUT(MPTHM,'VINLET',1,2,SPEED)
+      CALL LCMPUT(MPTHM,'POWER',NZ,2,POW)
+      CALL LCMPUT(MPTHM,'POULET',1,2,POULET)
+      CALL LCMPUT(MPTHM,'TEMPERATURES',NDTOT*NZ,2,TEMPT)
+      CALL LCMPUT(MPTHM,'RADII',(NDTOT-1)*NZ,2,RAD)
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(DLIQT,TCENTT,TEMPT,ENTHT,PREST,VELOT,DLIQT0,TEMPT0,
+     > ENTHT0,PREST0,DCOOL0,VELOT0,RAD)
+      RETURN
+*
+  190 FORMAT(/21H THMTRS: AXIAL SLICE=,I5)
+  200 FORMAT(/24H THMTRS: FLOW ITERATION=,I5,1P,8H  ERROR=,3E12.4)
+  210 FORMAT(1X,A,A,A,A)
+  220 FORMAT(1X,A,F11.2,A,F11.2,A,F12.4,A,F12.4,A,F12.2,A,3P,E12.4,
+     >       A,1P,E12.4,A,1P,E12.4,A,1P,E12.4,A,0P,F10.4,A,E12.4,A,
+     >       E12.4,A,I5,2X,A)
+  225 FORMAT(1X,A,I3,A,F11.2,A,F11.2,A,F12.4,A,F12.4,A,F12.2,A,3P,
+     >       E12.4,A,1P,E12.4,A,1P,E12.4,A,1P,E12.4,A,0P,F10.4,A,
+     >       E12.4,A,E12.4,A,I5,2X,A)
+      END
diff --git a/Donjon/src/THMVGJ.f90 b/Donjon/src/THMVGJ.f90
new file mode 100644
index 0000000..7fdae19
--- /dev/null
+++ b/Donjon/src/THMVGJ.f90
@@ -0,0 +1,111 @@
+SUBROUTINE THMVGJ(VCOOL, DCOOL, PCOOL, MUT, XFL, HD, RHOG, RHOL, EPS, IDFM, VGJ, C0)
+!
+!-----------------------------------------------------------------------
+!
+!Purpose:
+! Update the concentration parameter CO and the drift velocity VGJ 
+! in the THM model after several correlations to implement the drift flux model 
+! in the THM code
+!
+!Copyright:
+! Copyright (C) 2025 Ecole Polytechnique de Montreal
+!
+!Author(s): M. Bellier
+! 04/2025: M. Bellier - Creation
+!
+!Parameters: input
+! XFL     quality of the fluid in the channel
+! DCOOL   density of the fluid in the channel
+! VCOOL   velocity of the fluid in the channel
+! PCOOL   pressure of the fluid in the channel
+! TCOOL   temperature of the fluid in the channel
+! MUT     dynamic viscosity of the fluid in the channel
+! HD      hydraulic diameter of the channel
+! RHOG    density of the vapour in given thermohydraulic conditions
+! RHOL    density of the liquid in given thermohydraulic conditions
+! ESP     void fraction of the fluid
+! IDFM    flag indicating if the drift flux model is to be used 
+!         (0=HEM1(no drift velocity)/1=EPRI/2=MODEBSTION/3=GERAMP/4=CHEXAL) 
+!
+!Parameters: output
+! VGJ     drift velocity
+! C0      concentration parameter
+!
+!-----------------------------------------------------------------------
+!
+    USE GANLIB
+    IMPLICIT NONE
+!----
+!   SUBROUTINE ARGUMENTS
+!----
+    REAL VCOOL, DCOOL, PCOOL, MUT, XFL, HD 
+    REAL EPS, RHOG, RHOL
+    INTEGER IDFM
+!----
+!   LOCAL VARIABLES
+!----
+    REAL g
+    REAL C1, k1, k0, r, PR, SIGM, VGJ, C0, REY
+    INTEGER PC
+
+    REY = ABS(VCOOL*DCOOL) * (1.0 - XFL) * HD / MUT !Reynolds
+    g =  9.81 !gravity
+    PR=PCOOL/10**6 ! PCOOL ou autre valeur de P ? initialement Pinlet
+    SIGM=-7.2391E-6*PR**3+2.8345E-4*PR**2-5.1566E-3*PR+4.2324E-2
+!----
+!   VGJ AND C0 CALCULATION
+!----
+IF (RHOG.EQ.0) THEN
+    C0=0
+    VGJ=0
+ELSE IF (RHOL.EQ.0) THEN
+    C0=0
+    VGJ=0
+
+ELSE IF (IDFM.EQ.0) THEN
+!HEM1 correlation (no drift velocity)
+    VGJ = 0
+    C0 = 1
+    
+ELSE IF (IDFM.EQ.4) THEN
+! Chexal correlation
+! Correlation used in previous codes, after the work of Sarra Zoghlami for CANDU reactors
+    C0=1.13
+    VGJ=1.18*((SIGM*9.81*(RHOL-RHOG))/(RHOL**2))**0.25
+    
+
+ELSE IF (IDFM.EQ.3) THEN
+! GEramp correlation 
+    IF (SIGM.EQ.0) THEN
+        VGJ = 0
+    ELSE 
+        VGJ = (g*SIGM*(RHOL-RHOG)/(RHOG**2))**0.25  
+        IF (EPS.GT.0.65) THEN
+            VGJ= VGJ*(2.9/0.35)*(1-EPS) 
+            C0= 1 + (0.1/0.35)*(1-EPS)
+        ELSE
+            VGJ = 2.9*VGJ
+            C0= 1.1 
+        ENDIF
+    ENDIF
+
+ELSE IF (IDFM.EQ.1) THEN
+! EPRI correlation
+    VGJ= ((2**0.5)*g*SIGM*(RHOL-RHOG)/(RHOL**2))**0.25 * ((1+EPS)**1.5)
+    PC = 22060000
+    C1 = (4 * (PC**2))/(PCOOL*(PC - PCOOL))
+    k1 = MIN(0.8, 1/(1 + exp(-REY /60000)))
+    k0 = k1 + (1-k1) * (RHOG / RHOL)**2
+    r = (1+1.57*(RHOG/RHOL))/(1-k1)
+    IF (EPS.GT.0) THEN
+        C0 = (k0 + (1 - k0)*(EPS**r)*exp((-1)*C1*(1-EPS))*(sinh(C1/2)/sinh(C1/2*EPS)))**(-1)
+    ENDIF
+
+ELSE IF (IDFM.EQ.2) THEN
+! Modfified Bestion Correlation
+    VGJ =  0.188 * (((RHOL - RHOG) * g * HD ) / RHOG )*0.5
+    C0 = 1.2 - 0.2*(RHOG/RHOL)**0.5
+
+ENDIF
+RETURN
+END
\ No newline at end of file
diff --git a/Donjon/src/TINCHA.f b/Donjon/src/TINCHA.f
new file mode 100644
index 0000000..4b02488
--- /dev/null
+++ b/Donjon/src/TINCHA.f
@@ -0,0 +1,85 @@
+*DECK TINCHA
+      SUBROUTINE TINCHA(IPMAP,NCH,IMPX,NAMCHA,TTIME,RFCHAN)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute 'REF-CHAN' record in L_MAP object for history-based cases.
+*
+*Copyright:
+* Copyright (C) 2013 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* A. Hebert
+*
+*Parameters: input
+* IPMAP   pointer to fuel-map information.
+* NCH     number of channels
+* IMPX    print flag
+* NAMCHA  channel name
+* TTIME   refuelling time
+*
+*Parameters: output
+* RFCHAN  time values at which channels are refueled inside a refueling
+*         time period
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAP
+      INTEGER NCH,IMPX
+      CHARACTER*(*) NAMCHA
+      REAL RFCHAN(NCH)
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(NSTATE=40)
+      INTEGER ISTATE(NSTATE)
+      CHARACTER XNAM*4,YNAM*4,TEXT4*4
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: MIX,IXN,IYN
+*
+      CALL LCMSIX(IPMAP,'GEOMAP',1)
+      CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+      IF(ISTATE(1).NE.7) CALL XABORT('TINCHA: 3-D CARTESIAN GEOMETRY'
+     +    //' REQUIRED')
+      NX = ISTATE(3)
+      NY = ISTATE(4)
+      NREG = ISTATE(6)
+      ALLOCATE(MIX(NREG),IXN(NX),IYN(NY))
+      CALL LCMGET(IPMAP,'MIX',MIX)
+      CALL LCMSIX(IPMAP,' ',2)
+      CALL LCMGET(IPMAP,'XNAME',IXN)
+      CALL LCMGET(IPMAP,'YNAME',IYN)
+      TEXT4 = NAMCHA(2:3)
+      IX = 1
+      IY = 1
+      DO 10 I=1,NX
+        WRITE(XNAM,'(A4)') IXN(I)
+        IF (XNAM.EQ.TEXT4) THEN
+           IX = I
+           GOTO 20
+        ENDIF
+  10  CONTINUE
+  20  TEXT4 = NAMCHA(1:1)
+      DO 30 I=1,NY
+        WRITE(YNAM,'(A4)') IYN(I)
+        IF (YNAM.EQ.TEXT4) THEN
+           IY = I
+           GOTO 40
+        ENDIF
+  30  CONTINUE
+*
+  40  I = (IY-1)*NX + IX
+      ICHANAM = MIX(I)
+      IF(ICHANAM.EQ.0) CALL XABORT('TINCHA: WRONG CHANNEL NAME')
+      DEALLOCATE(IYN,IXN,MIX)
+      RFCHAN(ICHANAM) = TTIME
+      IF(IMPX.GT.0) THEN
+        WRITE(6,*) 'TINCHA: REFUEL ',NAMCHA,' NUMBER ',I,' AT TIME ',
+     1  TTIME
+      ENDIF
+      RETURN
+      END
diff --git a/Donjon/src/TINFL.f b/Donjon/src/TINFL.f
new file mode 100644
index 0000000..ac3dfb6
--- /dev/null
+++ b/Donjon/src/TINFL.f
@@ -0,0 +1,56 @@
+*DECK TINFL
+      SUBROUTINE TINFL (NNS,NW,NW2,NK)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Produce the useful vector for refuelling, according
+* to a given refuelling-scheme
+*
+*Copyright:
+* Copyright (C) 2010 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* E. Varin, M. Guyot
+*
+*Parameters: input/output
+* NNS    Number corresponding to the refuelling type
+* NW     Vector corresponding to the refuelling type
+*           NW > 0  : Position of the bundle before refuelling     
+*           NW = 0  : Insertion of a new bundle
+* NW2    Vector NW when the refueling is negative
+* NK     Number of bundles per channel
+*
+*-----------------------------------------------------------------------
+*
+      IMPLICIT    NONE
+*
+      INTEGER     NNS,NK,NW(NK),NW2(NK)
+      INTEGER     MODEID,I,IP,NL
+*
+      MODEID = NNS
+*
+*---- MODE DE RECHARGEMENT GENERALISE
+*
+      IF(MODEID.GT.NK) THEN
+        WRITE(6,'(13H @TINFL: NNS=,I6,4H NK=,I6)') NNS,NK
+        CALL XABORT('@TINFL: ONLY BI-DIRECTIONNAL REFUELING ')
+      ELSE
+*
+*------- MODE DE RECHARGEMENT DIRECT
+*
+         NW2(:NK)=0
+         NW(:MODEID)=0
+*
+         IF(MODEID.NE.NK) THEN
+            NL = NK - MODEID
+            DO 20 I=1,NL
+               IP = MODEID + I
+               NW(IP) = I
+               NW2(I)=I+NNS
+  20        CONTINUE
+          ENDIF
+*
+      ENDIF
+      RETURN
+      END
diff --git a/Donjon/src/TINMIC.f b/Donjon/src/TINMIC.f
new file mode 100644
index 0000000..8fa8585
--- /dev/null
+++ b/Donjon/src/TINMIC.f
@@ -0,0 +1,178 @@
+*DECK TINMIC
+      SUBROUTINE TINMIC(IPMIC,IPMIC2,IPMIC3,NB,NCH,NW,ICH,NISO,NISO2,
+     1 IWORK,BSH,NDENS)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Microscopic refueling to update the microlib (micro-depletion)
+*
+*Copyright:
+* Copyright (C) 2010 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* M. Guyot
+*
+*Parameters: input/output
+* IPMIC   Adress of the L_LIBRARY in creation mode.
+* IPMIC2  Adress of the fuel-map L_LIBRARY in read-only mode.
+* IPMIC3  Adress of the L_LIBRARY in read-only mode, containing new
+*         fuel properties.
+* NB      Number of bundles
+* NCH     Number of channels
+* NW      Vector containing new index for the refuelling
+* ICH     Number of the channel to refuel
+* NISO    Number of isotopes in the fuel-map microlib
+* NISO2   Number of isotopes in the third microlib
+* IWORK   Useful vector for refueling
+* BSH     Vector containing new mixtures after shifting
+* NDENS   New isotopic densities after refueling
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMIC,IPMIC2,IPMIC3
+      INTEGER NB,NCH,NW(NB),ICH,NISO,NISO2,IWORK(NB,2),BSH(NB)
+      REAL NDENS(NISO)
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER (IOUT=6,MAXISO=100)
+      INTEGER IB,ISO,ISO2,IMIX,I,SHT(NB),IND(MAXISO),IND2(MAXISO),I1,I2
+      CHARACTER TEXT*12,TEXT2*12
+      LOGICAL LMIX
+      TYPE(C_PTR) JPMIC2,JPMIC3
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: MIX,MIX2,TODO,TODO2,TYP,TYP2
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NAME,NAME2,USED,USED2
+      REAL, ALLOCATABLE, DIMENSION(:) :: DENS,DENS2,TEMP,TEMP2,VOL,VOL2
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(MIX(NISO),MIX2(NISO2),TODO(NISO),TODO2(NISO2),TYP(NISO),
+     1 TYP2(NISO2))
+      ALLOCATE(NAME(3,NISO),NAME2(3,NISO2),USED(3,NISO),USED2(3,NISO2))
+      ALLOCATE(DENS(NISO),DENS2(NISO2),TEMP(NISO),TEMP2(NISO2),
+     1 VOL(NISO),VOL2(NISO2))
+*----
+*  RECOVER INFORMATION
+*----
+      CALL LCMGET(IPMIC2,'ISOTOPESMIX',MIX)
+      CALL LCMGET(IPMIC3,'ISOTOPESMIX',MIX2)
+      CALL LCMGET(IPMIC2,'ISOTOPERNAME',NAME)
+      CALL LCMGET(IPMIC3,'ISOTOPERNAME',NAME2)
+      CALL LCMGET(IPMIC2,'ISOTOPESUSED',USED)
+      CALL LCMGET(IPMIC3,'ISOTOPESUSED',USED2)
+      CALL LCMGET(IPMIC2,'ISOTOPESDENS',DENS)
+      CALL LCMGET(IPMIC3,'ISOTOPESDENS',DENS2)
+      CALL LCMGET(IPMIC2,'ISOTOPESTODO',TODO)
+      CALL LCMGET(IPMIC3,'ISOTOPESTODO',TODO2)
+      CALL LCMGET(IPMIC2,'ISOTOPESTYPE',TYP)
+      CALL LCMGET(IPMIC3,'ISOTOPESTYPE',TYP2)
+      CALL LCMGET(IPMIC2,'ISOTOPESTEMP',TEMP)
+      CALL LCMGET(IPMIC3,'ISOTOPESTEMP',TEMP2)
+      CALL LCMGET(IPMIC2,'ISOTOPESVOL',VOL)
+      CALL LCMGET(IPMIC3,'ISOTOPESVOL',VOL2)
+*----
+*  CHECK IF THE MIXTURES TO SHIFT EXIST IN THE MICROLIB
+*----
+      DO 10 IB=1,NB
+        LMIX=.FALSE.
+        DO 15 ISO2=1,NISO2
+          IF(MIX2(ISO2).EQ.IWORK(IB,2)) THEN
+            LMIX=.TRUE.
+          ENDIF
+ 15     CONTINUE
+        IMIX=MIX2(ISO2)
+        IF(.NOT.LMIX) THEN
+          WRITE(IOUT,*) '@TINMIC: THE MIXTURE ',IMIX,' IS NOT PRESENT '
+     +      //'IN THE MICROLIB FOR THE REFUEL. '
+          CALL XABORT('@TINMIC: REFUELING ERROR. ')
+        ENDIF
+ 10   CONTINUE
+*----
+*  COMPUTE THE VECTORS FOR THE REFUELING
+*----
+*     SHT CONTAINS THE MIXTURES OF THE CHANNEL TO SHIFT
+      SHT(:NB)=0
+      DO I=1,NB
+        SHT(I)=ICH+(I-1)*NCH
+      ENDDO
+*     BSH CONTAINS THE NEW MIXTURE AFTER SHIFTING
+      DO I=1,NB
+        IF(NW(I).EQ.0) THEN
+          BSH(I)=0
+        ELSE
+          BSH(I)=SHT(NW(I))
+        ENDIF
+      ENDDO
+
+      CALL LCMGET(IPMIC,'ISOTOPESDENS',NDENS)
+
+      DO 20 IB=1,NB
+        IND(:MAXISO)=0
+        IND2(:MAXISO)=0
+        I1=0
+        I2=0
+        DO 25 ISO=1,NISO
+          IF(MIX(ISO).EQ.SHT(IB)) THEN
+            I1=I1+1
+            IF(I1.GE.MAXISO) CALL XABORT('@TINMIC: NUMBER OF ISOTOPES'
+     +        //' OVERFLOW(1). ')
+            IND(I1)=ISO
+          ENDIF
+ 25     CONTINUE
+        IF(BSH(IB).EQ.0) THEN
+*       THE PROPERTIES ARE RECOVERED FROM THE THIRD LIBRARY
+          DO 30 ISO2=1,NISO2
+            IF(MIX2(ISO2).EQ.IWORK(IB,2)) THEN
+              I2=I2+1
+              IF(I2.GE.MAXISO) CALL XABORT('@TINMIC: NUMBER OF ISOTOPES'
+     +          //' OVERFLOW(2). ')
+              IND2(I2)=ISO2
+            ENDIF
+ 30       CONTINUE
+          IF(I1.NE.I2) CALL XABORT('@TINMIC: WRONG NUMBER OF ISOTOPES '
+     +      //'IN THE NEW MIXTURE(1). ')
+          DO 35 J=1,I1
+            NDENS(IND(J))=DENS2(IND2(J))
+            WRITE(TEXT,'(3A4)') (USED(I0,IND(J)),I0=1,3)
+            WRITE(TEXT2,'(3A4)') (USED2(I0,IND2(J)),I0=1,3)
+            JPMIC3=LCMGID(IPMIC3,TEXT2)
+            CALL LCMSIX(IPMIC,TEXT,1)
+            CALL LCMEQU(JPMIC3,IPMIC)
+            CALL LCMSIX(IPMIC,' ',2)
+ 35       CONTINUE
+*       THE PROPERTIES ARE RECOVERED FROM THE FUEL MAP LIBRARY
+        ELSE
+          DO 40 ISO=1,NISO
+            IF(MIX(ISO).EQ.BSH(IB)) THEN
+              I2=I2+1
+              IF(I2.GE.MAXISO) CALL XABORT('@TINMIC: NUMBER OF ISOTOPES'
+     +          //' OVERFLOW(3). ')
+              IND2(I2)=ISO
+            ENDIF
+ 40       CONTINUE
+          IF(I1.NE.I2) CALL XABORT('@TINMIC: WRONG NUMBER OF ISOTOPES '
+     +      //'IN THE NEW MIXTURE(2). ')
+          DO 45 J=1,I1
+            NDENS(IND(J))=DENS(IND2(J))
+            WRITE(TEXT,'(3A4)') (USED(I0,IND(J)),I0=1,3)
+            WRITE(TEXT2,'(3A4)') (USED(I0,IND2(J)),I0=1,3)
+            JPMIC2=LCMGID(IPMIC2,TEXT2)
+            CALL LCMSIX(IPMIC,TEXT,1)
+            CALL LCMEQU(JPMIC2,IPMIC)
+            CALL LCMSIX(IPMIC,' ',2)
+ 45       CONTINUE
+        ENDIF
+ 20   CONTINUE
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(VOL2,VOL,TEMP2,TEMP,DENS2,DENS)
+      DEALLOCATE(USED2,USED,NAME2,NAME)
+      DEALLOCATE(TYP2,TYP,TODO2,TODO,MIX2,MIX)
+      RETURN
+      END
diff --git a/Donjon/src/TINREF.f b/Donjon/src/TINREF.f
new file mode 100644
index 0000000..5a7e609
--- /dev/null
+++ b/Donjon/src/TINREF.f
@@ -0,0 +1,347 @@
+*DECK TINREF
+      SUBROUTINE TINREF(IPRES,IPMIC,IPMIC2,IPMIC3,NCH,NK,NX,NY,NZ,NREG,
+     +         NAMCHA,NS,MS,WINT,MIX,IXN,IYN,BS,PS,ISFT,POW,MAXS,NSS,
+     +         IND,IPRT,KRF,LMIC)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Refuel a channel according to a refuelling mode in Cartesian geometry.
+*
+*Copyright:
+* Copyright (C) 2010 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* E. Varin, M. Guyot
+*
+*Parameters: input/output
+* IPRES  Adress of the map Linked_List or XSM file.
+* IPMIC  Adress of the L_LIBRARY in creation mode.
+* IPMIC2 Adress of the fuel-map L_LIBRARY in read-only mode.
+* IPMIC3 Adress of the L_LIBRARY in read-only mode, containing new 
+*        fuel properties.
+* NCH    Number of channels
+* NK     Number of bundles per channel
+* NX     Number of X-Meshes
+* NY     Number of Y-Meshes
+* NZ     Number axial planes
+* NREG   Number of regions in fuel map geometry
+* NAMCHA Name of the channel to refuel
+* NS     Number of bundles inserted
+* MS     Old maximum of shift + 1.
+* MIX    Fuel map bundle index
+* IXN    Name of the channel according to X
+* IYN    Name of the channel according to Y
+* POW    Power distribution.
+* INDEX  Fuel type indice
+* IND    Fuel type indice in the channel to refuel
+* MAXS   Maximum number of power shift
+* IPRT   Flag for printing level
+* KRF    Type of refueling
+* LMIC   =.true. for a micro-refueling
+*
+*Parameters:
+* WINT    
+* BS      
+* PS      
+* ISFT    
+* NSS     
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPRES,IPMIC,IPMIC2,IPMIC3
+      INTEGER     NCH,NK,NX,NY,NZ,NS,NREG,ILONG,ITYP,IX,IY,IPRT,MS,IS,
+     1            MAXS,KS,NSS(NCH),NNS
+      REAL        WINT(NCH,NK),BS(NCH,NK,MS),PS(NCH,NK,MS),POW(NCH,NK)
+      CHARACTER   XNAM*4,YNAM*4,NAMCHA*4,TEXT4*4
+      INTEGER     MIX(NREG),IXN(NX),IYN(NY),ISFT(NCH,NK),IND(*)
+      LOGICAL     LMIC
+      REAL        TMPDAY(3)
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER (NSTATE=40,IOUT=6)
+      INTEGER   ISTATE(NSTATE),I,J
+      CHARACTER CS*2,HSMG*131
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: NW,NW2,NWU,ISONA,ISOMI,ISHF
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ICHMAP,INDEX,IWORK
+      REAL, ALLOCATABLE, DIMENSION(:) :: DENIS,NDENS
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: WORK
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: WORKS
+      LOGICAL, ALLOCATABLE, DIMENSION(:) :: MASK,MASKL
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(NW(NK),NW2(NK),INDEX(NCH,NK),IWORK(NK,2),ICHMAP(NX,NY))
+      ALLOCATE(WORK(NK,2),WORKS(NK,MS,2))
+*----
+*  RECOVER SHIFT VECTOR
+*----
+      CALL LCMLEN(IPRES,'ISHIFT',ILS,ITYLCM)
+      IF(ILS.NE.0) THEN
+        CALL LCMGET(IPRES,'ISHIFT',ISFT(1,1))
+        DO 18 I=1,NK
+         DO 17 J=1,NCH
+            MAXS=MAX(MAXS,ISFT(J,I))
+ 17      CONTINUE
+ 18     CONTINUE
+      ELSE
+        MAXS=0
+        DO 115 I=1,NK
+          DO 15 J=1,NCH
+            ISFT(J,I) = 0
+ 15       CONTINUE
+115     CONTINUE
+      ENDIF
+      DO 1 I=1,NK
+       DO 2 J=1,NCH
+         WINT(J,I) = 0.0
+         DO 3 K=1,MS
+           BS(J,I,K)=0.0
+           PS(J,I,K)=0.0
+  3      CONTINUE
+  2    CONTINUE
+  1   CONTINUE
+*----
+*  RECOVER FUEL BURNUPS
+*----
+      CALL LCMLEN(IPRES,'BURN-INST',ILONG,ITYP)
+      IF(ILONG.EQ.0) THEN
+         CALL XABORT('@TINREF: INITIAL BURNUP REQUIRED')
+      ENDIF
+      CALL LCMGET(IPRES,'BURN-INST',WINT)
+*----
+*  RECOVER FUEL INDEX
+*----
+      CALL LCMLEN(IPRES,'FLMIX',ILONG,ITYP)
+      IF(ILONG.NE.0) THEN
+         CALL LCMGET(IPRES,'FLMIX',INDEX)
+      ELSE
+         CALL XABORT('@TINREF: FLMIX ARE REQUIRED')
+      ENDIF
+
+      IF(MAXS.GT.0) THEN
+        DO 16 IS=1,MAXS
+          WRITE (CS,'(I2)') IS
+          CALL LCMGET(IPRES,'BSHIFT'//CS,BS(1,1,IS))
+          CALL LCMGET(IPRES,'PSHIFT'//CS,PS(1,1,IS))
+ 16     CONTINUE
+      ENDIF
+*----
+*  SET THE CHANNEL INDEX MAP
+*----
+      CALL LCMSIX(IPRES,' ',0)
+      CALL LCMGET(IPRES,'BMIX',MIX)
+      ICHMAP(:NX,:NY)=0
+      ICH=0
+      DO 26 IY=1,NY
+      DO 25 IX=1,NX
+      IEL=(IY-1)*NX+IX
+      DO 23 IZ=1,NZ
+      IF(MIX((IZ-1)*NX*NY+IEL).NE.0) GO TO 24
+  23  CONTINUE
+      GO TO 25
+  24  ICH=ICH+1
+      ICHMAP(IX,IY)=ICH
+  25  CONTINUE
+  26  CONTINUE
+      IF(ICH.NE.NCH) CALL XABORT('@TINREF: INVALID NUMBER OF CHANNELS')
+*----
+*  SEARCH FOR THE CHANNEL NUMBER FROM ITS NAME
+*----
+      TEXT4 = NAMCHA(2:3)
+      IX = 0
+      IY = 0
+      DO 10 I=1,NX
+        WRITE(XNAM,'(A4)') IXN(I)
+        IF (XNAM.EQ.TEXT4) THEN
+           IX = I
+           GOTO 11
+        ENDIF
+  10  CONTINUE
+      WRITE(HSMG,'(26H@TINREF: NO CHANNEL NAMED ,A4,12H IN FUELMAP.)')
+     + NAMCHA
+  11  TEXT4 = NAMCHA(1:1)
+      DO 20 I=1,NY
+        WRITE(YNAM,'(A4)') IYN(I)
+        IF (YNAM.EQ.TEXT4) THEN
+           IY = I
+           GOTO 21
+        ENDIF
+  20  CONTINUE
+      WRITE(HSMG,'(26H@TINREF: NO CHANNEL NAMED ,A4,12H IN FUELMAP.)')
+     + NAMCHA
+      CALL XABORT(HSMG)
+
+  21  ICH=ICHMAP(IX,IY)
+      IF(ICH.EQ.0) THEN
+        WRITE(6,'(13H @TINREF: IX=,I6,4H IY=,I6)') IX,IY
+        WRITE(HSMG,'(23H@TINREF: CHANNEL NAMED ,A4,13H HAS NO FUEL.)')
+     +  NAMCHA
+        CALL XABORT(HSMG)
+      ENDIF
+      IF(NSS(ICH).NE.0) THEN
+        IF(ABS(NSS(ICH)).NE.ABS(NS)) THEN
+          WRITE(6,'(14H @TINREF: ICH=,I6,5H NSS=,I6,4H NS=,I6)') ICH,
+     +    NSS(ICH),NS
+          CALL XABORT('@TINREF: WRONG REFUELING SCHEME')
+        ENDIF
+        NS = NSS(ICH)
+      ENDIF
+      IF( IPRT.GT.3 )THEN
+        WRITE(6,*) ' REFUELING CHANNEL ',NAMCHA,' IX IY ',IX,IY
+        WRITE(6,*) ' REFUELING CHANNEL ',ICH,' SCHEME ',NS
+        WRITE(6,*) ' INITIAL BURNUP ',(WINT(ICH,I),I=1,NK)
+      ENDIF
+
+      NNS = ABS(NS)
+      CALL TINFL(NNS,NW,NW2,NK)
+
+      II=0
+      DO 30 K=1,NK
+         KK = K
+         IF (NS.LT.0) THEN
+            KK = NK - K + 1
+         ENDIF
+         KA = NW(K)
+*----
+*  INSERTION OF A NEW BUNDLE OR REPOSITIONNING
+*----
+         IF (KA.EQ.0) THEN
+            II=II+1
+            WORK(KK,1) = 0.0
+            IWORK(KK,1)=0
+            IF( KRF.EQ.1 )THEN
+              IWORK(KK,2)=INDEX(ICH,KK)
+            ELSE
+              IWORK(KK,2)=IND(II)
+            ENDIF
+            IF(MAXS.GT.0) THEN
+              DO 39 IS=1,MAXS
+                WORKS(KK,IS,1) = 0.0
+                WORKS(KK,IS,2) = 0.0
+  39          CONTINUE
+            ENDIF
+         ELSE
+            IF (NS.LT.0) THEN
+               KA = NK - KA + 1
+            ENDIF
+            WORK(KK,1) = WINT(ICH,KA)
+            WORK(KK,2) = POW(ICH,KA)
+            IWORK(KK,1)= ISFT(ICH,KA)
+            IWORK(KK,2)= INDEX(ICH,KA)
+            IF(MAXS.GT.0) THEN
+              DO 19 IS=1,MAXS
+                WORKS(KK,IS,1) = BS(ICH,KA,IS)
+                WORKS(KK,IS,2) = PS(ICH,KA,IS)
+  19          CONTINUE
+            ENDIF
+         ENDIF
+  30  CONTINUE
+
+      DO 40 K=1,NK
+        WINT(ICH,K) = WORK(K,1)
+        POW(ICH,K) = WORK(K,2)
+        ISFT(ICH,K) = IWORK(K,1)
+        INDEX(ICH,K) = IWORK(K,2)
+        IF(MAXS.GT.0) THEN
+          DO 22 IS=1,MAXS
+            BS(ICH,K,IS)=WORKS(K,IS,1)
+            PS(ICH,K,IS)=WORKS(K,IS,2)
+  22      CONTINUE
+        ENDIF
+        IF(WORK(K,1).NE.0.0) THEN
+          KS=ISFT(ICH,K)+1
+          BS(ICH,K,KS)=WINT(ICH,K)
+          PS(ICH,K,KS)=WORK(K,2)
+          ISFT(ICH,K)=KS
+        ENDIF
+  40  CONTINUE
+
+      MAXS=0
+      DO 112 I=1,NK
+        DO 12 J=1,NCH
+          MAXS=MAX(MAXS,ISFT(J,I))
+  12    CONTINUE
+ 112  CONTINUE
+*----
+* CALL THE SUBROUTINE FOR A MICROSCOPIC REFUEL
+*----
+      IF(LMIC) THEN
+        ISTATE(:NSTATE)=0
+        CALL LCMGET(IPMIC2,'STATE-VECTOR',ISTATE)
+        NISO=ISTATE(2)
+        NDEP=ISTATE(12)
+        IF(NDEP.NE.NK*NCH) CALL XABORT('@TINREF: WRONG NUMBER OF '
+     +  //'DEPLETING MIXTURES IN THE LIBRARY.')
+        ISTATE(:NSTATE)=0
+        CALL LCMGET(IPMIC3,'STATE-VECTOR',ISTATE)
+        NISO2=ISTATE(2)
+        ALLOCATE(NWU(NK))
+        DO I=1,NK
+          IF(NS.GT.0) THEN
+            NWU(I)=NW(I)
+          ELSE
+            NWU(I)=NW2(I)
+          ENDIF
+        ENDDO
+        ALLOCATE(NDENS(NISO),ISHF(NK))
+        CALL TINMIC(IPMIC,IPMIC2,IPMIC3,NK,NCH,NWU,ICH,NISO,NISO2,
+     1  IWORK,ISHF,NDENS)
+        CALL LCMPUT(IPMIC,'ISOTOPESDENS',NISO,2,NDENS)
+*----
+*  COMPUTE THE MACROSCOPIC X-SECTIONS
+*----
+        CALL LCMGET(IPMIC,'STATE-VECTOR',ISTATE)
+        MAXMIX=ISTATE(1)
+        NBISO=ISTATE(2)
+        NGRP=ISTATE(3)
+        ALLOCATE(MASK(MAXMIX),MASKL(NGRP))
+        ALLOCATE(ISONA(3*NBISO),ISOMI(NBISO),DENIS(NBISO))
+        CALL LCMGET(IPMIC,'ISOTOPESUSED',ISONA)
+        CALL LCMGET(IPMIC,'ISOTOPESMIX',ISOMI)
+        CALL LCMGET(IPMIC,'ISOTOPESDENS',DENIS)
+        MASK(:MAXMIX)=.FALSE.
+        MASKL(:NGRP)=.TRUE.
+        DO 13 I=1,NBISO
+          IBM=ISOMI(I)
+          MASK(IBM)=.TRUE.
+  13    CONTINUE
+        ITSTMP=0
+        TMPDAY(1)=0.0
+        TMPDAY(2)=0.0
+        TMPDAY(3)=0.0
+*       COMPUTATION OF THE MACROSCOPIC XS
+        CALL LIBMIX(IPMIC,MAXMIX,NGRP,NBISO,ISONA,ISOMI,DENIS,MASK,
+     1  MASKL,ITSTMP,TMPDAY)
+        DEALLOCATE(DENIS,ISOMI,ISONA,MASKL,MASK)
+        DEALLOCATE(NWU,NDENS,ISHF)
+      ENDIF
+
+      IF( IPRT.GT.3 )THEN
+        WRITE(6,*) ' SHIFTING BURNUP ',(WINT(ICH,I),I=1,NK)
+      ENDIF
+
+      CALL LCMSIX(IPRES,' ',0)
+      IF(IPRT.GT.3) WRITE(6,*) ' REFUELLING TYPE DIRECT OR HOMOGENOUS'
+      CALL LCMPUT(IPRES,'BURN-INST',NCH*NK,2,WINT(1,1))
+      CALL LCMPUT(IPRES,'FLMIX',NCH*NK,1,INDEX(1,1))
+      CALL LCMPUT(IPRES,'ISHIFT',NCH*NK,1,ISFT(1,1))
+
+      IF(MAXS.GT.0) THEN
+        DO 14 IS=1,MAXS
+          WRITE (CS,'(I2)') IS
+          CALL LCMPUT(IPRES,'BSHIFT'//CS,NCH*NK,2,BS(1,1,IS))
+          CALL LCMPUT(IPRES,'PSHIFT'//CS,NCH*NK,2,PS(1,1,IS))
+ 14    CONTINUE
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(WORKS,WORK,ICHMAP,IWORK,INDEX,NW2,NW)
+      RETURN
+      END
diff --git a/Donjon/src/TINREH.f b/Donjon/src/TINREH.f
new file mode 100644
index 0000000..05990ff
--- /dev/null
+++ b/Donjon/src/TINREH.f
@@ -0,0 +1,332 @@
+*DECK TINREH
+      SUBROUTINE TINREH(IPRES,IPMIC,IPMIC2,IPMIC3,NCH,NK,NH,NZ,NREG,
+     +         NAMCHA,NS,MS,WINT,MIX,IHN,BS,PS,ISFT,POW,MAXS,NSS,IND,
+     +         IPRT,KRF,LMIC)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Refuel a channel according to a refuelling mode in hexagonal
+* geometry.
+*
+*Copyright:
+* Copyright (C) 2015 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* E. Varin, M. Guyot and A. Hebert
+*
+*Parameters: input/output
+* IPRES  Adress of the map Linked_List or XSM file.
+* IPMIC  Adress of the L_LIBRARY in creation mode.
+* IPMIC2 Adress of the fuel-map L_LIBRARY in read-only mode.
+* IPMIC3 Adress of the L_LIBRARY in read-only mode, containing new 
+*        fuel properties.
+* NCH    Number of channels
+* NK     Number of bundles per channel
+* NH     Number of hexagons in the plane
+* NZ     Number axial planes
+* NREG   Number of regions in fuel map geometry
+* NAMCHA Name of the channel to refuel
+* NS     Number of bundles inserted
+* MS     Old maximum of shift + 1.
+* MIX    Fuel map bundle index
+* IHN    Name of the channel according to the hexagonal position
+* POW    Power distribution.
+* INDEX  Fuel type indice
+* IND    Fuel type indice in the channel to refuel
+* MAXS   Maximum number of power shift
+* IPRT   Flag for printing level
+* KRF    Type of refueling
+* LMIC   =.true. for a micro-refueling
+*
+*Parameters:
+* WINT   
+* BS     
+* PS     
+* ISFT   
+* NSS    
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPRES,IPMIC,IPMIC2,IPMIC3
+      INTEGER     NCH,NK,NH,NZ,NS,NREG,ILONG,ITYP,IH,IPRT,MS,IS,MAXS,
+     1            KS,NSS(NCH),NNS
+      REAL        WINT(NCH,NK),BS(NCH,NK,MS),PS(NCH,NK,MS),POW(NCH,NK)
+      INTEGER     MIX(NREG),IHN(2,NH),ISFT(NCH,NK),IND(*)
+      LOGICAL     LMIC
+      REAL        TMPDAY(3)
+      CHARACTER   NAMCHA*8
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER (NSTATE=40,IOUT=6)
+      INTEGER   ISTATE(NSTATE),I,J
+      CHARACTER HNAM*8,CS*2,HSMG*131
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: NW,NW2,NWU,ISONA,ISOMI,ISHF,
+     + ICHMAP
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: INDEX,IWORK
+      REAL, ALLOCATABLE, DIMENSION(:) :: DENIS,NDENS
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: WORK
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: WORKS
+      LOGICAL, ALLOCATABLE, DIMENSION(:) :: MASK,MASKL
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(NW(NK),NW2(NK),INDEX(NCH,NK),IWORK(NK,2),ICHMAP(NH))
+      ALLOCATE(WORK(NK,2),WORKS(NK,MS,2))
+*----
+*  RECOVER SHIFT VECTOR
+*----
+      CALL LCMLEN(IPRES,'ISHIFT',ILS,ITYLCM)
+      IF(ILS.NE.0) THEN
+        CALL LCMGET(IPRES,'ISHIFT',ISFT(1,1))
+        DO 18 I=1,NK
+         DO 17 J=1,NCH
+            MAXS=MAX(MAXS,ISFT(J,I))
+ 17      CONTINUE
+ 18     CONTINUE
+      ELSE
+        MAXS=0
+        DO 115 I=1,NK
+          DO 15 J=1,NCH
+            ISFT(J,I) = 0
+ 15       CONTINUE
+115     CONTINUE
+      ENDIF
+      DO 1 I=1,NK
+       DO 2 J=1,NCH
+         WINT(J,I) = 0.0
+         DO 3 K=1,MS
+           BS(J,I,K)=0.0
+           PS(J,I,K)=0.0
+  3      CONTINUE
+  2    CONTINUE
+  1   CONTINUE
+*----
+*  RECOVER FUEL BURNUPS
+*----
+      CALL LCMLEN(IPRES,'BURN-INST',ILONG,ITYP)
+      IF(ILONG.EQ.0) THEN
+         CALL XABORT('@TINREH: INITIAL BURNUP REQUIRED')
+      ENDIF
+      CALL LCMGET(IPRES,'BURN-INST',WINT)
+*----
+*  RECOVER FUEL INDEX
+*----
+      CALL LCMLEN(IPRES,'FLMIX',ILONG,ITYP)
+      IF(ILONG.NE.0) THEN
+         CALL LCMGET(IPRES,'FLMIX',INDEX)
+      ELSE
+         CALL XABORT('@TINREH: FLMIX ARE REQUIRED')
+      ENDIF
+
+      IF(MAXS.GT.0) THEN
+        DO 16 IS=1,MAXS
+          WRITE (CS,'(I2)') IS
+          CALL LCMGET(IPRES,'BSHIFT'//CS,BS(1,1,IS))
+          CALL LCMGET(IPRES,'PSHIFT'//CS,PS(1,1,IS))
+ 16     CONTINUE
+      ENDIF
+*----
+*  SET THE CHANNEL INDEX MAP
+*----
+      CALL LCMSIX(IPRES,' ',0)
+      CALL LCMGET(IPRES,'BMIX',MIX)
+      ICHMAP(:NH)=0
+      ICH=0
+      DO 25 IH=1,NH
+      DO 23 IZ=1,NZ
+      IF(MIX((IZ-1)*NH+IH).NE.0) GO TO 24
+  23  CONTINUE
+      GO TO 25
+  24  ICH=ICH+1
+      ICHMAP(IH)=ICH
+  25  CONTINUE
+      IF(ICH.NE.NCH) CALL XABORT('@TINREH: INVALID NUMBER OF CHANNELS')
+*----
+*  SEARCH FOR THE CHANNEL NUMBER FROM ITS NAME
+*----
+      IH = 0
+      DO 10 I=1,NH
+        WRITE(HNAM,'(2A4)') IHN(1,I),IHN(2,I)
+        IF (HNAM.EQ.NAMCHA) THEN
+           IH = I
+           GOTO 21
+        ENDIF
+  10  CONTINUE
+      WRITE(HSMG,'(26H@TINREH: NO CHANNEL NAMED ,A8,12H IN FUELMAP.)')
+     + NAMCHA
+      CALL XABORT(HSMG)
+
+  21  ICH=ICHMAP(IH)
+      IF(ICH.EQ.0) THEN
+        WRITE(6,'(13H @TINREH: IH=,I6)') IH
+        WRITE(HSMG,'(23H@TINREH: CHANNEL NAMED ,A8,13H HAS NO FUEL.)')
+     +  NAMCHA
+        CALL XABORT(HSMG)
+      ENDIF
+      IF(NSS(ICH).NE.0) THEN
+        IF(ABS(NSS(ICH)).NE.ABS(NS)) THEN
+          WRITE(6,'(14H @TINREH: ICH=,I6,5H NSS=,I6,4H NS=,I6)') ICH,
+     +    NSS(ICH),NS
+          CALL XABORT('@TINREH: WRONG REFUELING SCHEME')
+        ENDIF
+        NS = NSS(ICH)
+      ENDIF
+      IF( IPRT.GT.3 )THEN
+        WRITE(6,*) ' REFUELING CHANNEL ',NAMCHA,' IH ',IH
+        WRITE(6,*) ' REFUELING CHANNEL ',ICH,' SCHEME ',NS
+        WRITE(6,*) ' INITIAL BURNUP ',(WINT(ICH,I),I=1,NK)
+      ENDIF
+
+      NNS = ABS(NS)
+      CALL TINFL(NNS,NW,NW2,NK)
+
+      II=0
+      DO 30 K=1,NK
+         KK = K
+         IF (NS.LT.0) THEN
+            KK = NK - K + 1
+         ENDIF
+         KA = NW(K)
+*----
+*  INSERTION OF A NEW BUNDLE OR REPOSITIONNING
+*----
+         IF (KA.EQ.0) THEN
+            II=II+1
+            WORK(KK,1) = 0.0
+            IWORK(KK,1)=0
+            IF( KRF.EQ.1 )THEN
+              IWORK(KK,2)=INDEX(ICH,KK)
+            ELSE
+              IWORK(KK,2)=IND(II)
+            ENDIF
+            IF(MAXS.GT.0) THEN
+              DO 39 IS=1,MAXS
+                WORKS(KK,IS,1) = 0.0
+                WORKS(KK,IS,2) = 0.0
+  39          CONTINUE
+            ENDIF
+         ELSE
+            IF (NS.LT.0) THEN
+               KA = NK - KA + 1
+            ENDIF
+            WORK(KK,1) = WINT(ICH,KA)
+            WORK(KK,2) = POW(ICH,KA)
+            IWORK(KK,1)= ISFT(ICH,KA)
+            IWORK(KK,2)= INDEX(ICH,KA)
+            IF(MAXS.GT.0) THEN
+              DO 19 IS=1,MAXS
+                WORKS(KK,IS,1) = BS(ICH,KA,IS)
+                WORKS(KK,IS,2) = PS(ICH,KA,IS)
+  19          CONTINUE
+            ENDIF
+         ENDIF
+  30  CONTINUE
+
+      DO 40 K=1,NK
+        WINT(ICH,K) = WORK(K,1)
+        POW(ICH,K) = WORK(K,2)
+        ISFT(ICH,K) = IWORK(K,1)
+        INDEX(ICH,K) = IWORK(K,2)
+        IF(MAXS.GT.0) THEN
+          DO 22 IS=1,MAXS
+            BS(ICH,K,IS)=WORKS(K,IS,1)
+            PS(ICH,K,IS)=WORKS(K,IS,2)
+  22      CONTINUE
+        ENDIF
+        IF(WORK(K,1).NE.0.0) THEN
+          KS=ISFT(ICH,K)+1
+          BS(ICH,K,KS)=WINT(ICH,K)
+          PS(ICH,K,KS)=WORK(K,2)
+          ISFT(ICH,K)=KS
+        ENDIF
+  40  CONTINUE
+
+      MAXS=0
+      DO 112 I=1,NK
+        DO 12 J=1,NCH
+          MAXS=MAX(MAXS,ISFT(J,I))
+  12    CONTINUE
+ 112  CONTINUE
+*----
+* CALL THE SUBROUTINE FOR A MICROSCOPIC REFUEL
+*----
+      IF(LMIC) THEN
+        ISTATE(:NSTATE)=0
+        CALL LCMGET(IPMIC2,'STATE-VECTOR',ISTATE)
+        NISO=ISTATE(2)
+        NDEP=ISTATE(12)
+        IF(NDEP.NE.NK*NCH) CALL XABORT('@TINREH: WRONG NUMBER OF '
+     +  //'DEPLETING MIXTURES IN THE LIBRARY.')
+        ISTATE(:NSTATE)=0
+        CALL LCMGET(IPMIC3,'STATE-VECTOR',ISTATE)
+        NISO2=ISTATE(2)
+        ALLOCATE(NWU(NK))
+        DO I=1,NK
+          IF(NS.GT.0) THEN
+            NWU(I)=NW(I)
+          ELSE
+            NWU(I)=NW2(I)
+          ENDIF
+        ENDDO
+        ALLOCATE(NDENS(NISO),ISHF(NK))
+        CALL TINMIC(IPMIC,IPMIC2,IPMIC3,NK,NCH,NWU,ICH,NISO,NISO2,
+     1  IWORK,ISHF,NDENS)
+        CALL LCMPUT(IPMIC,'ISOTOPESDENS',NISO,2,NDENS)
+*----
+*  COMPUTE THE MACROSCOPIC X-SECTIONS
+*----
+        CALL LCMGET(IPMIC,'STATE-VECTOR',ISTATE)
+        MAXMIX=ISTATE(1)
+        NBISO=ISTATE(2)
+        NGRP=ISTATE(3)
+        ALLOCATE(MASK(MAXMIX),MASKL(NGRP))
+        ALLOCATE(ISONA(3*NBISO),ISOMI(NBISO),DENIS(NBISO))
+        CALL LCMGET(IPMIC,'ISOTOPESUSED',ISONA)
+        CALL LCMGET(IPMIC,'ISOTOPESMIX',ISOMI)
+        CALL LCMGET(IPMIC,'ISOTOPESDENS',DENIS)
+        MASK(:MAXMIX)=.FALSE.
+        MASKL(:NGRP)=.TRUE.
+        DO 13 I=1,NBISO
+          IBM=ISOMI(I)
+          MASK(IBM)=.TRUE.
+  13    CONTINUE
+        ITSTMP=0
+        TMPDAY(1)=0.0
+        TMPDAY(2)=0.0
+        TMPDAY(3)=0.0
+*       COMPUTATION OF THE MACROSCOPIC XS
+        CALL LIBMIX(IPMIC,MAXMIX,NGRP,NBISO,ISONA,ISOMI,DENIS,MASK,
+     1  MASKL,ITSTMP,TMPDAY)
+        DEALLOCATE(DENIS,ISOMI,ISONA,MASKL,MASK)
+        DEALLOCATE(NWU,NDENS,ISHF)
+      ENDIF
+
+      IF( IPRT.GT.3 )THEN
+        WRITE(6,*) ' SHIFTING BURNUP ',(WINT(ICH,I),I=1,NK)
+      ENDIF
+
+      CALL LCMSIX(IPRES,' ',0)
+      IF(IPRT.GT.3) WRITE(6,*) ' REFUELLING TYPE DIRECT OR HOMOGENOUS'
+      CALL LCMPUT(IPRES,'BURN-INST',NCH*NK,2,WINT(1,1))
+      CALL LCMPUT(IPRES,'FLMIX',NCH*NK,1,INDEX(1,1))
+      CALL LCMPUT(IPRES,'ISHIFT',NCH*NK,1,ISFT(1,1))
+
+      IF(MAXS.GT.0) THEN
+        DO 14 IS=1,MAXS
+          WRITE (CS,'(I2)') IS
+          CALL LCMPUT(IPRES,'BSHIFT'//CS,NCH*NK,2,BS(1,1,IS))
+          CALL LCMPUT(IPRES,'PSHIFT'//CS,NCH*NK,2,PS(1,1,IS))
+ 14    CONTINUE
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(WORKS,WORK,ICHMAP,IWORK,INDEX,NW2,NW)
+      RETURN
+      END
diff --git a/Donjon/src/TINSHH.f b/Donjon/src/TINSHH.f
new file mode 100644
index 0000000..9cfa8c5
--- /dev/null
+++ b/Donjon/src/TINSHH.f
@@ -0,0 +1,243 @@
+*DECK TINSHH
+      SUBROUTINE TINSHH(IPRES,NCH,NK,NH,NZ,NREG,MS,NAMCHA,NAMCH2,
+     + WINT,MIX,BS,PS,ISFT,IHN,IPRT)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute new burnup values per channel after shuffling of two
+* channels in hexagonal geometry.
+*
+*Copyright:
+* Copyright (C) 2015 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* E. Varin, M. Guyot and A. Hebert
+*
+*Parameters: input/output
+* IPRES  ßAdress of the map Linked_List or XSM file.
+* NAMCHA Name of the channel to refuel
+* NAMCH2 Name of the channel to refuel
+* NS     Number of bundles inserted
+* MIX    Fuel map bundle index
+* MS     Maximum number of power shift
+*
+*Parameters:
+* NCH      
+* NK       
+* NH       
+* NZ       
+* NREG     
+* WINT     
+* BS       
+* PS       
+* ISFT     
+* IHN      
+* IPRT     
+*      
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPRES
+      INTEGER     NCH,NK,NH,NZ,NREG,ILONG,ITYP,IPRT,ICH1,ICH2,ILS,
+     1            ITYLCM,IS,MAXS,MS
+      REAL        WINT(NCH,NK),BS(NCH,NK,MS),PS(NCH,NK,MS)
+      INTEGER     MIX(NREG),IHN(2,NH),ISFT(NCH,NK)
+      CHARACTER   NAMCHA*8,NAMCH2*8
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER ICH,I,J,IZ,IH
+      CHARACTER HNAM*8,CS*2,HSMG*131
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: ICHMAP
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: INDEX
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: POOL
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(ICHMAP(NH),INDEX(NCH,NK),POOL(NCH,NK))
+*----
+*  RECOVER INFORMATIONS FROM FUEL MAP OBJECT
+*----
+      DO 1 I=1,NK
+       DO 2 J=1,NCH
+         WINT(J,I) = 0.0
+         ISFT(J,I) = 0
+         POOL(J,I) = 0.0
+         DO 3 IS=1,MS
+           BS(J,I,IS)=0.0
+           PS(J,I,IS)=0.0
+  3      CONTINUE
+  2   CONTINUE
+  1   CONTINUE
+*----
+*  RECOVER FUEL BURNUPS
+*----
+      CALL LCMLEN(IPRES,'BURN-INST',ILONG,ITYP)
+      IF(ILONG.EQ.0) THEN
+         CALL XABORT('@TINSHH: INITIAL BURNUP REQUIRED')
+      ENDIF
+      CALL LCMGET(IPRES,'BURN-INST',WINT(1,1))
+*----
+*  RECOVER FUEL INDEX
+*----
+      CALL LCMLEN(IPRES,'FLMIX',ILONG,ITYP)
+      IF(ILONG.NE.0) THEN
+         CALL LCMGET(IPRES,'FLMIX',INDEX)
+      ELSE
+         CALL XABORT('@TINSHH: FLMIX ARE REQUIRED')
+      ENDIF
+*----
+*  RECOVER SHIFT VECTOR
+*----
+      MAXS=0
+      CALL LCMLEN(IPRES,'ISHIFT',ILS,ITYLCM)
+      IF(ILS.NE.0) THEN
+        CALL LCMGET(IPRES,'ISHIFT',ISFT(1,1))
+        DO 16 I=1,NK
+         DO 15 J=1,NCH
+            MAXS=MAX(MAXS,ISFT(J,I))
+ 15     CONTINUE
+ 16     CONTINUE
+      ELSE
+        MAXS=0
+      ENDIF
+
+      IF(MAXS.GT.0) THEN
+        DO 17 IS=1,MAXS
+          WRITE (CS,'(I2)') IS
+          CALL LCMGET(IPRES,'BSHIFT'//CS,BS(1,1,IS))
+          CALL LCMGET(IPRES,'PSHIFT'//CS,PS(1,1,IS))
+ 17     CONTINUE
+      ENDIF
+*----
+*  SET THE CHANNEL INDEX MAP
+*----
+      CALL LCMSIX(IPRES,' ',0)
+      CALL LCMGET(IPRES,'BMIX',MIX)
+      ICHMAP(:NH)=0
+      ICH=0
+      DO 25 IH=1,NH
+      DO 23 IZ=1,NZ
+      IF(MIX((IZ-1)*NH+IH).NE.0) GO TO 24
+  23  CONTINUE
+      GO TO 25
+  24  ICH=ICH+1
+      ICHMAP(IH)=ICH
+  25  CONTINUE
+      IF(ICH.NE.NCH) CALL XABORT('@TINSHH: INVALID NUMBER OF CHANNELS')
+*----
+*  SEARCH FOR CHANNEL NUMBER TO MOVE
+*----
+      IH = 0
+      DO 10 I=1,NH
+        WRITE(HNAM,'(2A4)') IHN(1,I),IHN(2,I)
+        IF (HNAM.EQ.NAMCHA) THEN
+           IH = I
+           GOTO 21
+        ENDIF
+  10  CONTINUE
+      WRITE(HSMG,'(26H@TINREH: NO CHANNEL NAMED ,A8,12H IN FUELMAP.)')
+     + NAMCHA
+      CALL XABORT(HSMG)
+
+  21  ICH1 = ICHMAP(IH)
+      IF(ICH1.EQ.0) THEN
+        WRITE(6,'(13H @TINSHH: IH=,I6)') IH
+        WRITE(HSMG,'(23H@TINSHH: CHANNEL NAMED ,A4,13H HAS NO FUEL.)')
+     +  NAMCHA
+        CALL XABORT(HSMG)
+      ENDIF
+      IF(IPRT.GT.3) THEN
+        WRITE(6,*)
+        WRITE(6,*) ' SHUFFLING CHANNEL ',NAMCHA,ICH1
+        WRITE(6,*) ' BEFORE ',NAMCHA,(WINT(ICH1,I),I=1,NK)
+      ENDIF
+*----
+*  SEARCH FOR CHANNEL NUMBER WHERE TO MOVE
+*----
+      IF(NAMCH2.NE.'POOL') THEN
+        IH = 0
+        DO 40 I=1,NH
+          WRITE(HNAM,'(2A4)') IHN(1,I),IHN(2,I)
+          IF (HNAM.EQ.NAMCH2) THEN
+             IH = I
+             GOTO 41
+          ENDIF
+  40    CONTINUE
+        WRITE(HSMG,'(26H@TINREH: NO CHANNEL NAMED ,A8,12H IN FUELMAP.)')
+     +  NAMCHA
+        CALL XABORT(HSMG)
+
+  41    ICH2 = ICHMAP(IH)
+        IF(ICH2.EQ.0) CALL XABORT('@TINSHH: WRONG CHANNEL NAME')
+        IF(IPRT.GT.3) THEN
+          WRITE(6,*)
+          WRITE(6,*) ' SHUFFLING CHANNEL ',NAMCH2,ICH2
+          WRITE(6,*) ' BEFORE ',NAMCH2,(WINT(ICH2,I),I=1,NK)
+        ENDIF
+*----
+*  SHUFFLING
+*----
+        DO 50 I=1,NK
+          IF(WINT(ICH2,I).NE.0.0) THEN
+             WRITE(6,*) ' BURNUP ',WINT(ICH2,I)
+             CALL XABORT('@TINSHH: WRONG POSITION TO SHUFFLE, '
+     +          //'CHANNEL NOT EMPTY')
+          ENDIF
+          WINT(ICH2,I) = WINT(ICH1,I)
+          WINT(ICH1,I) = 0.0
+          ISFT(ICH2,I) = ISFT(ICH1,I)
+          ISFT(ICH1,I) = 0
+          INDEX(ICH2,I) = INDEX(ICH1,I)
+          IF(MAXS.GT.0) THEN
+             DO 56 IS=1,MAXS
+               BS(ICH2,I,IS) = BS(ICH1,I,IS)
+               PS(ICH2,I,IS) = PS(ICH1,I,IS)
+               BS(ICH1,I,IS) = 0.0
+               PS(ICH1,I,IS) = 0.0
+  56         CONTINUE
+          ENDIF
+  50    CONTINUE
+        IF(IPRT.GT.3) THEN
+          WRITE(6,*)
+          WRITE(6,*) ' AFTER ',NAMCH2,(WINT(ICH2,I),I=1,NK)
+        ENDIF
+      ELSE
+        WRITE(6,*) ' CHANNEL TO POOL '
+*----
+*  RECOVER DISCHARGED FUEL BURNUPS
+*----
+        CALL LCMLEN(IPRES,'BURN-POOL',ILONG,ITYP)
+        IF(ILONG.NE.0) THEN
+           CALL LCMGET(IPRES,'BURN-POOL',POOL(1,1))
+        ENDIF
+        DO 51 I=1,NK
+          POOL(ICH1,I) = WINT(ICH1,I)
+          WINT(ICH1,I) = 0.0
+  51    CONTINUE
+        CALL LCMPUT(IPRES,'BURN-POOL',NCH*NK,2,POOL(1,1))
+      ENDIF
+      IF(IPRT.GT.3)
+     +    WRITE(6,*) ' AFTER ',NAMCHA,(WINT(ICH1,I),I=1,NK)
+      CALL LCMSIX(IPRES,' ',0)
+      CALL LCMPUT(IPRES,'BURN-INST',NCH*NK,2,WINT(1,1))
+      CALL LCMPUT(IPRES,'FLMIX',NCH*NK,1,INDEX(1,1))
+      CALL LCMPUT(IPRES,'ISHIFT',NCH*NK,1,ISFT(1,1))
+      IF(MAXS.GT.0) THEN
+        DO 53 IS=1,MAXS
+          WRITE (CS,'(I2)') IS
+          CALL LCMPUT(IPRES,'BSHIFT'//CS,NCH*NK,2,BS(1,1,IS))
+          CALL LCMPUT(IPRES,'PSHIFT'//CS,NCH*NK,2,PS(1,1,IS))
+ 53     CONTINUE
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(POOL,INDEX,ICHMAP)
+      RETURN
+      END
diff --git a/Donjon/src/TINSHU.f b/Donjon/src/TINSHU.f
new file mode 100644
index 0000000..9c31b9b
--- /dev/null
+++ b/Donjon/src/TINSHU.f
@@ -0,0 +1,274 @@
+*DECK TINSHU
+      SUBROUTINE TINSHU(IPRES,NCH,NK,NX,NY,NZ,NREG,MS,NAMCHA,NAMCH2,
+     + WINT,MIX,BS,PS,ISFT,IXN,IYN,IPRT)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute new burnup values per channel after shuffling of two
+* channels
+*
+*Copyright:
+* Copyright (C) 2010 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* E. Varin, M. Guyot
+*
+*Parameters: input/output
+* IPRES  Adress of the map Linked_List or XSM file.
+* NAMCHA Name of the channel to refuel
+* NAMCH2 Name of the channel to refuel
+* NS     Number of bundles inserted
+* MIX    Fuel map bundle index
+* MS     Maximum number of power shift
+*
+*Parameters: 
+* NCH       
+* NK        
+* NX        
+* NY        
+* NZ        
+* NREG      
+* WINT      
+* BS        
+* PS        
+* ISFT      
+* IXN       
+* IYN       
+* IPRT
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+      IMPLICIT NONE
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPRES
+      INTEGER     NCH,NK,NX,NY,NZ,NREG,ILONG,ITYP,IX,IY,IPRT,
+     1            ICH1,ICH2,ILS,ITYLCM,IS,MAXS,MS
+      REAL        WINT(NCH,NK),BS(NCH,NK,MS),PS(NCH,NK,MS)
+      CHARACTER   XNAM*4,YNAM*4,NAMCHA*4,NAMCH2*4,TEXT4*4,CS*2
+      INTEGER     MIX(NREG),IXN(NX),IYN(NY),ISFT(NCH,NK)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER ICH,IEL,I,J,IZ
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ICHMAP
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: INDEX
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: POOL
+      CHARACTER HSMG*131
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(ICHMAP(NX,NY),INDEX(NCH,NK),POOL(NCH,NK))
+*----
+*  RECOVER INFORMATIONS FROM FUEL MAP OBJECT
+*----
+      DO 1 I=1,NK
+       DO 2 J=1,NCH
+         WINT(J,I) = 0.0
+         ISFT(J,I) = 0
+         POOL(J,I) = 0.0
+         DO 3 IS=1,MS
+           BS(J,I,IS)=0.0
+           PS(J,I,IS)=0.0
+  3      CONTINUE
+  2   CONTINUE
+  1   CONTINUE
+*----
+*  RECOVER FUEL BURNUPS
+*----
+      CALL LCMLEN(IPRES,'BURN-INST',ILONG,ITYP)
+      IF(ILONG.EQ.0) THEN
+         CALL XABORT('@TINSHU: INITIAL BURNUP REQUIRED')
+      ENDIF
+      CALL LCMGET(IPRES,'BURN-INST',WINT(1,1))
+*----
+*  RECOVER FUEL INDEX
+*----
+      CALL LCMLEN(IPRES,'FLMIX',ILONG,ITYP)
+      IF(ILONG.NE.0) THEN
+         CALL LCMGET(IPRES,'FLMIX',INDEX)
+      ELSE
+         CALL XABORT('@TINSHU: FLMIX ARE REQUIRED')
+      ENDIF
+*----
+*  RECOVER SHIFT VECTOR
+*----
+      MAXS=0
+      CALL LCMLEN(IPRES,'ISHIFT',ILS,ITYLCM)
+      IF(ILS.NE.0) THEN
+        CALL LCMGET(IPRES,'ISHIFT',ISFT(1,1))
+        DO 16 I=1,NK
+         DO 15 J=1,NCH
+            MAXS=MAX(MAXS,ISFT(J,I))
+ 15     CONTINUE
+ 16     CONTINUE
+      ELSE
+        MAXS=0
+      ENDIF
+
+      IF(MAXS.GT.0) THEN
+        DO 17 IS=1,MAXS
+          WRITE (CS,'(I2)') IS
+          CALL LCMGET(IPRES,'BSHIFT'//CS,BS(1,1,IS))
+          CALL LCMGET(IPRES,'PSHIFT'//CS,PS(1,1,IS))
+ 17     CONTINUE
+      ENDIF
+*----
+*  SET THE CHANNEL INDEX MAP
+*----
+      CALL LCMSIX(IPRES,' ',0)
+      CALL LCMGET(IPRES,'BMIX',MIX)
+      ICHMAP(:NX,:NY)=0
+      ICH=0
+      DO 26 IY=1,NY
+      DO 25 IX=1,NX
+      IEL=(IY-1)*NX+IX
+      DO 23 IZ=1,NZ
+      IF(MIX((IZ-1)*NX*NY+IEL).NE.0) GO TO 24
+  23  CONTINUE
+      GO TO 25
+  24  ICH=ICH+1
+      ICHMAP(IX,IY)=ICH
+  25  CONTINUE
+  26  CONTINUE
+      IF(ICH.NE.NCH) CALL XABORT('@TINSHU: INVALID NUMBER OF CHANNELS')
+*----
+*  SEARCH FOR CHANNEL NUMBER TO MOVE
+*----
+      TEXT4 = NAMCHA(2:3)
+      IX = 0
+      IY = 0
+      DO 10 I=1,NX
+        WRITE(XNAM,'(A4)') IXN(I)
+        IF (XNAM.EQ.TEXT4) THEN
+           IX = I
+           GOTO 11
+        ENDIF
+  10  CONTINUE
+      WRITE(HSMG,'(26H@TINSHU: NO CHANNEL NAMED ,A4,12H IN FUELMAP.)')
+     + NAMCHA
+      CALL XABORT(HSMG)
+  11  TEXT4 = NAMCHA(1:1)
+      DO 20 I=1,NY
+        WRITE(YNAM,'(A4)') IYN(I)
+        IF (YNAM.EQ.TEXT4) THEN
+           IY = I
+           GOTO 21
+        ENDIF
+  20  CONTINUE
+      WRITE(HSMG,'(26H@TINSHU: NO CHANNEL NAMED ,A4,12H IN FUELMAP.)')
+     + NAMCHA
+      CALL XABORT(HSMG)
+
+  21  ICH1 = ICHMAP(IX,IY)
+      IF(ICH1.EQ.0) THEN
+        WRITE(6,'(13H @TINSHU: IX=,I6,4H IY=,I6)') IX,IY
+        WRITE(HSMG,'(23H@TINREF: CHANNEL NAMED ,A4,13H HAS NO FUEL.)')
+     +  NAMCHA
+        CALL XABORT(HSMG)
+      ENDIF
+      IF(IPRT.GT.3) THEN
+        WRITE(6,*)
+        WRITE(6,*) ' SHUFFLING CHANNEL ',NAMCHA,ICH1
+        WRITE(6,*) ' BEFORE ',NAMCHA,(WINT(ICH1,I),I=1,NK)
+      ENDIF
+*----
+*  SEARCH FOR CHANNEL NUMBER WHERE TO MOVE
+*----
+      IF(NAMCH2.NE.'POOL') THEN
+        TEXT4 = NAMCH2(2:3)
+        IX = 1
+        IY = 1
+        DO 30 I=1,NX
+          WRITE(XNAM,'(A4)') IXN(I)
+          IF (XNAM.EQ.TEXT4) THEN
+             IX = I
+             GOTO 31
+          ENDIF
+  30    CONTINUE
+        WRITE(HSMG,'(26H@TINSHU: NO CHANNEL NAMED ,A4,12H IN FUELMAP.)')
+     +  NAMCHA
+        CALL XABORT(HSMG)
+  31    TEXT4 = NAMCH2(1:1)
+        DO 40 I=1,NY
+          WRITE(YNAM,'(A4)') IYN(I)
+          IF (YNAM.EQ.TEXT4) THEN
+             IY = I
+             GOTO 41
+          ENDIF
+  40    CONTINUE
+        WRITE(HSMG,'(26H@TINSHU: NO CHANNEL NAMED ,A4,12H IN FUELMAP.)')
+     +  NAMCHA
+        CALL XABORT(HSMG)
+
+  41    ICH2 = ICHMAP(IX,IY)
+        IF(ICH2.EQ.0) CALL XABORT('@TINSHU: WRONG CHANNEL NAME')
+        IF(IPRT.GT.3) THEN
+          WRITE(6,*)
+          WRITE(6,*) ' SHUFFLING CHANNEL ',NAMCH2,ICH2
+          WRITE(6,*) ' BEFORE ',NAMCH2,(WINT(ICH2,I),I=1,NK)
+        ENDIF
+*----
+*  SHUFFLING
+*----
+        DO 50 I=1,NK
+          IF(WINT(ICH2,I).NE.0.0) THEN
+             WRITE(6,*) ' BURNUP ',WINT(ICH2,I)
+             CALL XABORT('@TINSHU: WRONG POSITION TO SHUFFLE, '
+     +          //'CHANNEL NOT EMPTY')
+          ENDIF
+          WINT(ICH2,I) = WINT(ICH1,I)
+          WINT(ICH1,I) = 0.0
+          ISFT(ICH2,I) = ISFT(ICH1,I)
+          ISFT(ICH1,I) = 0
+          INDEX(ICH2,I) = INDEX(ICH1,I)
+          IF(MAXS.GT.0) THEN
+             DO 56 IS=1,MAXS
+               BS(ICH2,I,IS) = BS(ICH1,I,IS)
+               PS(ICH2,I,IS) = PS(ICH1,I,IS)
+               BS(ICH1,I,IS) = 0.0
+               PS(ICH1,I,IS) = 0.0
+  56         CONTINUE
+          ENDIF
+  50    CONTINUE
+        IF(IPRT.GT.3) THEN
+          WRITE(6,*)
+          WRITE(6,*) ' AFTER ',NAMCH2,(WINT(ICH2,I),I=1,NK)
+        ENDIF
+      ELSE
+        WRITE(6,*) ' CHANNEL TO POOL '
+*----
+*  RECOVER DISCHARGED FUEL BURNUPS
+*----
+        CALL LCMLEN(IPRES,'BURN-POOL',ILONG,ITYP)
+        IF(ILONG.NE.0) THEN
+           CALL LCMGET(IPRES,'BURN-POOL',POOL(1,1))
+        ENDIF
+        DO 51 I=1,NK
+          POOL(ICH1,I) = WINT(ICH1,I)
+          WINT(ICH1,I) = 0.0
+  51    CONTINUE
+        CALL LCMPUT(IPRES,'BURN-POOL',NCH*NK,2,POOL(1,1))
+      ENDIF
+      IF(IPRT.GT.3)
+     +    WRITE(6,*) ' AFTER ',NAMCHA,(WINT(ICH1,I),I=1,NK)
+      CALL LCMSIX(IPRES,' ',0)
+      CALL LCMPUT(IPRES,'BURN-INST',NCH*NK,2,WINT(1,1))
+      CALL LCMPUT(IPRES,'FLMIX',NCH*NK,1,INDEX(1,1))
+      CALL LCMPUT(IPRES,'ISHIFT',NCH*NK,1,ISFT(1,1))
+      IF(MAXS.GT.0) THEN
+        DO 53 IS=1,MAXS
+          WRITE (CS,'(I2)') IS
+          CALL LCMPUT(IPRES,'BSHIFT'//CS,NCH*NK,2,BS(1,1,IS))
+          CALL LCMPUT(IPRES,'PSHIFT'//CS,NCH*NK,2,PS(1,1,IS))
+ 53     CONTINUE
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(POOL,INDEX,ICHMAP)
+      RETURN
+      END
diff --git a/Donjon/src/TINST.f b/Donjon/src/TINST.f
new file mode 100644
index 0000000..7ee314c
--- /dev/null
+++ b/Donjon/src/TINST.f
@@ -0,0 +1,454 @@
+*DECK TINST
+      SUBROUTINE TINST(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Perform computations according to the time-linear model.
+*
+*Copyright:
+* Copyright (C) 2009 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* B. Toueg, M. Guyot
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The TINST: module specification is:
+* Option 1
+* FMAP := TINST: FMAP [ POWER ] :: (desctinst) ;
+* Option 2  
+* MICLIB3 FMAP := TINST: FMAP MICLIB2 MICLIB :: (desctinst) ;
+* where
+*   FMAP : name of a \emph{fmap} object, that will be updated by the TINST: 
+*     module. The FMAP object must contain the instantaneous burnups for each 
+*     fuel bundle and the weight of each fuel mixture.
+*   POWER : name of a \emph{power} object containing the channel and bundle 
+*     powers, previously computed by the FLPOW: module. The channel and bundle 
+*     powers are used by the TINST: module to compute the new burn-up of each 
+*     bundle. If bundle-powers are previously specified with the module RESINI:,
+*     you can refuel your core without a POWER object.
+*   MICLIB3 : name of a \emph{library} object, that will be created by the 
+*     TINST: module. This \emph{MICROLIB} contains the fuel properties after 
+*     refueling when keyword MICRO is used in (desctinst).
+* 
+*   MICLIB2 : name of a \emph{library} object, that will be read by the TINST: 
+*     module. This must be a fuel-map LIBRARY created either created by the 
+*     NCR: or the EVO: module.
+*   MICLIB : name of a \emph{library} object, that will be read by the TINST: 
+*     module. This \emph{MICROLIB} contains the new fuel properties, that 
+*     should be used for the refueling.
+*   (desctinst) : structure describing the input data to the TINST: module.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(NSTATE=40,IOUT=6)
+      CHARACTER TEXT*12,HSIGN*12,NAMCHA*8,NAMCHA2*8,TEXT12*12
+      INTEGER IMPX,MSHT,NB,NCH,IMOD,NCOMB,NF,NX,NY,NZ,MAXS,ITYP,
+     +        NREG,KREF,I,ISTATE(NSTATE),LENGT,NS,NSS,NITMA
+      DOUBLE PRECISION DFLOT
+      LOGICAL LNOTHING,LMIC
+      REAL TIME,BURNSTEP,FLOT
+      TYPE(C_PTR) IPMAP,IPPOW,IPMIC,IPMIC2,IPMIC3,JPMAP,KPMAP,LPMAP,
+     +            MPMAP
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IDX,NSSV,IXN,IYN,MIX,IVS
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: IHN
+      REAL, ALLOCATABLE, DIMENSION(:) :: BUNDPOW,WINT,BS,PS,POW,RFCHAN,
+     + BURNINST
+*----
+*  PARAMETER VALIDATION
+*----
+      IF((NENTRY.LT.1).AND.(NENTRY.GT.5)) CALL XABORT('@TINST: WRONG '
+     +  //'NUMBER OF PARAMETERS')
+      IPMAP=C_NULL_PTR
+      IPPOW=C_NULL_PTR
+      IPMIC=C_NULL_PTR
+      IPMIC2=C_NULL_PTR
+      IPMIC3=C_NULL_PTR
+      IF(JENTRY(1).EQ.0) THEN
+        IPMIC=KENTRY(1)
+        I=2
+        TEXT12=HENTRY(1)
+        IF(IENTRY(1).GT.2) CALL XABORT('@TINST: LCM OR XSM OBJECT TYPE'
+     +  //' FOR ENTRY='//TEXT12//'.')
+      ELSE
+        I=1
+      ENDIF
+      DO IEN=I,NENTRY
+        TEXT12=HENTRY(IEN)
+        IF(IENTRY(IEN).GT.2) CALL XABORT('@TINST: LCM OR XSM OBJECT TY'
+     +  //'PE FOR ENTRY='//TEXT12//'.')
+        CALL LCMGTC(KENTRY(IEN),'SIGNATURE',12,HSIGN)
+        IF(HSIGN.EQ.'L_MAP') THEN
+          IPMAP=KENTRY(IEN)
+          IF(JENTRY(IEN).NE.1) CALL XABORT('@TINST: MODIFICATION MODE '
+     +    //'FOR L_MAP EXPECTED')
+        ELSEIF(HSIGN.EQ.'L_POWER') THEN
+          IPPOW=KENTRY(IEN)
+          IF(JENTRY(IEN).NE.2) CALL XABORT('@TINST: READ-ONLY MODE '
+     +    //'FOR L_POWER EXPECTED')
+        ELSEIF(HSIGN.EQ.'L_LIBRARY') THEN
+          IF(.NOT.C_ASSOCIATED(IPMIC2)) THEN
+            IPMIC2=KENTRY(IEN)
+            CALL LCMEQU(IPMIC2,IPMIC)
+            IF(JENTRY(IEN).NE.2) CALL XABORT('@TINST: READ-ONLY MODE'
+     +      //' FOR SECOND L_LIBRARY EXPECTED')
+          ELSE
+            IPMIC3=KENTRY(IEN)
+            IF(JENTRY(IEN).NE.2) CALL XABORT('@TINST: READ-ONLY MODE '
+     +      //'FOR THIRD L_LIBRARY EXPECTED')
+          ENDIF
+        ENDIF          
+      ENDDO
+*----
+*  RECOVER INFORMATION
+*----
+      ISTATE(:NSTATE)=0
+      CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+      NB=ISTATE(1)
+      NCH=ISTATE(2)
+      NCOMB=ISTATE(3)
+      IMOD=ISTATE(5)
+      MAXS=ISTATE(6)
+      MSHT=MAXS+1
+      NF=ISTATE(7)
+      NPARM=ISTATE(8)
+      IF(NF.EQ.0) CALL XABORT('@TINST: NO FUEL IN MAP OBJECT.')
+*----
+*  ONLY TIME INSTANTANEOUS CALCULATIONS IN TINST:
+*----
+      IF(IMOD.NE.2)
+     +    CALL XABORT('@TINST: INST-BURN OPTION '
+     + //'SHOULD BE USED IN RESINI.')
+      JPMAP=LCMGID(IPMAP,'GEOMAP')
+      ISTATE(:NSTATE)=0
+      CALL LCMGET(JPMAP,'STATE-VECTOR',ISTATE)
+      IGEO=ISTATE(1)
+      NX=ISTATE(3)
+      NY=ISTATE(4)
+      NZ=ISTATE(5)
+      NREG = ISTATE(6)
+*     CHECK EXISTING DATA
+      IF(.NOT.C_ASSOCIATED(IPPOW)) THEN
+        CALL LCMLEN(IPMAP,'BUND-PW',LENGT,ITYP)
+        IF(LENGT.EQ.0)CALL XABORT('@TINST: MISSING BUND-PW DATA IN '
+     +   //'L_MAP OBJECT.')
+      ELSE
+        CALL LCMLEN(IPPOW,'POWER-CHAN',LENGT,ITYP)
+        IF(LENGT.EQ.0)CALL XABORT('@TINST: MISSING POWER-CHAN DATA I'
+     +   //'N L_POWER OBJECT.')
+      ENDIF
+*----
+*  READ INPUT DATA
+*----
+      IMPX=0
+      LNOTHING=.TRUE.
+      LMIC=.FALSE.
+      TTIME=0.0
+      ALLOCATE(RFCHAN(NCH))
+      RFCHAN(:NCH)=0.0
+   2  TIME=0.0
+      BURNSTEP=0.0
+*     READ KEYWORD
+   1  CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('@TINST: CHARACTER DATA EXPECTED(1).')
+      IF(TEXT.EQ.'EDIT')THEN
+*       PRINTING INDEX
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@TINST: INTEGER DATA EXPECTED.')
+        IMPX=MAX(0,NITMA)
+        GOTO 1
+      ELSEIF(TEXT.EQ.'TIME')THEN
+*       TIME VALUE
+        IF(TIME.NE.0.0)CALL XABORT('@TINST: TIME ALREADY SPECIFIED(1).')
+        IF(BURNSTEP.NE.0.0)CALL XABORT('@TINST: BURNSTEP ALREADY //
+     +    //SPECIFIED(1).')
+        CALL REDGET(ITYP,NITMA,TIME,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@TINST: REAL DATA EXPECTED(1).')
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.3)CALL XABORT('@TINST: CHARACTER DATA EXPECTED(2).')
+        IF(TIME.LT.0.)CALL XABORT('@TINST: EXPECTING REAL > 0 (1).')
+        IF(TEXT.EQ.'DAY')THEN
+          TIME=TIME
+        ELSEIF(TEXT.EQ.'HOUR')THEN
+          TIME=TIME/24.
+        ELSEIF(TEXT.EQ.'MINUTE')THEN
+          TIME=TIME/(24.*60.)
+        ELSEIF(TEXT.EQ.'SECOND')THEN
+          TIME=TIME/(24.*60.*60.)
+        ELSE
+          CALL XABORT('@TINST: EXPECTING DAY|HOUR|MINUTE|SECOND.')
+        ENDIF
+        LNOTHING=.FALSE.
+        GOTO 10
+      ELSEIF(TEXT.EQ.'BURN-STEP')THEN
+*       BURN-STEP
+        IF(TIME.NE.0.)CALL XABORT('@TINST: TIME ALREADY SPECIFIED(2).')
+        IF(BURNSTEP.NE.0.)CALL XABORT('@TINST: BURNSTEP ALREADY '
+     +    //'SPECIFIED(2).')
+        CALL REDGET(ITYP,NITMA,BURNSTEP,TEXT,DFLOT)
+        IF(ITYP.NE.2)CALL XABORT('@TINST: REAL DATA EXPECTED(2).')
+        IF(BURNSTEP.LE.0.)CALL XABORT('@TINST: EXPECTING REAL > 0 (2).')
+        LNOTHING=.FALSE.
+        GOTO 10
+      ELSEIF(TEXT.EQ.'REFUEL')THEN
+*      REFUEL
+           KREF=1
+           LNOTHING=.FALSE.
+           CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+           IF(ITYP.NE.3)
+     +      CALL XABORT('@TINST: CHARACTER DATA EXPECTED(3).')
+           IF(TEXT.EQ.'MICRO') THEN
+             LMIC=.TRUE.
+             CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+           IF(ITYP.NE.3)
+     +      CALL XABORT('@TINST: CHARACTER DATA EXPECTED(4).')
+           ENDIF
+           IF(TEXT.EQ.'CHAN') THEN
+             CALL REDGET(ITYP,NITMA,FLOT,NAMCHA,DFLOT)
+             IF(ITYP.NE.3)
+     +        CALL XABORT('@TINST: CHARACTER DATA EXPECTED(5).')
+             CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+             IF(ITYP.NE.1)
+     +         CALL XABORT('@TINST: INTEGER DATA EXPECTED(2).')
+             NS = NITMA
+             CALL TINCHA(IPMAP,NCH,IMPX,NAMCHA,TTIME,RFCHAN)
+           ELSE
+            CALL XABORT('@TINST: INVALID KEYWORD '//TEXT)
+           ENDIF
+       GOTO 20
+      ELSEIF(TEXT.EQ.'NEWFUEL')THEN
+*      NEWFUEL
+           KREF=2
+           LNOTHING=.FALSE.
+           CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+           IF(ITYP.NE.3)
+     +      CALL XABORT('@TINST: CHARACTER DATA EXPECTED(4).')
+           IF(TEXT.EQ.'CHAN') THEN
+             CALL REDGET(ITYP,NITMA,FLOT,NAMCHA,DFLOT)
+             IF(ITYP.NE.3)
+     +        CALL XABORT('@TINST: CHARACTER DATA EXPECTED(5).')
+             CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+             IF(ITYP.NE.1)
+     +         CALL XABORT('@TINST: INTEGER DATA EXPECTED(3).')
+             NS = NITMA
+             NSS=ABS(NS)
+             ALLOCATE(IDX(NSS))
+             CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+             IF(ITYP.NE.3)
+     +         CALL XABORT('@TINST: CHARACTER DATA EXPECTED(6).')
+             IF(TEXT.EQ.'SOME')THEN
+                DO 11 I=1,NSS
+                 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+                 IF(ITYP.NE.1)
+     +             CALL XABORT('@TINST: INTEGER DATA EXPECTED(4).')
+                IF (NITMA.GT.NF)
+     +             CALL XABORT('@TINST: WRONG NUMBER OF FUEL TYPE. ')
+                 IDX(I) = NITMA
+ 11             CONTINUE
+             ELSEIF(TEXT.EQ.'ALL')THEN
+                CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+                IF(ITYP.NE.1)
+     +             CALL XABORT('@TINST: INTEGER DATA EXPECTED(5).')
+                IF (NITMA.GT.NF)
+     +             CALL XABORT('@TINST: WRONG NUMBER OF FUEL TYPE. ')
+                DO 12 I=1,NSS
+                 IDX(I) = NITMA
+ 12             CONTINUE
+             ELSE
+               CALL XABORT('@TINST: INVALID KEYWORD '//TEXT)
+             ENDIF
+           ELSE
+            CALL XABORT('@TINST: INVALID KEYWORD '//TEXT)
+           ENDIF
+        GOTO 20
+*     SHUFFL
+      ELSEIF (TEXT.EQ.'SHUFF') THEN
+           KREF = 3
+           LNOTHING=.FALSE.
+           CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+           IF(ITYP.NE.3)
+     +      CALL XABORT('@TINST: CHARACTER DATA EXPECTED(7).')
+           IF(TEXT.EQ.'CHAN') THEN
+             CALL REDGET(ITYP,NITMA,FLOT,NAMCHA,DFLOT)
+             IF(ITYP.NE.3)
+     +        CALL XABORT('@TINST: CHARACTER DATA EXPECTED(8).')
+             CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+             IF(ITYP.NE.3)
+     +        CALL XABORT('@TINST: CHARACTER DATA EXPECTED(8).')
+             IF(TEXT.EQ.'TO') THEN
+                CALL REDGET(ITYP,NITMA,FLOT,NAMCHA2,DFLOT)
+                IF(ITYP.NE.3)
+     +            CALL XABORT('@TINST: CHARACTER DATA EXPECTED(9).')
+                IF(IMPX.GT.2)
+     +            WRITE(6,*) 'TINST : ACTION ',NAMCHA,' TO ',NAMCHA2
+             ELSE
+               CALL XABORT('@TINST: INVALID KEYWORD '//TEXT)
+             ENDIF
+           ELSE
+             CALL XABORT('@TINST: INVALID KEYWORD '//TEXT)
+           ENDIF
+        GOTO 20
+      ELSEIF(TEXT.EQ.'PICK') THEN
+*       RECOVER THE BURNUP AND SAVE IT IN A CLE-2000 VARIABLE
+        IF(IMPX.GT.2) WRITE(IOUT,40) BURNAVG
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.-2) CALL XABORT('TINST: OUTPUT REAL EXPECTED.')
+        ITYP=2
+        CALL REDPUT(ITYP,NITMA,BURNAVG,TEXT,DFLOT)
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF((ITYP.NE.3).OR.(TEXT.NE.';')) THEN
+          CALL XABORT('TINST: ; CHARACTER EXPECTED.')
+        ENDIF      
+        GOTO 30
+      ELSEIF(TEXT.EQ.';')THEN
+        GOTO 30
+      ELSE
+*       KEYWORD DOES NOT MATCH
+        CALL XABORT('@TINST: WRONG KEYWORD: '//TEXT//'.')
+      ENDIF
+*----
+*  PERFORM CALCULATION
+*----
+   10 ALLOCATE(BUNDPOW(NCH*NB))
+      IF(.NOT.C_ASSOCIATED(IPPOW)) THEN
+        CALL LCMGET(IPMAP,'BUND-PW',BUNDPOW)
+      ELSE 
+        CALL LCMGET(IPPOW,'POWER-BUND',BUNDPOW)
+      ENDIF
+      IF(LMIC) CALL XABORT('@TINST: NO MICRO-DEPLETION ')
+      TTIME  = TTIME + TIME
+      ALLOCATE(BURNINST(NCH*NB))
+      CALL TINSTB(IPMAP,TIME,BURNSTEP,NCH,NB,NF,BUNDPOW,BURNAVG,
+     1 BURNINST,IMPX)
+*----
+*  SAVE LOCAL PARAMETERS FOR HISTORICAL FOLLOW-UP
+*----
+      CALL LCMLEN(IPMAP,'_TINST',ILONG,ITYLCM)
+      IF(IMPX.GT.0) WRITE(6,50) ILONG+1,BURNAVG
+      JPMAP=LCMLID(IPMAP,'_TINST',ILONG+1)
+      KPMAP=LCMDIL(JPMAP,ILONG+1)
+      CALL LCMPUT(KPMAP,'TIME',1,2,TTIME)
+      CALL LCMPUT(KPMAP,'BURNAVG',1,2,BURNAVG)
+      CALL LCMPUT(KPMAP,'BURN-INST',NCH*NB,2,BURNINST)
+      CALL LCMPUT(KPMAP,'POWER-BUND',NCH*NB,2,BUNDPOW)
+      IF(NPARM.GT.0) THEN
+        LPMAP=LCMGID(IPMAP,'PARAM')
+        MPMAP=LCMLID(KPMAP,'PARAM',NPARM)
+        CALL LCMEQU(LPMAP,MPMAP)
+        ISTATE(19)=1
+        CALL LCMPTC(IPMAP,'CYCLE-NAMES',12,'_TINST')
+      ENDIF
+      DEALLOCATE(BURNINST,BUNDPOW)
+      GOTO 1
+*
+   20 CALL LCMSIX(IPMAP,' ',0)
+      ALLOCATE(NSSV(NCH))
+      CALL LCMLEN(IPMAP,'REF-SCHEME',ILONG,ITYP)
+      IF(ILONG.EQ.0) THEN
+         DO 25 I=1,NCH
+            NSSV(I) = 0
+   25    CONTINUE
+      ELSEIF(ILONG.NE.NCH) THEN
+         CALL XABORT('@TINST: REF-SCHEME HAS NOT THE CORRECT LENGHT')
+      ELSE
+         CALL LCMGET(IPMAP,'REF-SCHEME',NSSV)
+      ENDIF
+      CALL LCMSIX(IPMAP,' ',0)
+      IF(IGEO.EQ.7) THEN
+*       Cartesian geometry.
+        ALLOCATE(IXN(NX),IYN(NY))
+        CALL LCMGET(IPMAP,'XNAME',IXN)
+        CALL LCMGET(IPMAP,'YNAME',IYN)
+        ALLOCATE(WINT(NCH*NB),MIX(NREG),BS(NCH*NB*MSHT),PS(NCH*NB*MSHT),
+     1  IVS(NCH*NB*MSHT))
+        IF(KREF.EQ.1.OR.KREF.EQ.2) THEN
+          IF(KREF.EQ.1) ALLOCATE(IDX(ABS(NS)))
+          ALLOCATE(POW(NCH*NB))
+          IF(.NOT.C_ASSOCIATED(IPPOW)) THEN
+            CALL LCMGET(IPMAP,'BUND-PW',POW)
+          ELSE 
+            CALL LCMGET(IPPOW,'POWER-BUND',POW)
+          ENDIF
+          CALL TINREF(IPMAP,IPMIC,IPMIC2,IPMIC3,NCH,NB,NX,NY,NZ,NREG,
+     +               NAMCHA,NS,MSHT,WINT,MIX,IXN,IYN,BS,PS,IVS,POW,
+     +               MAXS,NSSV,IDX,IMPX,KREF,LMIC)
+          DEALLOCATE(POW,IDX)
+        ELSE
+          CALL TINSHU(IPMAP,NCH,NB,NX,NY,NZ,NREG,MSHT,NAMCHA,NAMCHA2,
+     +       WINT,MIX,BS,PS,IVS,IXN,IYN,IMPX)
+        ENDIF
+        DEALLOCATE(IXN,IYN)
+      ELSE IF(IGEO.EQ.9) THEN
+*       Hexagonal geometry.
+        ALLOCATE(IHN(2,NX))
+        CALL LCMGET(IPMAP,'HNAME',IHN)
+        ALLOCATE(WINT(NCH*NB),MIX(NREG),BS(NCH*NB*MSHT),PS(NCH*NB*MSHT),
+     1  IVS(NCH*NB*MSHT))
+        IF(KREF.EQ.1.OR.KREF.EQ.2) THEN
+          IF(KREF.EQ.1) ALLOCATE(IDX(ABS(NS)))
+          ALLOCATE(POW(NCH*NB))
+          IF(.NOT.C_ASSOCIATED(IPPOW)) THEN
+            CALL LCMGET(IPMAP,'BUND-PW',POW)
+          ELSE 
+            CALL LCMGET(IPPOW,'POWER-BUND',POW)
+          ENDIF
+          CALL TINREH(IPMAP,IPMIC,IPMIC2,IPMIC3,NCH,NB,NX,NZ,NREG,
+     +               NAMCHA,NS,MSHT,WINT,MIX,IHN,BS,PS,IVS,POW,MAXS,
+     +               NSSV,IDX,IMPX,KREF,LMIC)
+          DEALLOCATE(POW,IDX)
+        ELSE
+          CALL TINSHH(IPMAP,NCH,NB,NX,NZ,NREG,MSHT,NAMCHA,NAMCHA2,
+     +       WINT,MIX,BS,PS,IVS,IHN,IMPX)
+        ENDIF
+        DEALLOCATE(IHN)
+      ELSE
+        CALL XABORT('TINST: GEOMETRY TYPE NOT SUPPORTED')
+      ENDIF
+      DEALLOCATE(BS,PS,IVS,MIX)
+      DEALLOCATE(WINT)
+      DEALLOCATE(NSSV)
+      MSHT=MAXS+1
+      KREF=0
+      GOTO 2
+*
+  30  IF(LNOTHING)CALL XABORT('@TINST: NO OPTION SPECIFIED.')
+      CALL LCMSIX(IPMAP,' ',0)
+      ISTATE(:NSTATE)=0
+      CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+      ISTATE(6)=MAXS
+      CALL LCMPUT(IPMAP,'STATE-VECTOR',NSTATE,1,ISTATE)
+      CALL LCMPUT(IPMAP,'DEPL-TIME',1,2,TTIME)
+      CALL LCMPUT(IPMAP,'REF-CHAN',NCH,2,RFCHAN)
+      DEALLOCATE(RFCHAN)
+      RETURN
+   40 FORMAT(/20H TINST: PICK BURNUP=,1P,E12.4,10H MWd/tonne)
+   50 FORMAT(/38H TINST: STORE INFORMATION IN LIST ITEM,I3,9H OF TINST,
+     + 20H DIRECTORY AT BURNUP,1P,E12.4,8H MW-D/T./)
+      END
diff --git a/Donjon/src/TINSTB.f b/Donjon/src/TINSTB.f
new file mode 100644
index 0000000..48c54db
--- /dev/null
+++ b/Donjon/src/TINSTB.f
@@ -0,0 +1,152 @@
+*DECK TINSTB
+      SUBROUTINE TINSTB(IPMAP,TIME,BURNSTP,NCH,NB,NF,BUNDPOW,BURNAVG,
+     1 BURNINS,IMPX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute new burnup for each bundle given either an average burnup step
+* or a burning time
+*
+*Copyright:
+* Copyright (C) 2009 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* B. Toueg
+*
+*Parameters: input/output
+* IPMAP   pointer to fuel-map information.
+* TIME    time to burn
+* BURNSTP average burnup step
+* NCH     number of reactor channels.
+* NB      number of fuel bundles.
+* NF      number of fuel types.
+* BUNDPOW bundle powers.
+* BURNAVG average burnup.
+* BURNINS instantaneous burnups.
+* IMPX    printing index (=0 for no print).
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMAP
+      INTEGER NCH,NB,NF,IMPX
+      REAL BUNDPOW(NCH,NB), BURNINS(NCH,NB)
+      REAL TIME,BURNSTP, BURNAVG, PTOT, MASSTOT, WEIGHT
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(NSTATE=40,IOUT=6)
+      TYPE(C_PTR) JPMAP,KPMAP
+      CHARACTER HSMG*131
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: FLMIX,IFLRANK
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: BUNDMIX
+      REAL, ALLOCATABLE, DIMENSION(:) :: FLWEIGHT
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(BUNDMIX(NCH,NB),FLMIX(NF),FLWEIGHT(NF))
+*----
+*  RECOVER INFORMATION
+*----
+      CALL LCMLIB(IPMAP)
+*     FUEL MIX
+      BUNDMIX(:NCH,:NB)=0
+      CALL LCMGET(IPMAP,'FLMIX',BUNDMIX)
+*     BURN-INST
+      BURNINS(:NCH,:NB)=0.0
+      CALL LCMGET(IPMAP,'BURN-INST',BURNINS)
+*     FUEL INFORMATION (WEIGHT & MIX)
+      JPMAP=LCMGID(IPMAP,'FUEL')
+      MAXFL=0 ! maximum fuel mix number
+      DO IFL=1,NF
+        KPMAP=LCMGIL(JPMAP,IFL)
+        CALL LCMGET(KPMAP,'MIX',FLMIX(IFL))
+        MAXFL=MAX(MAXFL,FLMIX(IFL))
+        CALL LCMGET(KPMAP,'WEIGHT',FLWEIGHT(IFL))
+      ENDDO
+      IF(MAXFL.LT.NF)THEN
+        WRITE(HSMG,'(38H@TINSTB: FOUND MAX FUEL MIX NUMBER : (,I6,
+     1  8H) THOUGH,I7,23H FUEL MIXES ARE DEFINED)')
+        CALL XABORT(HSMG)
+      ENDIF
+* the mix stored in FLMIX field of /FMAP/
+* is not the rank of the fuel in FUEL Dir list of /FMAP/
+      ALLOCATE(IFLRANK(MAXFL))
+      IFLRANK(:MAXFL)=0
+      DO IFL=1,NF
+        IFLRANK(FLMIX(IFL))=IFL
+      ENDDO
+*----
+*  COMPUTE BURNAVG, PTOT, MASSTOT, ( TIME if BURNSTEP is specified)
+*----
+      BURNAVG=0.
+      PTOT=0.
+      MASSTOT=0.
+      NTOT=0
+      DO ICH=1,NCH
+        DO IB=1,NB
+          IBD=BUNDMIX(ICH,IB)
+          IF(IBD.EQ.0) CYCLE
+          IFL=IFLRANK(IBD)
+          IF(IFL.EQ.0) CYCLE
+          NTOT=NTOT+1
+          WEIGHT = FLWEIGHT(IFL)
+          BURNAVG=BURNAVG+BURNINS(ICH,IB)
+          PTOT=PTOT+BUNDPOW(ICH,IB)
+          MASSTOT=MASSTOT+WEIGHT
+        ENDDO
+      ENDDO
+      BURNAVG=BURNAVG/REAL(NTOT)
+      IF(TIME.EQ.0.)THEN
+        TIME = BURNSTP*MASSTOT/PTOT
+      ENDIF
+      IF(IMPX.GT.0)THEN
+        WRITE(IOUT,*)'@TINSTB: TOTAL POWER = ',PTOT,' kW'
+        WRITE(IOUT,*)'@TINSTB: TOTAL FUEL MASS = ',MASSTOT,' kg'
+        WRITE(IOUT,*)'@TINSTB: AVERAGE BURN UP BEFORE = ',
+     1  BURNAVG,'MWd/t'
+      ENDIF
+*----
+*  COMPUTE NEW BURN-INST GIVEN TIME
+*----
+      BURNAVG=0.
+      NTOT=0
+      DO ICH=1,NCH
+        DO IB=1,NB
+          IBD=BUNDMIX(ICH,IB)
+          IF(IBD.EQ.0) CYCLE
+          IFL=IFLRANK(IBD)
+          IF(IFL.EQ.0) CYCLE
+          NTOT=NTOT+1
+          WEIGHT = FLWEIGHT(IFL)
+          IF(WEIGHT.GT.0.)THEN
+            BURNINS(ICH,IB)=BURNINS(ICH,IB)
+     1      +(BUNDPOW(ICH,IB)/WEIGHT)*TIME
+            BURNAVG=BURNAVG+BURNINS(ICH,IB)
+          ELSE
+            IF(IMPX.GT.0)THEN
+              WRITE(IOUT,*)'@TINSTB: WARNING MIX ',
+     1        BUNDMIX(ICH,IB),' WEIGHS ',WEIGHT,'kg'
+            ENDIF
+          ENDIF
+        ENDDO
+      ENDDO
+      BURNAVG=BURNAVG/REAL(NTOT)
+      IF(IMPX.GT.0)THEN
+        WRITE(IOUT,*)'@TINSTB: AVERAGE BURN UP AFTER = ',BURNAVG,'MWd/t'
+      ENDIF
+      CALL LCMPUT(IPMAP,'BURN-INST',NCH*NB,2,BURNINS)
+*----
+*  RELEASE MEMORY AND RETURN
+*----
+      DEALLOCATE(IFLRANK)
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(FLWEIGHT,FLMIX,BUNDMIX)
+      RETURN
+      END
diff --git a/Donjon/src/USPLIT.f b/Donjon/src/USPLIT.f
new file mode 100644
index 0000000..2e4ee2b
--- /dev/null
+++ b/Donjon/src/USPLIT.f
@@ -0,0 +1,302 @@
+*DECK USPLIT
+      SUBROUTINE USPLIT(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Provide a link between the material index and reactor geometry;
+* create a matex object.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* J. Koclas, D. Sekki, V. Descotes
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The USPLIT: module specification is: 
+* GEOM MATEX := USPLIT: { GEOM | GEOMOLD } :: (desclink) ;
+* where
+*   GEOM : name of a \emph{geometry} object. This object is defined in creation 
+*     (appears only on LHS) or modification (appears on both LHS and RHS) 
+*     mode. An existing geometry previously created in the GEO: module is 
+*     modified. Only 3-D Cartesian or 3-D Hexagonal reactor geometries are 
+*     allowed.
+*   MATEX name of a \emph{matex} object to be created by the module.
+*   GEOMOLD : name of a \emph{geometry} object previously created in the GEO: 
+*     module. This object must be specified in read-only mode (appears only on 
+*     RHS). It is copied into GEOM at the beginning of USPLIT: module. Only 3-D 
+*     Cartesian or 3-D Hexagonal reactor geometries are allowed.
+*   (desclink) : structure describing the input data to the USPLIT: module.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(NSTATE=40,IOUT=6)
+      CHARACTER TEXT*12,HSIGN*12
+      INTEGER ISTATE(NSTATE),NCODE(6),ICODE(6)
+      REAL ZCODE(6)
+      DOUBLE PRECISION DFLOT
+      TYPE(C_PTR) IPGEO,IPMTX
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: ISPLX,ISPLY,ISPLZ,MAT,INDX,
+     1 IRMIX,IFMIX,MIXA
+      REAL, ALLOCATABLE, DIMENSION(:) :: XX,YY,ZZ
+      LOGICAL LASBLY
+*----
+*  PARAMETER VALIDATION
+*----
+      IF(NENTRY.LT.2)CALL XABORT('@USPLIT: 2 PARAMETERS EXPECTED.')
+      IPGEO=KENTRY(1)
+      IPMTX=KENTRY(2)
+      IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2))CALL XABORT('@USPLIT:'
+     1 //' LCM OBJECT EXPECTED AT LHS.')
+      IF((IENTRY(2).NE.1).AND.(IENTRY(2).NE.2))CALL XABORT('@USPLIT:'
+     1 //' LCM OBJECT EXPECTED AT LHS.')
+      IF(JENTRY(1).EQ.0) THEN
+        IF(NENTRY.LT.3)CALL XABORT('@USPLIT: 3 PARAMETERS EXPECTED.')
+        IF((IENTRY(3).NE.1).AND.(IENTRY(3).NE.2))CALL XABORT('@USPLIT:'
+     1  //' LCM OBJECT EXPECTED AT RHS.')
+        IF(JENTRY(3).NE.2)CALL XABORT('@USPLIT: READ-ONLY MODE EXPECTE'
+     1  //'D FOR L_GEOM.')
+        CALL LCMGTC(KENTRY(3),'SIGNATURE',12,HSIGN)
+        IF(HSIGN.NE.'L_GEOM')THEN
+          TEXT=HENTRY(3)
+          CALL XABORT('@USPLIT: SIGNATURE OF '//TEXT//' IS '//HSIGN//
+     1    '. L_GEOM EXPECTED.')
+        ENDIF
+        CALL LCMEQU(KENTRY(3),IPGEO)
+      ELSE IF(JENTRY(1).EQ.1) THEN
+        CALL LCMGTC(IPGEO,'SIGNATURE',12,HSIGN)
+        IF(HSIGN.NE.'L_GEOM')THEN
+          TEXT=HENTRY(1)
+          CALL XABORT('@USPLIT: SIGNATURE OF '//TEXT//' IS '//HSIGN//
+     1    '. L_GEOM EXPECTED.')
+        ENDIF
+      ELSE
+        TEXT=HENTRY(1)
+        CALL XABORT('@USPLIT: CREATE OR MODFICATION MODE EXPECTED FOR '
+     1  //TEXT//'.')
+      ENDIF
+      IF(JENTRY(2).NE.0)CALL XABORT('@USPLIT: CREATE MODE EXPECTED FOR'
+     1 //' L_MATEX.')
+      LASBLY=.FALSE.
+*----
+*  RECOVER STATE-VECTOR INFORMATION
+*----
+      ISTATE(:NSTATE)=0
+      CALL LCMGET(IPGEO,'STATE-VECTOR',ISTATE)
+      IGEO=ISTATE(1)
+      NMAT=ISTATE(7)
+      CALL LCMLEN(IPGEO,'MIX-ASBLY',NITMA,ITYP)
+      IF(NITMA.EQ.0) THEN
+        NMIXA=0
+      ELSE
+        NMIXA=NITMA/2
+      ENDIF
+      CALL LCMLEN(IPGEO,'A-NMIXP',NITMA,ITYP)
+      IF(NITMA.NE.1) THEN
+        NMIXP=0
+      ELSE
+        CALL LCMGET(IPGEO,'A-NMIXP',NMIXP)
+      ENDIF
+      IF((IGEO.NE.7).AND.(IGEO.NE.9))CALL XABORT('@USPLIT: ONLY '
+     1 //' 3D-CARTESIAN OR 3D-HEXAGONAL GEOMETRY ALLOWED.')
+*----
+*  READ INFORMATION
+*----
+      IMPX=1
+      NREFL=0
+      NFUEL=0
+   10 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('@USPLIT: CHARACTER DATA EXPECTED.')
+      IF(TEXT.EQ.'EDIT') THEN
+*       READ PRINTING INDEX
+        CALL REDGET(ITYP,IMPX,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@USPLIT: INTEGER FOR EDIT EXPECTED.')
+      ELSE IF(TEXT.EQ.'NGRP') THEN
+*       NUMBER OF ENERGY GROUPS
+        CALL REDGET(ITYP,NGRP,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@USPLIT: INTEGER DATA EXPECTED(1).')
+        IF(NGRP.LT.1)CALL XABORT('@USPLIT: INVALID NUMBER FOR NGRP.')
+      ELSE IF(TEXT.EQ.'MAXR') THEN
+*       MAXIMUM NUMBER OF REGIONS
+        CALL REDGET(ITYP,MAXR,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@USPLIT: INTEGER DATA EXPECTED(2).')
+        IF(MAXR.LT.1)CALL XABORT('@USPLIT: INVALID NUMBER FOR MAXR.')
+      ELSE IF(TEXT.EQ.'NMIX') THEN
+*       MAXIMUM NUMBER OF REGIONS
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@USPLIT: INTEGER DATA EXPECTED(3).')
+        IF(NITMA.LT.NMAT)CALL XABORT('@USPLIT: INVALID NMIX < NMAT.')
+        NMAT=NITMA
+      ELSE IF(TEXT.EQ.'NREFL') THEN
+*       NUMBER OF REFLECTOR TYPES
+        CALL REDGET(ITYP,NREFL,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@USPLIT: INTEGER DATA EXPECTED(4).')
+        IF(NREFL.LT.1)CALL XABORT('@USPLIT: REFLECTOR NOT DEFINED.')
+        IF(NREFL.GT.NMAT-1)CALL XABORT('@USPLIT: WRONG NUMBER OF '
+     1  //'REFLECTOR TYPES.')
+*       REFLECTOR MIXTURES
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(TEXT.NE.'RMIX')CALL XABORT('@USPLIT: KEYWORD RMIX EXPECTED.')
+        ALLOCATE(IRMIX(NREFL))
+        DO I=1,NREFL
+          CALL REDGET(ITYP,IRMIX(I),FLOT,TEXT,DFLOT)
+          IF(ITYP.NE.1)CALL XABORT('@USPLIT: INTEGER DATA EXPECTED(5).')
+          IF(IRMIX(I).LT.1)CALL XABORT('@USPLIT: INVALID RMIX'
+     1    //' NUMBER < 1.')
+          IF(IRMIX(I).GT.NMAT)CALL XABORT('@USPLIT: INVALID RMIX NUMBE'
+     1    //'R > NBMIX.')
+        ENDDO
+      ELSE IF(TEXT.EQ.'NFUEL') THEN
+*       NUMBER OF FUEL TYPES
+        CALL REDGET(ITYP,NFUEL,FLOT,TEXT,DFLOT)
+        IF(ITYP.EQ.1) THEN
+*         general definition of fuel mixture
+          IF(NFUEL.LT.1)CALL XABORT('@USPLIT: FUEL NOT DEFINED.')
+          IF(NREFL+NFUEL.NE.NMAT)THEN
+            WRITE(IOUT,*)'@USPLIT: NREFL:',NREFL,', NFUEL:',NFUEL 
+            WRITE(IOUT,*)'@USPLIT: TOTAL NUMBER OF MATERIALS ',NMAT 
+            CALL XABORT('@USPLIT: WRONG NUMBER OF REFLECTOR OR FUEL TY'
+     1      //'PES.')
+          ENDIF
+*         FUEL MIXTURES
+          CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+          IF(TEXT.NE.'FMIX')CALL XABORT('@USPLIT: KEYWORD FMIX EXPECTE'
+     1    //'D.')
+          ALLOCATE(IFMIX(NFUEL))
+          DO I=1,NFUEL
+            CALL REDGET(ITYP,IFMIX(I),FLOT,TEXT,DFLOT)
+            IF(ITYP.NE.1)CALL XABORT('@USPLIT: INTEGER DATA EXPECTED(6'
+     1      //').')
+            IF(IFMIX(I).LT.1)CALL XABORT('@USPLIT: INVALID FMIX NUMBER'
+     1      //' < 1.')
+            IF(IFMIX(I).GT.NMAT)CALL XABORT('@USPLIT: INVALID FMIX NUM'
+     1      //'BER > NBMIX.')
+          ENDDO
+        ELSEIF((ITYP.EQ.3).AND.(TEXT.EQ.'ASBLY')) THEN
+*         automatic definition of fuel mixture from unfolded geometry
+*         by NAP:
+          LASBLY=.TRUE.
+          IF(NMIXA.EQ.0)CALL XABORT('@USPLIT: No assembly previously '
+     1    //'defined (NMIXA=0).')
+          IF(NMIXP.EQ.0)CALL XABORT('@USPLIT: No assembly previously '
+     1    //'defined (NMIXP=0).')
+          NFUEL=NMIXA*(NMIXP+1)
+          ALLOCATE(MIXA(2*NMIXA))
+          CALL LCMGET(IPGEO,'MIX-ASBLY',MIXA)
+          ALLOCATE(IFMIX(NFUEL))
+          DO I=1,NMIXA
+            IFMIX((I-1)*(NMIXP+1)+1)=MIXA(I)
+            DO J=1,NMIXP
+              IFMIX((I-1)*(NMIXP+1)+1+J)=MIXA(I+NMIXA)+J-1
+            ENDDO
+          ENDDO
+        ELSE
+          CALL XABORT('@USPLIT: INTEGER DATA or ASBLY keyword is EXPEC'
+     1    //'TED.')
+        ENDIF
+      ELSE IF(TEXT.EQ.';') THEN
+        GO TO 20
+      ELSE
+        CALL XABORT('@USPLIT: FINAL ; EXPECTED.')
+      ENDIF
+      GO TO 10
+*----
+*  RECOVER INFORMATION
+*----
+   20 IMPX0=MAX(0,IMPX-1)
+      ALLOCATE(ISPLX(MAXR),ISPLY(MAXR),ISPLZ(MAXR),MAT(MAXR))
+      ALLOCATE(XX(MAXR+1),YY(MAXR+1),ZZ(MAXR+1))
+      CALL READ3D(MAXR,MAXR,MAXR,MAXR,IPGEO,IHEX,IR,ILK,SIDE,XX,YY,ZZ,
+     1 IMPX0,LX,LY,LZ,MAT,NEL,NCODE,ICODE,ZCODE,ISPLX,ISPLY,ISPLZ,ISPLH,
+     2 ISPLL)
+*----
+*  CORRECT READ3D OUTPUT TO AVOID HEXAGON SPLITTING
+*----
+      ISTATE(11)=0
+*----
+*  COMPUTE RENUMBERED MATERIAL INDEX
+*----
+      IF((NEL.NE.LX*LY*LZ).AND.(IHEX.EQ.0))CALL XABORT('@USPLIT: WRONG'
+     1 // ' GEOMETRY.')
+      IF((NEL.NE.LX*LZ).AND.(IHEX.NE.0))CALL XABORT('@USPLIT: WRONG' 
+     1 // ' HEXAGONAL GEOMETRY, WRONG NUMBER OF ELEMENTS.')
+      DEALLOCATE(ISPLZ,ISPLY,ISPLX)
+      ALLOCATE(INDX(NEL))
+      IF(NREFL.EQ.0) ALLOCATE(IRMIX(1))
+      IF(NFUEL.EQ.0) ALLOCATE(IFMIX(1))
+      CALL USPMIX(IPMTX,NEL,NREFL,NFUEL,MAT,IRMIX,IFMIX,INDX,NMIX)
+*----
+*  STATE-VECTOR FOR GEOMETRY
+*----
+      IF(IHEX.EQ.0) THEN
+        CALL LCMPUT(IPMTX,'MESHX',LX+1,2,XX)
+        CALL LCMPUT(IPMTX,'MESHY',LY+1,2,YY)
+        CALL LCMPUT(IPMTX,'MESHZ',LZ+1,2,ZZ)
+        CALL LCMPUT(IPGEO,'MESHX',LX+1,2,XX)
+        CALL LCMPUT(IPGEO,'MESHY',LY+1,2,YY)
+        CALL LCMPUT(IPGEO,'MESHZ',LZ+1,2,ZZ)
+      ELSE
+        CALL LCMPUT(IPMTX,'SIDE',1,2,SIDE)
+        CALL LCMPUT(IPMTX,'MESHZ',LZ+1,2,ZZ)
+        CALL LCMPUT(IPGEO,'SIDE',1,2,SIDE)
+        CALL LCMPUT(IPGEO,'MESHZ',LZ+1,2,ZZ)
+        CALL LCMPUT(IPGEO,'IHEX',1,1,IHEX)
+        LY=1
+      ENDIF
+      DEALLOCATE(ZZ,YY,XX)
+*     MODIFY GEOMETRY
+      ISTATE(3)=LX
+      ISTATE(4)=LY
+      ISTATE(5)=LZ
+      ISTATE(6)=NEL
+      ISTATE(7)=NMIX
+      CALL LCMPUT(IPGEO,'STATE-VECTOR',NSTATE,1,ISTATE)
+      CALL LCMPUT(IPGEO,'MIX',NEL,1,INDX)
+      DEALLOCATE(IFMIX,IRMIX,INDX,MAT)
+      IF(LASBLY) DEALLOCATE(MIXA)
+*----
+*  STATE-VECTOR FOR MATEX
+*----
+      NTOT=NEL
+      HSIGN='L_MATEX'
+      CALL LCMPTC(IPMTX,'SIGNATURE',12,HSIGN)
+      ISTATE(:NSTATE)=0
+      ISTATE(1)=NGRP
+      ISTATE(2)=NMIX
+      ISTATE(3)=NREFL
+      ISTATE(4)=NFUEL
+      ISTATE(5)=NTOT
+      ISTATE(6)=IGEO
+      ISTATE(7)=NEL
+      ISTATE(8)=LX
+      ISTATE(9)=LY
+      ISTATE(10)=LZ
+      CALL LCMPUT(IPMTX,'STATE-VECTOR',NSTATE,1,ISTATE)
+      IF(IMPX.GT.0) CALL LCMLIB(IPMTX)
+      RETURN
+      END
diff --git a/Donjon/src/USPMIX.f b/Donjon/src/USPMIX.f
new file mode 100644
index 0000000..338a14c
--- /dev/null
+++ b/Donjon/src/USPMIX.f
@@ -0,0 +1,94 @@
+*DECK USPMIX
+      SUBROUTINE USPMIX(IPMTX,NEL,NREFL,NFUEL,MAT,RMIX,FMIX,INDX,NMIX)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover and check the material mixtures.
+*
+*Copyright:
+* Copyright (C) 2007 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* D. Sekki
+*
+*Parameters: input
+* IPMTX  pointer to matex information.
+* NEL    total number of volumes in reactor geometry.
+* NREFL  total number of reflector types.
+* NFUEL  total number of fuel types.
+* MAT    material index from geometry.
+* RMIX   reflector-type mixtures indices.
+* FMIX   fuel-type mixtures indices.
+*
+*Parameters: output
+* INDX   renumbered material index.
+* NMIX   total number of non-virtual volumes.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPMTX
+      INTEGER NEL,NREFL,NFUEL,MAT(NEL),RMIX(NREFL),FMIX(NFUEL),
+     1 INDX(NEL),NMIX
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: RTOT,FTOT
+*----
+*  SCRATCH STORAGE ALLOCATION
+*----
+      ALLOCATE(RTOT(NREFL),FTOT(NFUEL))
+*----
+*  MATERIAL INDEX
+*----
+      RTOT(:NREFL)=0
+      FTOT(:NFUEL)=0
+      INDX(:NEL)=0
+      NMIX=0
+      DO IEL=1,NEL
+        IF(MAT(IEL).NE.0)THEN
+          NMIX=NMIX+1
+          INDX(IEL)=NMIX
+        ENDIF
+      ENDDO
+      IF((NFUEL.EQ.0).AND.(NREFL.EQ.0)) GOTO 20
+*     CHECK MIXTURES
+      DO 10 IEL=1,NEL
+      IMIX=MAT(IEL)
+      IF(IMIX.EQ.0)GOTO 10
+      IF(NREFL.EQ.0)GOTO 5
+      DO IREFL=1,NREFL
+        IF(IMIX.EQ.RMIX(IREFL))THEN
+          RTOT(IREFL)=RTOT(IREFL)+1
+          GOTO 10
+        ENDIF
+      ENDDO
+    5 IF(NFUEL.EQ.0)GOTO 10
+      DO IFUEL=1,NFUEL
+        IF(IMIX.EQ.FMIX(IFUEL))THEN
+          FTOT(IFUEL)=FTOT(IFUEL)+1
+          GOTO 10
+        ENDIF
+      ENDDO
+   10 CONTINUE
+*     STORAGE
+20    CALL LCMPUT(IPMTX,'MAT',NEL,1,MAT)
+      CALL LCMPUT(IPMTX,'INDEX',NEL,1,INDX)
+      IF(NREFL.NE.0) THEN
+      	CALL LCMPUT(IPMTX,'RMIX',NREFL,1,RMIX)
+      	CALL LCMPUT(IPMTX,'RTOT',NREFL,1,RTOT)
+      ENDIF
+      IF(NFUEL.NE.0) THEN
+      	CALL LCMPUT(IPMTX,'FMIX',NFUEL,1,FMIX)
+      	CALL LCMPUT(IPMTX,'FTOT',NFUEL,1,FTOT)
+      ENDIF
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(FTOT,RTOT)
+      RETURN
+      END
diff --git a/Donjon/src/XENCAL.f b/Donjon/src/XENCAL.f
new file mode 100644
index 0000000..2ed0230
--- /dev/null
+++ b/Donjon/src/XENCAL.f
@@ -0,0 +1,116 @@
+*DECK XENCAL
+      SUBROUTINE XENCAL(IPLIB,IPPOW,NB,NCH,NGRP,NMIX,NBISO,XEN)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute the Xenon distribution according to the bundle flux
+*
+*Copyright:
+* Copyright (C) 2010 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* M. Guyot
+*
+*Parameters: input/output
+* IPLIB   adress of the L_LIBRARY
+* IPPOW   adress of the L_POWER
+* NB      number of fuel bundles per channel
+* NCH     number of channels
+* NGRP    number of energy groups
+* NMIX    number of mixtures present in the library
+* NBISO   number of isotopes
+* XEN     xenon concentrations in each bundle
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPLIB,IPPOW
+      INTEGER NB,NCH,NGRP,NMIX
+      REAL XEN(NMIX)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER ICH,IB,IGRP,IBM
+      REAL TAUF(NMIX,NGRP),TAUX(NMIX,NGRP),XLAMBDA,GAMMAI,GAMMAX,CF,TF,
+     1 TX
+      TYPE(C_PTR) JPLIB,KPLIB,LPLIB,MPLIB
+*----
+*  ALLOCATABLE ARRAYS
+*----
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: IMIX
+      REAL, ALLOCATABLE, DIMENSION(:) :: SIGX,SIGF
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: FLUB
+      CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: HNAMIS
+*----
+*  SCRATCH STORAGE ALLOCATION
+*  SIGX    microscopic capture cross section of Xe-135
+*  SIGF    macroscopic fission cross section
+*  FLUB    bundle fluxes
+*----
+      ALLOCATE(SIGX(NGRP),SIGF(NMIX),FLUB(NCH,NB,NGRP))
+      ALLOCATE(HNAMIS(NBISO),IMIX(NBISO))
+*----
+* SET THE YIELD AND THE DECAY CONSTANTE FOR XENON
+*----
+      XLAMBDA = 2.09E-5
+      GAMMAI = 0.0631
+      GAMMAX = 0.0045
+      CF=1.0E-24
+*----
+*  COMPUTE FISSION AND XENON REACTION RATES IN EACH BUNDLE
+*---- 
+      FLUB(:NCH,:NB,:NGRP)=0.0
+      TAUF(:NMIX,:NGRP)=0.0
+      TAUX(:NMIX,:NGRP)=0.0
+      CALL LCMGET(IPPOW,'FLUX-BUND',FLUB)
+      CALL LCMSIX(IPLIB,'MACROLIB',1)
+      JPLIB=LCMGID(IPLIB,'GROUP')
+      CALL LCMSIX(IPLIB,' ',2)
+      CALL LCMGTC(IPLIB,'ISOTOPESUSED',12,NBISO,HNAMIS)
+      CALL LCMGET(IPLIB,'ISOTOPESMIX',IMIX)
+      LPLIB=LCMGID(IPLIB,'ISOTOPESLIST')
+*
+      DO 10 IGRP=1,NGRP 
+        KPLIB=LCMGIL(JPLIB,IGRP)
+        CALL LCMGET(KPLIB,'NFTOT',SIGF)
+        DO 20 ICH=1,NCH
+          DO 30 IB=1,NB
+            IBM=NCH*(IB-1)+ICH
+            ISO=0
+            DO JSO=1,NBISO
+              IF((HNAMIS(JSO).EQ.'Xe135').AND.(IMIX(JSO).EQ.IBM)) THEN
+                ISO=JSO
+                GO TO 35
+              ENDIF
+            ENDDO
+            CALL XABORT('XENCAL: UNABLE TO FIND ISOTOPE=Xe135.')
+   35       MPLIB=LCMGIL(LPLIB,ISO)
+            CALL LCMGET(MPLIB,'NG',SIGX)
+            TAUX(IBM,IGRP)=TAUX(IBM,IGRP)+FLUB(ICH,IB,IGRP)*
+     +        SIGX(IGRP)
+            TAUF(IBM,IGRP)=TAUF(IBM,IGRP)+FLUB(ICH,IB,IGRP)*
+     +        SIGF(IBM)
+   30     CONTINUE
+   20   CONTINUE
+   10 CONTINUE
+*
+      DO 40 IBM=1,NMIX
+        TF=0.0
+        TX=0.0
+        DO 50 IGRP=1,NGRP
+          TF=TF+TAUF(IBM,IGRP)
+          TX=TX+TAUX(IBM,IGRP)
+   50   CONTINUE
+        XEN(IBM)=CF*(GAMMAX+GAMMAI)*TF/(XLAMBDA+TX*CF)
+   40 CONTINUE
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(IMIX,HNAMIS)
+      DEALLOCATE(FLUB,SIGF,SIGX)
+      RETURN
+      END
diff --git a/Donjon/src/XENLIB.f b/Donjon/src/XENLIB.f
new file mode 100644
index 0000000..5ab52d4
--- /dev/null
+++ b/Donjon/src/XENLIB.f
@@ -0,0 +1,99 @@
+*DECK XENLIB
+      SUBROUTINE XENLIB(IPLIB,MAXMIX,NMIX,NBISO,NGRP,XEN)
+
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Update the macroscopic cross sections thanks to the Xenon distribution
+*
+*Copyright:
+* Copyright (C) 2010 Ecole Polytechnique de Montreal
+*
+*Author(s): 
+* M. Guyot
+*
+*Parameters: input/output
+* IPLIB   adress of the L_LIBRARY
+* MAXMIX  maximum number of mixtures in the library
+* NMIX    number of mixtures present in the library
+* NBISO   number of isotopes
+* NGRP    number of energy groups
+* XEN     xenon concentrations in each bundle
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      TYPE(C_PTR) IPLIB
+      INTEGER MAXMIX,NMIX,NBISO,NGRP
+      REAL XEN(NMIX)
+*----
+*  LOCAL VARIABLES
+*----
+      INTEGER IMIX,ISO
+      REAL TMPDAY(3)
+      CHARACTER TEXT*8
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: MIX
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NAME,USED
+      REAL, ALLOCATABLE, DIMENSION(:) :: DENS
+      LOGICAL, ALLOCATABLE, DIMENSION(:) :: MASK,MASKL
+*----
+*  SCRATCH STORAGE ALLOCATION
+*   MIX     'ISOTOPESMIX'
+*   NAME    'ISOTOPESNAME'
+*   USED    'ISOTOPESUSED'
+*   DENS    'ISOTOPESDENS' updated
+*----
+      ALLOCATE(MIX(NBISO),NAME(3,NBISO),USED(3,NBISO),DENS(NBISO))
+*----
+*  RECOVER INFORMATION
+*----
+      CALL LCMGET(IPLIB,'ISOTOPESMIX',MIX)
+      CALL LCMGET(IPLIB,'ISOTOPERNAME',NAME)
+      CALL LCMGET(IPLIB,'ISOTOPESUSED',USED)
+      CALL LCMGET(IPLIB,'ISOTOPESDENS',DENS)
+*----
+*  PERFORM CALCULATION
+*----
+      IMIX=0
+      DO 10 ISO=1,NBISO
+        WRITE(TEXT,'(2A4)') (NAME(I,ISO),I=1,2)
+        IF(TEXT.EQ.'Xe135   ') THEN
+          IMIX=IMIX+1
+          DENS(ISO)=XEN(IMIX)
+        ENDIF
+   10 CONTINUE
+       
+      IF(IMIX.NE.NMIX) CALL XABORT('@XENLIB: Xe135 SHOULD BE EXTRACTED '
+     1 //'IN ALL MIXTURES .')
+
+      CALL LCMPUT(IPLIB,'ISOTOPESDENS',NBISO,2,DENS)
+*----
+*  UPDATE MACROSCOPIC XS
+*----
+      ALLOCATE(MASK(MAXMIX),MASKL(NGRP))
+      MASK(:MAXMIX)=.FALSE.
+      MASKL(:NGRP)=.TRUE.
+      DO 20 I=1,NBISO
+       IBM=MIX(I)
+       MASK(IBM)=.TRUE.
+   20 CONTINUE
+      ITSTMP=0
+      TMPDAY(1)=0.0
+      TMPDAY(2)=0.0
+      TMPDAY(3)=0.0
+*----
+*  CALL THE DRAGON SUBROUTINE FOR THE COMPUTATION OF THE MACROSCOPIC XS
+*----
+      CALL LIBMIX(IPLIB,MAXMIX,NGRP,NBISO,USED,MIX,DENS,MASK,MASKL,
+     1 ITSTMP,TMPDAY)
+      DEALLOCATE(MASKL,MASK)
+*----
+*  SCRATCH STORAGE DEALLOCATION
+*----
+      DEALLOCATE(DENS,USED,NAME,MIX)
+      RETURN
+      END
diff --git a/Donjon/src/XENON.f b/Donjon/src/XENON.f
new file mode 100644
index 0000000..9b5ca5c
--- /dev/null
+++ b/Donjon/src/XENON.f
@@ -0,0 +1,157 @@
+*DECK XENON
+      SUBROUTINE XENON(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Computing the Xenon distribution
+*
+*Copyright:
+* Copyright (C) 2010 Ecole Polytechnique de Montreal.
+*
+*Author(s): 
+* M. Guyot
+*
+*Parameters: input
+* NENTRY  number of data structures transfered to this module.
+* HENTRY  name of the data structures.
+* IENTRY  data structure type where:
+*         IENTRY=1 for LCM memory object;
+*         IENTRY=2 for XSM file;
+*         IENTRY=3 for sequential binary file;
+*         IENTRY=4 for sequential ASCII file.
+* JENTRY  access permission for the data structure where:
+*         JENTRY=0 for a data structure in creation mode;
+*         JENTRY=1 for a data structure in modifications mode;
+*         JENTRY=2 for a data structure in read-only mode.
+* KENTRY  data structure pointer.
+*
+*Comments:
+* The XENON: module specification is:
+* MICROLIB := XENON: MICROLIB [ POWER ] :: (descxenon) ;
+* where
+*   MICROLIB : name of a \emph{library} object, that will be updated by the 
+*     XENON : module. The Xenon should be extracted in this library for the use 
+*     of this module.
+*   POWER : name of a \emph{power} object containing the bundle fluxes, 
+*     previously computed by the FLPOW: module. The fluxes should be normalized 
+*     to the reactor power.
+*   (descxenon) : structure describing the input data to the XENON: module.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER      NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+      TYPE(C_PTR)  KENTRY(NENTRY)
+      CHARACTER    HENTRY(NENTRY)*12
+*----
+*  LOCAL VARIABLES
+*----
+      PARAMETER(NSTATE=40,IOUT=6)
+      CHARACTER HSIGN*12,TEXT*12
+      INTEGER ISTATE(NSTATE),ITYP,NITMA
+      REAL FLOT
+      DOUBLE PRECISION DFLOT
+      LOGICAL LINI
+      TYPE(C_PTR) IPLIB,IPPOW
+      REAL, ALLOCATABLE, DIMENSION(:) :: XEN
+*----
+*  PARAMETER VALIDATION
+*----
+      IPLIB=C_NULL_PTR
+      IPPOW=C_NULL_PTR
+      IF((NENTRY.NE.1).AND.(NENTRY.NE.2)) 
+     1  CALL XABORT('@XENON: 1 OR 2 PARAMETERS EXPECTED.')
+      DO I=1,NENTRY
+         IF((IENTRY(I).NE.1).AND.(IENTRY(I).NE.2))
+     1   CALL XABORT('@XENON: LCM OBJECT EXPECTED AT LHS')
+      ENDDO
+      IF(JENTRY(1).NE.1)CALL XABORT('@XENON: MODIFICATION MODE EXPECTED'
+     1 //' FOR L_LIBRARY.')
+      IF(NENTRY.EQ.2) THEN
+        IF(JENTRY(2).NE.2)CALL XABORT('@XENON: READ-ONLY MODE EXPECTED'
+     1   //' FOR L_POWER AT LHS.')
+      ENDIF
+      DO IEN=1,NENTRY
+        CALL LCMGTC(KENTRY(IEN),'SIGNATURE',12,HSIGN)
+*       L_LIBRARY
+        IF(HSIGN.EQ.'L_LIBRARY')THEN
+          IPLIB=KENTRY(IEN)
+*       L_POWER
+        ELSEIF(HSIGN.EQ.'L_POWER')THEN
+          IPPOW=KENTRY(IEN)
+        ELSE
+          TEXT=HENTRY(IEN)
+          CALL XABORT('@XENON: SIGNATURE OF '//TEXT//' IS '//HSIGN//
+     1    '. L_LIBRARY OR L_POWER EXPECTED.')
+        ENDIF
+      ENDDO
+*----
+*  RECOVER INFORMATION
+*----
+*     L_LIBRARY
+      CALL LCMSIX(IPLIB,' ',0)
+      ISTATE(:NSTATE)=0
+      CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE)
+      MAXMIX=ISTATE(1)
+      NBISO=ISTATE(2)
+      NGRP=ISTATE(3)
+      NMIX=ISTATE(14)
+*     L_POWER
+      IF(C_ASSOCIATED(IPPOW)) THEN
+        CALL LCMSIX(IPPOW,' ',0)
+        ISTATE(:NSTATE)=0
+        CALL LCMGET(IPPOW,'STATE-VECTOR',ISTATE)
+        IF(ISTATE(1).NE.NGRP)CALL XABORT('@XENON: DIFFERENT NGR'
+     1   //'P NUMBER IN L_LIBRARY AND L_POWER OBJECT.')
+        NCH=ISTATE(6)
+        NB=ISTATE(7)
+        IF(NCH*NB.NE.NMIX)CALL XABORT('@XENON: DIFFERENT '
+     1   //'MIXTURE NUMBER IN L_LIBRARY AND L_POWER OBJECT.')
+      ENDIF
+*----
+*  READ INPUT DATA
+*----
+      IPRT=0
+      LINI=.FALSE.
+*     READ KEYWORD
+   10 CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+      IF(ITYP.NE.3)CALL XABORT('@XENON: CHARACTER DATA EXPECTED(1).')
+      IF(TEXT.EQ.'EDIT')THEN
+*       PRINTING INDEX
+        CALL REDGET(ITYP,NITMA,FLOT,TEXT,DFLOT)
+        IF(ITYP.NE.1)CALL XABORT('@XENON: INTEGER DATA EXPECTED.')
+        IPRT=MAX(0,NITMA)
+        GOTO 10
+      ELSEIF(TEXT.EQ.'INIT')THEN
+        LINI=.TRUE.
+        GOTO 10
+      ELSEIF(TEXT.EQ.';')THEN
+        GOTO 20
+      ELSE
+*       KEYWORD DOES NOT MATCH
+        CALL XABORT('@XENON: WRONG KEYWORD:'//TEXT//'.')
+      ENDIF
+
+   20 IF((.NOT.C_ASSOCIATED(IPPOW)).AND.(.NOT.LINI)) THEN
+         CALL XABORT('@XENON: L_POWER OBJECT REQUIRED .')
+      ENDIF
+      ALLOCATE(XEN(NMIX))
+*----
+*  COMPUTE THE VALUE OF THE XENON CONCENTRATIONS
+*----
+      IF(.NOT.LINI) THEN
+        CALL XENCAL(IPLIB,IPPOW,NB,NCH,NGRP,NMIX,NBISO,XEN)
+      ELSE
+        XEN(:NMIX)=0.0
+      ENDIF
+*----
+*  PUT THE CONCENTRATIONS IN THE LIBRARY AND COMPUTE NEW XS
+*----
+      CALL XENLIB(IPLIB,MAXMIX,NMIX,NBISO,NGRP,XEN)
+      DEALLOCATE(XEN)
+      RETURN
+      END
diff --git a/Donjon/src/donmod.f90 b/Donjon/src/donmod.f90
new file mode 100644
index 0000000..3f7196a
--- /dev/null
+++ b/Donjon/src/donmod.f90
@@ -0,0 +1,91 @@
+!
+!-----------------------------------------------------------------------
+!
+!Purpose:
+! Dispatch to a calculation module in DONJON. ANSI-C interoperable.
+!
+!Copyright:
+! Copyright (C) 2009 Ecole Polytechnique de Montreal
+! This library is free software; you can redistribute it and/or
+! modify it under the terms of the GNU Lesser General Public
+! License as published by the Free Software Foundation; either
+! version 2.1 of the License, or (at your option) any later version.
+!
+!Author(s): 
+! A. Hebert
+!
+!-----------------------------------------------------------------------
+!
+integer(c_int) function donmod(cmodul, nentry, hentry, ientry, jentry, &
+               kentry, hparam_c) bind(c)
+!
+   use GANLIB
+   implicit none
+!----
+!  subroutine arguments
+!----
+   character(kind=c_char), dimension(*) :: cmodul
+   integer(c_int), value :: nentry 
+   character(kind=c_char), dimension(13,*) :: hentry
+   integer(c_int), dimension(nentry) :: ientry, jentry
+   type(c_ptr), dimension(nentry) :: kentry
+   character(kind=c_char), dimension(73,*) :: hparam_c
+!----
+!  local variables
+!----
+   integer :: i, ier
+   character :: hmodul*12, hsmg*131, hparam*72
+   character(len=12), allocatable :: hentry_f(:)
+   type FIL_file_array
+     type(FIL_file), pointer :: my_file
+   end type FIL_file_array
+   type(FIL_file_array), pointer :: my_file_array(:)
+   integer, external :: DONDRV
+!
+   allocate(hentry_f(nentry),my_file_array(nentry))
+   call STRFIL(hmodul, cmodul)
+   do i=1,nentry
+      call STRFIL(hentry_f(i), hentry(1,i))
+      if((ientry(i) >= 3).and.(ientry(i) <= 5)) then
+!        open a Fortran file.
+         call STRFIL(hparam, hparam_c(1,i))
+         my_file_array(i)%my_file=>FILOPN(hparam,jentry(i),ientry(i)-1,0)
+         if(.not.associated(my_file_array(i)%my_file)) then
+            write(hsmg,'(29hdonmod: unable to open file '',a12,2h''.)') hentry_f(i)
+            call XABORT(hsmg)
+         endif
+         kentry(i)=c_loc(my_file_array(i)%my_file)
+      endif
+   enddo
+!  ----------------------------------------------------------
+   donmod=DONDRV(hmodul,nentry,hentry_f,ientry,jentry,kentry)
+!  ----------------------------------------------------------
+   do i=1,nentry
+      if(jentry(i) == -2) then
+!        destroy a LCM object or a Fortran file.
+         if(ientry(i) <= 2) then
+            call LCMCL(kentry(i),2)
+            kentry(i)=c_null_ptr
+         else if((ientry(i) >= 3).and.(ientry(i) <= 5)) then
+            ier=FILCLS(my_file_array(i)%my_file,2)
+            if(ier < 0) then
+               write(hsmg,'(32hdonmod: unable to destroy file '',a12,2h''.)') hentry_f(i)
+               call XABORT(hsmg)
+            endif
+            kentry(i)=c_null_ptr
+         endif
+      else
+!        close a Fortran file.
+         if((ientry(i) >= 3).and.(ientry(i) <= 5)) then
+            ier=FILCLS(my_file_array(i)%my_file,1)
+            if(ier < 0) then
+               write(hsmg,'(30hdonmod: unable to close file '',a12,2h''.)') hentry_f(i)
+               call XABORT(hsmg)
+            endif
+         endif
+      endif
+   enddo
+   deallocate(my_file_array,hentry_f)
+   flush(6)
+   return
+end function donmod