summaryrefslogtreecommitdiff
path: root/Donjon/src/ACR.f
diff options
context:
space:
mode:
Diffstat (limited to 'Donjon/src/ACR.f')
-rw-r--r--Donjon/src/ACR.f594
1 files changed, 594 insertions, 0 deletions
diff --git a/Donjon/src/ACR.f b/Donjon/src/ACR.f
new file mode 100644
index 0000000..5ca076e
--- /dev/null
+++ b/Donjon/src/ACR.f
@@ -0,0 +1,594 @@
+*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
generated by cgit v1.2.3 (git 2.46.0) at 2026-02-16 20:57:12 +0000