summaryrefslogtreecommitdiff
path: root/Donjon/src/MCRRGR.f
diff options
context:
space:
mode:
Diffstat (limited to 'Donjon/src/MCRRGR.f')
-rw-r--r--Donjon/src/MCRRGR.f923
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
generated by cgit v1.2.3 (git 2.46.0) at 2026-02-16 15:32:07 +0000