Initial commit from Polytechnique Montreal

1 files changed, 860 insertions, 0 deletions

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