*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