summaryrefslogtreecommitdiff
path: root/Donjon/src/MCR.f
diff options
context:
space:
mode:
Diffstat (limited to 'Donjon/src/MCR.f')
-rw-r--r--Donjon/src/MCR.f564
1 files changed, 564 insertions, 0 deletions
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
generated by cgit v1.2.3 (git 2.46.0) at 2026-02-16 16:59:07 +0000