*DECK ACR SUBROUTINE ACR(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY) * *----------------------------------------------------------------------- * *Purpose: * Recover and interpolate Microlib or Macrolib information from one or * many Apex database files. * *Copyright: * Copyright (C) 2021 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 ACR: calling specifications are: * MLIB := ACR: [ { MLIB | MLIB2 } ] APXNAM1 [[ APXNAM2 ]] [ MAPFL ] * :: (acr\_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 (ACR:, it is open in modification mode * and updated. * MLIB2 : name of an optional \emph{microlib} object whose content is copied * on MLIB. * APXNAM1 : name of the \emph{Apex file} data structure. * APXNAM2 : name of an additional \emph{Apex 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 (acr\_data). * acr\_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, MD1, MD2, MY1, MY2, NB, NCAL, > NCH, NCOMB, NDEPL, NDFI, NDFP, NFUEL, NGRP, NHEAVY, NISOF, NISOP, > NISOS, NITMA, NLIGHT, NBMAC, NMIL, NMIX, NOTHER, NPARM, NPAR, > NVP, NREAC, NSTABL, NSURFD, NVTOT, NBISO, NLAM, NREA, NISOTS, > NPRC, IMPX, ILONG, IMPY, INDIC, ITER, ITEXT4, I, IACCS, ITH, J, > NBESP, ILUPS CHARACTER TEXT4*4,TEXT12*12,HSMG*131,HSIGN*12,HEQUI*80, > NMDEPL(MAXR)*8 LOGICAL LMACRO,LCUBIC,LRES,LPURE,LTOTAL,LFROM DOUBLE PRECISION DFLOTT INTEGER ISTATE(NSTATE) TYPE(C_PTR) IPMAP,IPAPX,IPLIB,IPLIB2 *---- * ALLOCATABLE ARRAYS *---- INTEGER, ALLOCATABLE, DIMENSION(:) :: MIXC,NISO,LISO,IADRY,ITNAM, 1 ITZEA,MATNO,KPAX,INAM,IZAE,HREAC,IDR,KPAR,ITODO REAL, ALLOCATABLE, DIMENSION(:) :: CONC,BPAX,RER,RRD,BPAR,YIELD REAL, ALLOCATABLE, DIMENSION(:,:) :: TERP DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: VTOT DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:,:) :: YLDS,DECAY CHARACTER(LEN=4), ALLOCATABLE, DIMENSION(:) :: TYPISO CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:) :: NOMISO,NOMMAC,NOMIS CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:,:) :: HISO * SAVE NMDEPL DATA NMDEPL/'DECAY ','NFTOT ','NG ','N2N ', > 'N3N ','N4N ','NA ','NP ', > 'N2A ','NNP ','ND ','NT '/ *---- * PARAMETER VALIDATION *---- IF(NENTRY.LE.1) CALL XABORT('ACR: MINIMUM OF 2 OBJECTS EXPECTED.') IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('ACR: MACRO' 1 //'LIB LCM OBJECT EXPECTED AT LHS.') IF((JENTRY(1).NE.0).AND.(JENTRY(1).NE.1)) CALL XABORT('ACR: 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('ACR: 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('ACR: LCM OR HDF5 OBJECTS EXPECTED AT RHS.') ENDIF IF(JENTRY(I).NE.2) CALL XABORT('ACR: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('ACR: ONLY ONE MICROL' 1 //'IB EXPECTED AT RHS.') IPLIB2=KENTRY(I) GO TO 10 ELSE IF(HSIGN.EQ.'L_MACROLIB') THEN CALL XABORT('ACR: ANOTHER MACROLIB NOT EXPECTED AT RHS.') ELSE IF(HSIGN.EQ.'L_MAP') THEN IF(I.NE.NENTRY)CALL XABORT('ACR: FUEL-MAP EXPECTED TO BE T' 1 //'HE LAST OBJECT.') IF(NENTRY.LT.3)CALL XABORT('ACR: MISSING APEX 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. LTOTAL=.FALSE. LCUBIC=.FALSE. LRES=.FALSE. LPURE=.FALSE. B2=0.0 ITER=-1 IPAPX=C_NULL_PTR HEQUI=' ' ILUPS=0 IMPX=1 20 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT) IF(INDIC.NE.3) CALL XABORT('ACR: 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('ACR: 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('ACR: INTEGER DATA EXPECTED(2).') IF(NITMA.LT.NMIX) THEN WRITE(HSMG,'(20HACR: 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.'TOTAL') THEN IF(LMACRO) CALL XABORT('ACR: TOTAL LIMITED TO MICRO OPTION.') LTOTAL=.TRUE. 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('ACR: 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.'APEX') THEN IF(NMIX.EQ.0) CALL XABORT('ACR: ZERO NUMBER OF MIXTURES.') IF(C_ASSOCIATED(IPMAP)) THEN WRITE(IOUT,'(/43H ACR: ***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('ACR: CHARACTER DATA EXPECTED(2).') ITH=0 DO 50 I=2,NENTRY IF(C_ASSOCIATED(KENTRY(I),IPLIB2)) GO TO 50 IF(TEXT12.EQ.HENTRY(I)) THEN IPAPX=KENTRY(I) ITH=I GO TO 60 ENDIF 50 CONTINUE CALL XABORT('ACR: APEX '//TEXT12//' NOT FOUND.') 60 WRITE(IOUT,320) HENTRY(ITH) CALL APXTOC(IPAPX,IMPX,NLAM,NREA,NBISO,NBMAC,NMIL,NPAR,NVP, 1 NISOF,NISOP,NISOS,NCAL,NGRP,NISOTS,NSURFD,NPRC) MY1=NBMAC+NISOF MY2=NISOP MD1=NLAM MD2=NBISO+NBMAC ALLOCATE(MIXC(NMIX),NISO(NMIX),LISO(NMIX),HISO(NMIX,MD2), 1 ITODO(NMIX*MD2)) ALLOCATE(TERP(NCAL,NMIX),CONC(NMIX*MD2)) * CALL ACRDRV(IPAPX,LCUBIC,NMIX,IMPX,NMIL,NCAL,MD2,NPAR,ITER, 1 MAXNIS,MIXC,TERP,NISO,LISO,HISO,CONC,ITODO,LFROM) GO TO 130 ELSE IF(TEXT12.EQ.'TABLE') THEN IF(.NOT.C_ASSOCIATED(IPMAP)) CALL XABORT('ACR: 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('ACR: 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('ACR: CHARACTER DATA EXPECTED(3).') 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 IPAPX=KENTRY(I) ITH=I GO TO 90 ENDIF 80 CONTINUE CALL XABORT('ACR: APEX FILE '//TEXT12//' NOT FOUND.') 90 WRITE(IOUT,320) HENTRY(ITH) CALL APXTOC(IPAPX,IMPX,NLAM,NREA,NBISO,NBMAC,NMIL,NPAR,NVP, 1 NISOF,NISOP,NISOS,NCAL,NGRP,NISOTS,NSURFD,NPRC) MY1=NBMAC+NISOF MY2=NISOP MD1=NLAM MD2=NBISO+NBMAC ALLOCATE(MIXC(NMIX),NISO(NMIX),LISO(NMIX),HISO(NMIX,MD2), 1 ITODO(NMIX*MD2)) ALLOCATE(TERP(NCAL,NMIX),CONC(NMIX*MD2)) * CALL ACRRGR(IPAPX,IPMAP,LCUBIC,NMIX,IMPX,NMIL,NCAL,MD2,NCH,NB, 1 NFUEL,NPARM,NPAR,ITER,MAXNIS,MIXC,TERP,NISO,LISO,HISO,CONC, 2 ITODO,LFROM) GO TO 130 ELSE IF(TEXT12.EQ.'EQUI') THEN CALL REDGET(INDIC,NITMA,FLOTT,HEQUI,DFLOTT) IF(INDIC.NE.3) CALL XABORT('ACR: CHARACTER DATA EXPECTED(4).') ELSE IF(TEXT12.EQ.'LEAK') THEN CALL REDGET(INDIC,NITMA,B2,TEXT12,DFLOTT) IF(INDIC.NE.2) CALL XABORT('ACR: REAL DATA EXPECTED.') ELSE IF(TEXT12.EQ.'CHAIN') THEN IF(LMACRO) CALL XABORT('ACR: MICRO KEYWORD EXPECTED.') IF(LTOTAL) CALL XABORT('ACR: TOTAL AND CHAIN KEYWORDS ARE EXCL' 1 //'USIVE.') CALL APXTOC(IPAPX,0,NLAM,NREA,NBISO,NBMAC,NMIL,NPAR,NVP,NISOF, 1 NISOP,NISOS,NCAL,NGRP,NISOTS,NSURFD,NPRC) IF(NBISO.EQ.0) CALL XABORT('ACR: NO PARTICULARIZED ISOTOPES.') IF(NBMAC.EQ.0) CALL XABORT('ACR: NO MACROSCOPIC SETS.') MY1=NBMAC+NISOF MY2=NISOP MD1=NLAM MD2=NBISO+NBMAC CALL LCMLEN(IPLIB,'VTOT_',ILONG,ITYLCM) IF(ILONG.NE.NVTOT) CALL XABORT('ACR: INVALID LENGTH: VTOT(1).') CALL LCMLEN(IPLIB,'YLDS_',ILONG,ITYLCM) IF(ILONG.NE.MY1*MY2*NVTOT) CALL XABORT('ACR: INVALID LENGTH: Y' 1 //'LDS(1).') CALL LCMLEN(IPLIB,'DECAYC_',ILONG,ITYLCM) IF(ILONG.NE.MD1*MD2*NVTOT) CALL XABORT('ACR: INVALID LENGTH: D' 1 //'ECAYC(1)') ALLOCATE(VTOT(NVTOT),YLDS(MY1,MY2,NVTOT),DECAY(MD1,MD2,NVTOT), 1 NOMIS(NBISO+NBMAC)) CALL LCMGET(IPLIB,'VTOT_',VTOT) CALL LCMGET(IPLIB,'YLDS_',YLDS) CALL LCMGET(IPLIB,'DECAYC_',DECAY) IF(hdf5_group_exists(IPAPX,"/explicit/")) THEN CALL hdf5_read_data(IPAPX,"/explicit/ISONAME",NOMISO) ELSE IF(hdf5_group_exists(IPAPX,"/expli001/")) THEN CALL hdf5_read_data(IPAPX,"/expli001/ISONAME",NOMISO) ELSE CALL XABORT('ACR: GROUP explicit NOT FOUND IN HDF5 FILE.') ENDIF NOMIS(:NBISO)=NOMISO(:NBISO) DEALLOCATE(NOMISO) IF(hdf5_group_exists(IPAPX,"/physconst/")) THEN CALL hdf5_read_data(IPAPX,"/physconst/ISOTYP",TYPISO) ELSE IF(hdf5_group_exists(IPAPX,"/physco001/")) THEN CALL hdf5_read_data(IPAPX,"/physc001/ISOTYP",TYPISO) ELSE CALL XABORT('ACR: GROUP physconst NOT FOUND IN HDF5 FILE.') ENDIF ALLOCATE(IADRY(MD2)) NISOF=0 NISOP=0 NISOS=0 DO I=1,NBISO IF(TYPISO(I).EQ.'FISS') THEN NISOF=NISOF+1 IADRY(I)=NISOF ELSE IF(TYPISO(I).EQ.'F.P.') THEN NISOP=NISOP+1 IADRY(I)=-NISOP ELSE NISOS=NISOS+1 IADRY(I)=0 ENDIF ENDDO IF(NBMAC.GT.0) THEN IF(hdf5_group_exists(IPAPX,"/explicit/")) THEN CALL hdf5_read_data(IPAPX,"/explicit/MACNAME",NOMMAC) ELSE IF(hdf5_group_exists(IPAPX,"/expli001/")) THEN CALL hdf5_read_data(IPAPX,"/expli001/MACNAME",NOMMAC) ELSE CALL XABORT('ACR: GROUP explicit NOT FOUND IN HDF5 FILE.') ENDIF DO I=1,NBMAC IF(NOMMAC(I).EQ.'TOTAL') THEN NOMIS(NBISO+I)=' ' IADRY(NBISO+I)=0 ELSE IF(NOMMAC(I).EQ.'RESIDUAL') THEN NOMIS(NBISO+I)='*MAC*RES' IADRY(NBISO+I)=0 ENDIF ENDDO DEALLOCATE(NOMMAC) ENDIF * NBESP=1 ALLOCATE(ITNAM(3*MD2),ITZEA(MD2),MATNO(MD2), 1 KPAX((MD2+MAXR)*MD2),BPAX((MD2+MAXR)*MD2*NBESP)) TEXT4=' ' READ(TEXT4,'(A4)') ITEXT4 ITNAM(:3*MD2)=ITEXT4 ITZEA(:MD2)=0 MATNO(:MD2)=0 KPAX(:(MD2+MAXR)*MD2)=0 BPAX(:(MD2+MAXR)*MD2*NBESP)=0.0 CALL SCREIR(NMDEPL,MY1,MY2,MD1,MD2,NOMIS,IADRY,NVTOT,VTOT, 1 YLDS,DECAY,ITNAM,ITZEA,KPAX,BPAX) DEALLOCATE(IADRY,NOMIS,DECAY,YLDS,VTOT) CALL LIBWET(MAXR,MD2,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,MD2,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,NBESP,NDEPL,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('ACR: '//TEXT12//' IS AN INVALID KEYWORD.') ENDIF GO TO 20 *---- * PERFORM MULTIPARAMETER INTERPOLATION *---- 130 CALL APXTOC(IPAPX,0,NLAM,NREA,NBISO,NBMAC,NMIL,NPAR,NVP,NISOF, 1 NISOP,NISOS,NCAL,NGRP,NISOTS,NSURFD,NPRC) MD2=NBISO+NBMAC IF(.NOT.LFROM) NMIL=1 *---- * BUILD THE INTERPOLATED MACROLIB *---- IF(LMACRO.AND.(MAXNIS.EQ.0)) THEN * build a macrolib CALL ACRMAC(IPLIB,IPAPX,IACCS,NMIL,NMIX,NGRP,IMPX,HEQUI,NCAL, 1 NSURFD,ILUPS,MIXC,TERP,LPURE,B2,LFROM) ELSE * build a microlib IF(LMACRO)THEN CALL LCMOP(IPLIB,'*TEMPORARY*',0,1,0) IACCS=0 ENDIF IF(IACCS.EQ.0)THEN MAXISO=MD2*NMIX ELSE CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE) MAXISO=MAX(MD2*NMIX,ISTATE(2)) ENDIF NVTOT=NVTOT+1 ALLOCATE(VTOT(NVTOT),YLDS(MY1,MY2,NVTOT),DECAY(MD1,MD2,NVTOT)) IF(NVTOT.GT.1) THEN CALL LCMLEN(IPLIB,'VTOT_',ILONG,ITYLCM) IF(ILONG.NE.NVTOT-1) CALL XABORT('ACR: INVALID LENGTH: VTOT(' 1 //'2).') CALL LCMLEN(IPLIB,'YLDS_',ILONG,ITYLCM) IF(ILONG.NE.MY1*MY2*(NVTOT-1)) CALL XABORT('ACR: INVALID LEN' 1 //'GTH: YLDS(2).') CALL LCMGET(IPLIB,'VTOT_',VTOT) IF(MY1*MY2.GT.0) CALL LCMGET(IPLIB,'YLDS_',YLDS) IF(MD1*MD2.GT.0) CALL LCMGET(IPLIB,'DECAYC_',DECAY) ENDIF CALL ACRLIB(MAXNIS,MAXISO,IPLIB,IPAPX,IACCS,NMIX,NGRP,IMPX, 1 HEQUI,NCAL,ITER,MY1,MY2,MD1,MD2,TERP,NISO,LISO,HISO,CONC,ITODO, 2 MIXC,LRES,LPURE,LTOTAL,ILUPS,B2,LFROM,VTOT(NVTOT), 3 YLDS(1,1,NVTOT),DECAY(1,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(MD1*MD2.GT.0) THEN CALL LCMPUT(IPLIB,'DECAYC_',MD1*MD2*NVTOT,4,DECAY) ENDIF 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 ENDIF *---- * CONTINUE DATA PROCESSING *---- IF(ITER.EQ.0) THEN GO TO 200 ELSE IF(ITER.EQ.1) THEN TEXT12='APEX' 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 ACR: *---- 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 10H 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 10H GAP INFO)) 320 FORMAT(/31H ACR: INTERPOLATING APEX FILE ',A12,2H'.) END