summaryrefslogtreecommitdiff
path: root/Donjon/src/SCR.f
diff options
context:
space:
mode:
Diffstat (limited to 'Donjon/src/SCR.f')
-rw-r--r--Donjon/src/SCR.f592
1 files changed, 592 insertions, 0 deletions
diff --git a/Donjon/src/SCR.f b/Donjon/src/SCR.f
new file mode 100644
index 0000000..c827954
--- /dev/null
+++ b/Donjon/src/SCR.f
@@ -0,0 +1,592 @@
+*DECK SCR
+ SUBROUTINE SCR(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Recover and interpolate Microlib or Macrolib information from one or
+* many Saphyb database objects.
+*
+*Copyright:
+* Copyright (C) 2012 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.
+* 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 SCR: calling specifications are:
+* MLIB := SCR: [ { MLIB | MLIB2 } ] SAPNAM1 [[ SAPNAM2 ]] [ MAPFL ]
+* :: (scr\_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 (SCR:, it is open in modification mode
+* and updated.
+* MLIB2 : name of an optional \emph{microlib} object whose content is copied
+* on MLIB.
+* SAPNAM1 : name of the \emph{saphyb} data structure (L\_SAPHYB signature).
+* SAPNAM2 : name of an additional \emph{saphyb} data structure (L\_SAPHYB
+* signature). 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 (scr\_data).
+* scr\_data : input data structure containing interpolation information.
+*
+*-----------------------------------------------------------------------
+*
+ USE GANLIB
+ 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, NBISO, NISY,
+ & NITMA, NLIGHT, NMAC, NMIL, NMIX, NOTHER, NPARM, NPAR, NREAC,
+ & NSTABL, NSURFD, NVTOT, NBESP, ILUPS
+ INTEGER IMPX, ILONG, IMPY, INDIC, ITER, ITEXT4
+ INTEGER I, IACCS, ITH, J
+ CHARACTER TEXT4*4,TEXT12*12,HSMG*131,HSIGN*12,HEQUI*4,
+ 1 HMASL*4,NMDEPL(MAXR)*8
+ LOGICAL LMACRO,LCUBIC,LRES,LPURE
+ DOUBLE PRECISION DFLOTT
+ INTEGER ISTATE(NSTATE),DIMSAP(50)
+ TYPE(C_PTR) IPMAP,IPSAP,IPLIB,IPLIB2,IPMEM
+*----
+* ALLOCATABLE ARRAYS
+*----
+ INTEGER, ALLOCATABLE, DIMENSION(:) :: MIXC,NISO,LISO,HISO,IADRY,
+ 1 ITNAM,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=8), ALLOCATABLE, DIMENSION(:) :: NOMIS
+*
+ SAVE NMDEPL
+ DATA NMDEPL/'DECAY ','NFTOT ','NG ','N2N ',
+ > 'N3N ','N4N ','NA ','NP ',
+ > 'N2A ','NNP ','ND ','NT '/
+*----
+* PARAMETER VALIDATION
+*----
+ IF(NENTRY.LE.1) CALL XABORT('SCR: MINIMUM OF 2 OBJECTS EXPECTED.')
+ IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('SCR: MACRO'
+ 1 //'LIB LCM OBJECT EXPECTED AT LHS.')
+ IF((JENTRY(1).NE.0).AND.(JENTRY(1).NE.1)) CALL XABORT('SCR: 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('SCR: 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)) CALL XABORT('SCR: '
+ 1 //'LCM OBJECTS EXPECTED AT RHS.')
+ IF(JENTRY(I).NE.2) CALL XABORT('SCR: LCM OBJECTS IN READ-ONLY '
+ 1 //'MODE EXPECTED AT RHS.')
+ CALL LCMGTC(KENTRY(I),'SIGNATURE',12,HSIGN)
+ IF(HSIGN.EQ.'L_LIBRARY') THEN
+ IF(C_ASSOCIATED(IPLIB2)) CALL XABORT('SCR: ONLY ONE MICROLIB'
+ 1 //' EXPECTED AT RHS.')
+ IPLIB2=KENTRY(I)
+ GO TO 10
+ ELSE IF(HSIGN.EQ.'L_MACROLIB') THEN
+ CALL XABORT('SCR: ANOTHER MACROLIB NOT EXPECTED AT RHS.')
+ ELSE IF(HSIGN.EQ.'L_MAP') THEN
+ IF(I.NE.NENTRY)CALL XABORT('SCR: FUEL-MAP EXPECTED TO BE THE '
+ 1 //'LAST OBJECT.')
+ IF(NENTRY.LT.3)CALL XABORT('SCR: MISSING SAPHYB OBJECT.')
+ IPMAP=KENTRY(NENTRY)
+ CALL LCMGET(IPMAP,'STATE-VECTOR',ISTATE)
+ NMIX=ISTATE(9)
+ ELSE IF(HSIGN.NE.'L_SAPHYB') THEN
+ TEXT12=HENTRY(I)
+ CALL XABORT('SCR: SIGNATURE OF '//TEXT12//' IS '//HSIGN//
+ 1 '. L_SAPHYB EXPECTED.')
+ ENDIF
+ 10 CONTINUE
+*----
+* READ THE INPUT DATA
+*----
+ NVTOT=0
+ LMACRO=.TRUE.
+ LCUBIC=.FALSE.
+ LRES=.FALSE.
+ LPURE=.FALSE.
+ B2=0.0
+ ITER=-1
+ IPSAP=C_NULL_PTR
+ HEQUI=' '
+ HMASL=' '
+ ILUPS=0
+ IMPX=1
+ 20 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+ IF(INDIC.NE.3) CALL XABORT('SCR: 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('SCR: 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('SCR: INTEGER DATA EXPECTED(2).')
+ IF(NITMA.LT.NMIX) THEN
+ WRITE(HSMG,'(20HSCR: 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('SCR: 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.'SAPHYB') THEN
+ IF(NMIX.EQ.0) CALL XABORT('SCR: ZERO NUMBER OF MIXTURES.')
+ IF(C_ASSOCIATED(IPMAP)) THEN
+ WRITE(IOUT,'(/43H SCR: ***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('SCR: 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
+ CALL LCMGTC(KENTRY(I),'SIGNATURE',12,TEXT12)
+ IF(TEXT12.EQ.'L_SAPHYB') THEN
+ IPSAP=KENTRY(I)
+ ELSE
+ CALL XABORT('SCR: WRONG SIGNATURE ('//TEXT12//').')
+ ENDIF
+ ITH=I
+ GO TO 60
+ ENDIF
+ 50 CONTINUE
+ CALL XABORT('SCR: SAPHYB '//TEXT12//' NOT FOUND.')
+ 60 IF(IMPX.GT.0) THEN
+ WRITE(IOUT,320) HENTRY(ITH)
+ CALL SCRTOC(IPSAP)
+ ENDIF
+ CALL LCMGET(IPSAP,'DIMSAP',DIMSAP)
+ IF(NGRP.EQ.0) THEN
+ NGRP=DIMSAP(20)
+ ELSE IF(NGRP.NE.DIMSAP(20)) THEN
+ WRITE(HSMG,'(9H SCR: THE,I4,27H-TH SAPHYB HAS AN INVALID N,
+ 1 24HUMBER OF ENERGY GROUPS (,I4,3H VS,I5,1H.)') ITH,NGRP,
+ 2 DIMSAP(20)
+ CALL XABORT(HSMG)
+ ENDIF
+ NMIL=DIMSAP(7)
+ NCAL=DIMSAP(19)
+ MY1=DIMSAP(6)+DIMSAP(14)
+ MY2=DIMSAP(15)
+ MD1=DIMSAP(3)
+ MD2=DIMSAP(5)+DIMSAP(6)
+ ALLOCATE(MIXC(NMIX),NISO(NMIX),LISO(NMIX),HISO(2*NMIX*MD2),
+ 1 ITODO(NMIX*MD2))
+ ALLOCATE(TERP(NCAL,NMIX),CONC(NMIX*MD2))
+*
+ CALL SCRDRV(IPSAP,LCUBIC,NMIX,IMPX,NMIL,NCAL,MD2,ITER,MAXNIS,
+ 1 MIXC,TERP,NISO,LISO,HISO,CONC,ITODO)
+ GO TO 130
+ ELSE IF(TEXT12.EQ.'TABLE') THEN
+ IF(.NOT.C_ASSOCIATED(IPMAP)) CALL XABORT('SCR: 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('SCR: 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('SCR: CHARACTER DATA EXPECTED(2).')
+ 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
+ CALL LCMGTC(KENTRY(I),'SIGNATURE',12,TEXT12)
+ IF(TEXT12.EQ.'L_SAPHYB') THEN
+ IPSAP=KENTRY(I)
+ ELSE
+ CALL XABORT('SCR: WRONG SIGNATURE ('//TEXT12//').')
+ ENDIF
+ ITH=I
+ GO TO 90
+ ENDIF
+ 80 CONTINUE
+ CALL XABORT('SCR: SAPHYB '//TEXT12//' NOT FOUND.')
+ 90 IF(IMPX.GT.0) THEN
+ WRITE(IOUT,320) HENTRY(ITH)
+ CALL SCRTOC(IPSAP)
+ ENDIF
+ CALL LCMGET(IPSAP,'DIMSAP',DIMSAP)
+ IF(NGRP.NE.DIMSAP(20)) THEN
+ WRITE(HSMG,'(9H SCR: THE,I4,27H-TH SAPHYB HAS AN INVALID N,
+ 1 24HUMBER OF ENERGY GROUPS (,I4,3H VS,I5,2H).)') ITH,NGRP,
+ 2 DIMSAP(20)
+ CALL XABORT(HSMG)
+ ENDIF
+ NMIL=DIMSAP(7)
+ NCAL=DIMSAP(19)
+ MY1=DIMSAP(6)+DIMSAP(14)
+ MY2=DIMSAP(15)
+ MD1=DIMSAP(3)
+ MD2=DIMSAP(5)+DIMSAP(6)
+ ALLOCATE(MIXC(NMIX),NISO(NMIX),LISO(NMIX),HISO(2*NMIX*MD2),
+ 1 ITODO(NMIX*MD2))
+ ALLOCATE(TERP(NCAL,NMIX),CONC(NMIX*MD2))
+*
+ CALL SCRRGR(IPSAP,IPMAP,LCUBIC,NMIX,IMPX,NMIL,NCAL,MD2,NCH,NB,
+ 1 NFUEL,NPARM,ITER,MAXNIS,MIXC,TERP,NISO,LISO,HISO,CONC,ITODO)
+ GO TO 130
+ ELSE IF(TEXT12.EQ.'EQUI') THEN
+ CALL REDGET(INDIC,NITMA,FLOTT,HEQUI,DFLOTT)
+ IF(INDIC.NE.3) CALL XABORT('SCR: CHARACTER DATA EXPECTED')
+ ELSE IF(TEXT12.EQ.'MASL') THEN
+ CALL REDGET(INDIC,NITMA,FLOTT,HMASL,DFLOTT)
+ IF(INDIC.NE.3) CALL XABORT('SCR: CHARACTER DATA EXPECTED')
+ ELSE IF(TEXT12.EQ.'LEAK') THEN
+ CALL REDGET(INDIC,NITMA,B2,TEXT12,DFLOTT)
+ IF(INDIC.NE.2) CALL XABORT('SCR: REAL DATA EXPECTED.')
+ ELSE IF(TEXT12.EQ.'CHAIN') THEN
+ IF(LMACRO) CALL XABORT('SCR: MICRO KEYWORD EXPECTED.')
+ CALL LCMGET(IPSAP,'DIMSAP',DIMSAP)
+ NBISO=DIMSAP(5) ! number of particularized isotopes
+ NMAC=DIMSAP(6) ! number of macroscopic sets
+ IF(NBISO.EQ.0) CALL XABORT('SCR: NO PARTICULARIZED ISOTOPES.')
+ IF(NMAC.EQ.0) CALL XABORT('SCR: NO MACROSCOPIC SETS.')
+ MY1=DIMSAP(6)+DIMSAP(14)
+ MY2=DIMSAP(15)
+ MD1=DIMSAP(3)
+ MD2=DIMSAP(5)+DIMSAP(6)
+ CALL LCMLEN(IPLIB,'VTOT_',ILONG,ITYLCM)
+ IF(ILONG.NE.NVTOT) CALL XABORT('SCR: INVALID LENGTH: VTOT(1).')
+ CALL LCMLEN(IPLIB,'YLDS_',ILONG,ITYLCM)
+ IF(ILONG.NE.MY1*MY2*NVTOT) CALL XABORT('SCR: INVALID LENGTH: Y'
+ 1 //'LDS(1).')
+ CALL LCMLEN(IPLIB,'DECAYC_',ILONG,ITYLCM)
+ IF(ILONG.NE.MD1*MD2*NVTOT) CALL XABORT('SCR: INVALID LENGTH: D'
+ 1 //'ECAYC(1)')
+ ALLOCATE(VTOT(NVTOT),YLDS(MY1,MY2,NVTOT),DECAY(MD1,MD2,NVTOT),
+ 1 NOMIS(NBISO+NMAC))
+ CALL LCMGET(IPLIB,'VTOT_',VTOT)
+ CALL LCMGET(IPLIB,'YLDS_',YLDS)
+ CALL LCMGET(IPLIB,'DECAYC_',DECAY)
+ CALL LCMSIX(IPSAP,'contenu',1)
+ CALL LCMGTC(IPSAP,'NOMISO',8,NBISO,NOMIS)
+ CALL LCMGTC(IPSAP,'NOMMAC',8,NMAC,NOMIS(NBISO+1:NBISO+NMAC))
+ CALL LCMSIX(IPSAP,' ',2)
+ WRITE(TEXT12,'(4Hcalc,I8)') 1
+ CALL LCMSIX(IPSAP,TEXT12,1) ! step up to calc
+ CALL LCMSIX(IPSAP,'info',1)
+ CALL LCMGET(IPSAP,'NISY',NISY)
+ ALLOCATE(IADRY(NISY))
+ CALL LCMGET(IPSAP,'ADRY',IADRY)
+ CALL LCMSIX(IPSAP,' ',2)
+ CALL LCMSIX(IPSAP,' ',2)
+*
+ 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('SCR: '//TEXT12//' IS AN INVALID KEYWORD.')
+ ENDIF
+ GO TO 20
+*----
+* COPY THE SAPHYB INTO MEMORY IN ORDER TO SAVE INTERPOLATION TIME
+*----
+ 130 CALL SCRMEM(IPSAP,IPMEM,NCAL,NMIL,NMIX,TERP,MIXC)
+ CALL LCMGET(IPSAP,'DIMSAP',DIMSAP)
+ MD2=DIMSAP(5)+DIMSAP(6)
+*----
+* FIND THE NUMBER OF DISCONTINUITY FACTORS
+*----
+ NSURFD=0
+ CALL LCMSIX(IPSAP,'geom',1)
+ CALL LCMLEN(IPSAP,'outgeom',ILONG,ITYLCM)
+ IF(ILONG.NE.0) THEN
+ CALL LCMSIX(IPSAP,'outgeom',1)
+ CALL LCMLEN(IPSAP,'SURF',NSURFD,ITYLCM)
+ CALL LCMSIX(IPSAP,' ',2)
+ ENDIF
+ CALL LCMSIX(IPSAP,' ',2)
+*----
+* BUILD THE INTERPOLATED MACROLIB
+*----
+ IF(LMACRO.AND.(MAXNIS.EQ.0)) THEN
+* build a macrolib
+ CALL SCRSAP(IPLIB,IPMEM,IACCS,NMIL,NMIX,NGRP,IMPX,HEQUI,HMASL,
+ 1 NCAL,NSURFD,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=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('SCR: INVALID LENGTH: VTOT('
+ 1 //'2).')
+ CALL LCMLEN(IPLIB,'YLDS_',ILONG,ITYLCM)
+ IF(ILONG.NE.MY1*MY2*(NVTOT-1)) CALL XABORT('SCR: 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 SCRLIB(MAXNIS,MAXISO,IPLIB,IPMEM,IACCS,NMIX,NGRP,IMPX,
+ 1 HEQUI,HMASL,NCAL,ITER,MY1,MY2,MD1,MD2,TERP,NISO,LISO,HISO,
+ 2 CONC,ITODO,MIXC,LRES,LPURE,ILUPS,B2,VTOT(NVTOT),YLDS(1,1,NVTOT),
+ 3 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
+ CALL LCMCL(IPMEM,2)
+ 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='SAPHYB'
+ 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 SCR:
+*----
+ 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,34H (0=NO ADF INFO/2=FLUX 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(/28H SCR: INTERPOLATING SAPHYB ',A12,2H'.)
+ END
generated by cgit v1.2.3 (git 2.46.0) at 2026-02-16 14:49:53 +0000