*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