Initial commit from Polytechnique Montreal

1 files changed, 923 insertions, 0 deletions

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