*DECK LIBINP SUBROUTINE LIBINP (MAXMIX,MAXED,MAXISO,IPLIB,INDREC,IMPX,NBISO, 1 NGRO,NGT,NL,ITRANC,IPROB,ITIME,NLIB,NGF,IGRMAX,NDEPL,NCOMB, 2 NEDMAC,NBMIX,NRES,IPROC,IMAC,NDEL,ISOADD,MAXISM,HVECT,IPRECI, 3 SVDEPS,STERN) * *----------------------------------------------------------------------- * *Purpose: * Read the information related to microscopic cross section libraries. * *Copyright: * Copyright (C) 2002 Ecole Polytechnique de Montreal * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * *Author(s): A. Hebert * *Parameters: input/output * MAXMIX maximum value of NBMIX. * MAXED maximum value of NEDMAC. * MAXISO maximum number of isotopes permitted. * IPLIB pointer to the lattice microscopic cross section library * (L_LIBRARY signature). * INDREC type of action: * =1 a new microlib is created; =2 the microlib is updated; * =3 a read-only macrolib is copied in the microlib. * IMPX print flag. * NBISO number of isotopes present in the calculation domain. * NGRO number of energy groups. * NGT number of energy groups to test. * NL number of Legendre orders required in the calculation. * NL=1 (for isotropic scattering) or higher. * ITRANC type of transport correction: =0 no transport correction * =1 Apollo type transport correction; =2 recover from * library; =3 WIMS-D type; =4 leakage correction alone. * IPROB adjoint macrolib flag: * =0 direct problem; =1 adjoint problem. * ITIME MATXS type of fission spectrum: * =1 steady-state; =2 prompt. * NLIB number of cross-section libraries. * NGF number of fast groups without self-shielding. * IGRMAX maximum group index with self-shielding. * NDEPL number of depleting isotopes (used by EVO:). * NCOMB number of depleting mixtures (used by EVO:). * NEDMAC number of extra vector edits. * NBMIX number of mixtures defined in the microlib. * NRES number of resonant mixtures (used by SHI:, TONE: or USS:). * IPROC type of microlib processing: * =-1: skip temperature/dilution interpolation; * =0: perform temperature/dilution interpolation; * =1: perform temperature interpolation and compute physical * probability tables; * =2: perform temperature interpolation and build a * temperature-independent microlib; * =3: perform temperature interpolation and compute calendf- * type mathematical probability tables based on bin-type * cross-sections for total cross sections; * =4: compute slowing-down correlated probability tables. * =5: perform temperature interpolation and compute calendf- * type mathematical probability tables based on bin-type * cross-sections for all available cross-sections types. * =6: compute orthogonal bases for the resonance spectrum * expansion (RSE) method. * IMAC macrolib construction flag: * =0 do not compute an embedded macrolib; * =1 compute an embedded macrolib. * NDEL number of precursor groups for delayed neutrons. * ISOADD flag to complete the depletion chain: * =0 complete; =1 do not complete. * MAXISM maximum number of isotopes per mixture. * HVECT matxs names of the extra vector edits. * IPRECI accuracy index for probability tables in CALENDF. * SVDEPS rank accuracy of the singular value decomposition. * STERN Sternheimer flag (=0/1: off/on). * *----------------------------------------------------------------------- * USE GANLIB *---- * SUBROUTINE ARGUMENTS *---- TYPE(C_PTR) IPLIB INTEGER MAXMIX,MAXED,MAXISO,INDREC,IMPX,NBISO,NGRO,NGT,NL,ITRANC, > IPROB,ITIME,NLIB,NGF,IGRMAX,NDEPL,NCOMB,NEDMAC,NBMIX,NRES,IPROC, > IMAC,NDEL,ISOADD,MAXISM,IPRECI,STERN REAL SVDEPS CHARACTER*(*) HVECT(MAXED) *---- * LOCAL PARAMETERS *---- PARAMETER (IOUT=6,NHOBL=18,MAXPAR=5,MAXLIB=20,NSTATE=40, > MAXTRA=10000) TYPE(C_PTR) JPLIB DOUBLE PRECISION DBLINP CHARACTER TEXT4*4,TEXT12*12,HOBL(NHOBL)*8,HSMG*131,NAMFIL*64, > NAMLBT*8,NAMLCM*12,NAMMY*12 LOGICAL LNEW,EMPTY,LCM,LSET INTEGER KCHAR(2),ISTATE(NSTATE) REAL TMPDAY(3) *---- * ALLOCATABLE ARRAYS *---- INTEGER, ALLOCATABLE, DIMENSION(:) :: ISOMIX,NTFG,LSHI,NIR,ILLIB, > IEVOL,ITYP,KGAS INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ISONAM,ISONRF REAL, ALLOCATABLE, DIMENSION(:) :: DENISO,DENMIX,TMPISO,SNISO, > SBISO,GIR,TMPMIX,GSN,GSB LOGICAL, ALLOCATABLE, DIMENSION(:) :: MASK,MASKI,MASKL CHARACTER(LEN=8), ALLOCATABLE, DIMENSION(:,:) :: HLIB CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: SHINA CHARACTER(LEN=64), ALLOCATABLE, DIMENSION(:) :: HNAME *---- * DATA STATEMENTS *---- SAVE HOBL DATA HOBL /'NFTOT ','NG ','N2N ','N3N ', > 'N4N ','NA ','NP ','N2A ', > 'NNP ','ND ','NT ','NX ', > 'TRANC ','BSTC ','BSTR ','CSTC ', > 'CSTR ','H-FACTOR'/ *---- * SCRATCH STORAGE ALLOCATION *---- ALLOCATE(ISONAM(3,MAXISO),ISONRF(3,MAXISO),ISOMIX(MAXISO), > NTFG(MAXISO),LSHI(MAXISO),NIR(MAXISO),ILLIB(MAXISO),I > EVOL(MAXISO),ITYP(MAXISO),KGAS(MAXMIX)) ALLOCATE(DENISO(MAXISO),DENMIX(MAXMIX),TMPISO(MAXISO), > SNISO(MAXISO),SBISO(MAXISO),GIR(MAXISO),TMPMIX(MAXMIX)) ALLOCATE(MASK(MAXMIX),MASKI(MAXISO)) ALLOCATE(HNAME(MAXLIB)) ALLOCATE(HLIB(MAXISO,4),SHINA(MAXISO)) *---- * INITIALIZATIONS. *---- KEVOL=0 IF((NGT.NE.0).AND.(NGT.NE.NGRO)) THEN WRITE(HSMG,400) NGT,NGRO CALL XABORT(HSMG) ENDIF IF((INDREC.EQ.2).AND.(NBISO.GT.0)) THEN * THE LIBRARY IS UPDATED. READ OLD LIBRARY INFORMATION. CALL LIBINF(IPLIB,MAXISO,MAXLIB,MAXED,MAXMIX,NBISO,NGRO,NL, 1 ITRANC,NLIB,NCOMB,NEDMAC,NBMIX,ISONAM,ISONRF,ISOMIX,DENISO, 2 TMPISO,SHINA,SNISO,SBISO,NTFG,LSHI,GIR,NIR,MASKI,HLIB,IEVOL, 3 ITYP,ILLIB,KGAS,DENMIX,HVECT,HNAME) NNMIX=NBMIX DO 20 IIIMIX=1,MAXMIX DO 10 IIISO=1,NBISO IF(ISOMIX(IIISO).EQ.IIIMIX) THEN TMPMIX(IIIMIX)=TMPISO(IIISO) GO TO 20 ENDIF 10 CONTINUE TMPMIX(IIIMIX)=-1.0 20 CONTINUE ELSE NBISO=0 NELSN=0 NNMIX=0 DO IIIMIX=1,MAXMIX DENMIX(IIIMIX)=-1.0 TMPMIX(IIIMIX)=-1.0 KGAS(IIIMIX)=0 ENDDO ENDIF *---- * READ THE SPECIFICATION FOR EACH ISOTOPE. *---- TEXT12='MIXS' JLIB=0 LSET=.TRUE. 40 IF(TEXT12.EQ.'MIXS') THEN CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DBLINP) IF((INDIC.EQ.3).AND.(TEXT4.EQ.';')) THEN MASKI(:NBISO)=.TRUE. GO TO 100 ENDIF IF((INDIC.NE.3).OR.(TEXT4.NE.'LIB:')) > CALL XABORT('LIBINP: KEYWORD LIB: EXPECTED') CALL REDGET(INDIC,NITMA,FLOTT,NAMLBT,DBLINP) IF(INDIC.NE.3) > CALL XABORT('LIBINP: CHARACTER LIBRARY NAME REQUIRED.') IF( (NAMLBT.NE.'MATXS' ).AND.(NAMLBT.NE.'MATXS2').AND. > (NAMLBT.NE.'APLIB1').AND.(NAMLBT.NE.'APLIB2').AND. > (NAMLBT.NE.'APLIB3').AND.(NAMLBT.NE.'APXSM' ).AND. > (NAMLBT.NE.'DRAGON').AND.(NAMLBT.NE.'WIMSAECL').AND. > (NAMLBT.NE.'WIMSD4').AND.(NAMLBT.NE.'WIMSE' ).AND. > (NAMLBT.NE.'NDAS' ).AND.(NAMLBT.NE.'MICROLIB')) THEN WRITE(HSMG,'(29HLIBINP: INVALID LIBRARY TYPE ,A8)') NAMLBT CALL XABORT(HSMG) ENDIF CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP) IF((INDIC.NE.3).OR.(TEXT12.NE.'FIL:')) > CALL XABORT('LIBINP: FIL: EXPECTED.') NAMFIL=' ' CALL REDGET(INDIC,NITMA,FLOTT,NAMFIL,DBLINP) IF(INDIC.NE.3) CALL XABORT('LIBINP: CHARACTER DATA EXPECTED'// > '(1).') CALL LIBNRG(IPLIB,NAMLBT,NAMFIL,NGRO,NGT) IF(NLIB.GT.0) CALL LCMGTC(IPLIB,'ILIBRARYNAME',64,NLIB,HNAME) DO 50 ILIB=1,NLIB IF(HNAME(ILIB).EQ.NAMFIL) THEN JLIB=ILIB GO TO 60 ENDIF 50 CONTINUE NLIB=NLIB+1 IF(NLIB.GT.MAXLIB) CALL XABORT('LIBINP: MAXLIB OVERFLOW.') HNAME(NLIB)=NAMFIL CALL LCMPTC(IPLIB,'ILIBRARYNAME',64,NLIB,HNAME) JLIB=NLIB 60 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP) IF(INDIC.NE.3) CALL XABORT('LIBINP: CHARACTER DATA EXPECTED'// > '(2).') GO TO 40 ELSE IF(TEXT12.EQ.';') THEN GO TO 100 ELSE IF(TEXT12.EQ.'MIX') THEN CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP) IF(INDIC.EQ.1) THEN NNMIX=NITMA CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP) ELSE NNMIX=NNMIX+1 ENDIF IF(NNMIX.GT.MAXMIX) THEN CALL XABORT('LIBINP: MIX NUMBER LARGER THAN MAXMIX.') ELSE IF(NNMIX.LE.0) THEN CALL XABORT('LIBINP: MIX NUMBER .LE. 0.') ENDIF NBMIX=MAX(NNMIX,NBMIX) IF(INDIC.EQ.3) THEN CALL LCMLEN(IPLIB,'MACROLIB',ILONG,ITYLCM) IF((ILONG.NE.0).AND.LSET) THEN * perform a reset of the macrolib to be safe CALL LCMSIX(IPLIB,'MACROLIB',1) CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE) ISTATE(4)=0 CALL LCMPUT(IPLIB,'STATE-VECTOR',NSTATE,1,ISTATE) CALL LCMSIX(IPLIB,' ',2) MASKI(:NBISO)=.TRUE. LSET=.FALSE. ENDIF IF(TEXT12.EQ.'COMB') THEN *---- * THIS MIXTURE IS A COMBINATION OF OTHER MIXTURES. *---- CALL LCMINF(IPLIB,NAMLCM,NAMMY,EMPTY,ILONG,LCM) VOLTOT=0.0 70 VOLFRA=0.0 MIXCMB=0 CALL REDGET(INDIC,MIXCMB,FLOTT,TEXT12,DBLINP) IF(INDIC.EQ.3) THEN IF(VOLTOT.EQ.0.0) CALL XABORT('LIBINP: TOTAL VOLUME F' > //'RACTION OF 0.0 IS ILLEGAL.') GO TO 40 ENDIF IF(INDIC.EQ.2) CALL XABORT('LIBINP: MIXTURE NUMBER MISSI' > //'NG FOR COMBINATION.') CALL REDGET(INDIC,NITMA,VOLFRA,TEXT12,DBLINP) IF((INDIC.EQ.1).OR.(INDIC.EQ.3)) CALL XABORT('LIBINP: VO' > //'LUME FRACTION MISSING FOR COMBINATION.') IF(VOLFRA.EQ.0.0) CALL XABORT('LIBINP: INDIVIDUAL VOLUME' > //' FRACTION OF 0.0 IS ILLEGAL.') CALL LIBCMB(MAXMIX,MAXISO,NBISO,NEWISO,NNMIX,MIXCMB, 1 VOLTOT,VOLFRA,DENMIX,ISONAM,ISONRF,SHINA,ISOMIX,HLIB, 2 ILLIB,DENISO,TMPISO,LSHI,SNISO,SBISO,NTFG,NIR,GIR,MASKI, 3 IEVOL,ITYP) GO TO 70 ELSE WRITE(HSMG,'(41HLIBINP: ONLY COMB KEYWORD CAN FOLLOW MIXT, > 12HURE NUMBER (,A,8H READED))') TEXT12 CALL XABORT(HSMG) ENDIF ELSE IF(INDIC.NE.2) CALL XABORT('LIBINP: REAL NUMBER EXPECTED.') TMPMIX(NNMIX)=FLOTT CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP) IF(INDIC.EQ.2) THEN IF(DENMIX(NNMIX).EQ.-1.0) THEN CALL LIBCON(IPLIB,NNMIX,NBISO,ISOMIX,DENISO, > DENMIX(NNMIX),2) ENDIF DENMIX(NNMIX)=FLOTT CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP) ENDIF IF(INDIC.NE.3) CALL XABORT('LIBINP: CHARACTER DATA EXPECT'// > 'ED(4).') IF(TEXT12.EQ.'NOEV') THEN CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP) IF(INDIC.NE.3) CALL XABORT('LIBINP: CHARACTER DATA EXPE'// > 'CTED(5).') KEVOL=1 ELSE IF(TEXT12.EQ.'EVOL') THEN CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP) IF(INDIC.NE.3) CALL XABORT('LIBINP: CHARACTER DATA EXPE'// > 'CTED(6).') KEVOL=2 ELSE KEVOL=0 ENDIF IF(TEXT12.EQ.'NOGAS') THEN CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP) IF(INDIC.NE.3) CALL XABORT('LIBINP: CHARACTER DATA EXPE'// > 'CTED(7).') KGAS(NNMIX)=0 ENDIF IF(TEXT12.EQ.'GAS') THEN CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP) IF(INDIC.NE.3) CALL XABORT('LIBINP: CHARACTER DATA EXPE'// > 'CTED(8).') KGAS(NNMIX)=1 ENDIF IF((TEXT12.EQ.'MIX').OR.(TEXT12.EQ.'MIXS').OR. > (TEXT12.EQ.';')) THEN DO 80 IISO=1,NBISO IF(ISOMIX(IISO).EQ.NNMIX) THEN TMPISO(IISO)=TMPMIX(NNMIX) MASKI(IISO)=.TRUE. ENDIF 80 CONTINUE ENDIF ENDIF GO TO 40 ENDIF READ(TEXT12,'(2A4)') KCHAR(1),KCHAR(2) DO 81 I=1,NBISO IF((KCHAR(1).EQ.ISONAM(1,I)).AND.(KCHAR(2).EQ.ISONAM(2,I)).AND. > (NNMIX.EQ.ISOMIX(I))) THEN * UPDATE AN EXISTING ISOTOPE. NEWISO=I LNEW=.FALSE. GO TO 82 ENDIF 81 CONTINUE LNEW=.TRUE. NBISO=NBISO+1 NEWISO=NBISO IF(NBISO.GT.MAXISO) THEN WRITE(6,'(15H LIBINP: NBISO=,I6,8H MAXISO=,I6)') NBISO,MAXISO CALL XABORT('LIBINP: MAXISO TOO SMALL.') ENDIF READ(TEXT12,'(3A4)') (ISONAM(I0,NBISO),I0=1,3) READ(TEXT12,'(3A4)') (ISONRF(I0,NBISO),I0=1,3) SHINA(NBISO)=' ' HLIB(NBISO,2:4)=' ' NTFG(NBISO)=0 LSHI(NBISO)=0 GIR(NBISO)=1.0 NIR(NBISO)=0 ISOMIX(NBISO)=NNMIX DENISO(NBISO)=0.0 SNISO(NBISO)=1.0E10 SBISO(NBISO)=1.0E10 IEVOL(NBISO)=KEVOL ITYP(NBISO)=1 * 82 MASKI(NEWISO)=.TRUE. HLIB(NEWISO,1)=NAMLBT ILLIB(NEWISO)=JLIB TMPISO(NEWISO)=TMPMIX(NNMIX) CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP) IF(INDIC.EQ.3.AND.TEXT12.EQ.'=') THEN CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP) IF(INDIC.EQ.3) THEN READ(TEXT12,'(3A4)') (ISONRF(I0,NEWISO),I0=1,3) ELSE CALL XABORT('LIBINP: LIBRARY ISOTOPE NAME MISSING AFTER =') ENDIF CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP) ENDIF IF(INDIC.NE.2) THEN CALL XABORT('LIBINP: ISOTOPIC DENSITY OR WEIGHT PERCENT EXPECT' > //'ED.') ENDIF IF((.NOT.LNEW).AND.(DENMIX(NNMIX).NE.-1.0).AND.(ABS(DENISO(NEWISO) 1 -FLOTT).GT.1.0E-4)) THEN CALL XABORT('LIBINP: PERTURBATION OF THE WEIGHT PERCENTS IS FOR' 1 //'BIDDEN.') ENDIF DENISO(NEWISO)=FLOTT 90 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP) IF(INDIC.EQ.2) THEN SNISO(NEWISO)=FLOTT SBISO(NEWISO)=FLOTT ELSE IF(INDIC.EQ.1) THEN LSHI(NEWISO)=NITMA NRES=MAX(NRES,NITMA) IF(IPROC.EQ.3) THEN NIR(NEWISO)=1 GIR(NEWISO)=-998.0 ELSE IF(IPROC.EQ.4) THEN NIR(NEWISO)=1 GIR(NEWISO)=-999.0 ELSE IF(IPROC.EQ.5) THEN NIR(NEWISO)=1 GIR(NEWISO)=-1000.0 ELSE IF(IPROC.EQ.6) THEN NIR(NEWISO)=1 GIR(NEWISO)=-1001.0 ENDIF ELSE IF(TEXT12.EQ.'INF') THEN SNISO(NEWISO)=1.0E10 SBISO(NEWISO)=1.0E10 ELSE IF(TEXT12.EQ.'SHIB') THEN CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP) IF(INDIC.NE.3) CALL XABORT('LIBINP: CHARACTER DATA EXPECTED'// > '(9).') SHINA(NEWISO)=TEXT12 ELSE IF(TEXT12.EQ.'THER') THEN CALL REDGET(INDIC,NTFG(NEWISO),FLOTT,TEXT12,DBLINP) IF(INDIC.NE.1) CALL XABORT('LIBINP: NUMBER OF THERMALIZED '// > 'GROUPS REQUIRED.') CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP) IF(INDIC.NE.3) CALL XABORT('LIBINP: CHARACTER DATA EXPECTED'// > '(10).') HLIB(NEWISO,3)=TEXT12(:8) ELSE IF(TEXT12.EQ.'TCOH') THEN CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP) IF(INDIC.NE.3) CALL XABORT('LIBINP: CHARACTER DATA EXPECTED'// > '(11).') HLIB(NEWISO,2)=TEXT12(:8) ELSE IF(TEXT12.EQ.'RESK') THEN TEXT12='RESK' HLIB(NEWISO,4)=TEXT12(:8) ELSE IF(TEXT12.EQ.'DBYE') THEN CALL REDGET(INDIC,NITMA,TMPISO(NEWISO),TEXT12,DBLINP) IF(INDIC.NE.2) CALL XABORT('LIBINP: REAL DATA EXPECTED.') ELSE IF(TEXT12.EQ.'CORR') THEN CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP) IF(INDIC.NE.1) CALL XABORT('LIBINP: INTEGER DATA EXPECTED(2).') LSHI(NEWISO)=-NITMA NRES=MAX(NRES,NITMA) IF(IPROC.EQ.3) THEN NIR(NEWISO)=1 GIR(NEWISO)=-998.0 ELSE IF(IPROC.EQ.4) THEN NIR(NEWISO)=1 GIR(NEWISO)=-999.0 ELSE IF(IPROC.EQ.5) THEN NIR(NEWISO)=1 GIR(NEWISO)=-1000.0 ELSE IF(IPROC.EQ.6) THEN NIR(NEWISO)=1 GIR(NEWISO)=-1001.0 ENDIF ELSE IF(TEXT12.EQ.'IRSET') THEN CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP) IF(INDIC.EQ.2) THEN GIR(NEWISO)=FLOTT IF((IPROC.EQ.3).AND.(FLOTT.NE.1.0)) CALL XABORT('LIBINP: P' > //'T MAIN OPTION NOT EXPECTED.') IF((IPROC.EQ.4).AND.(FLOTT.NE.1.0)) CALL XABORT('LIBINP: P' > //'TSL MAIN OPTION NOT EXPECTED.') ELSE IF(INDIC.EQ.3) THEN IF(TEXT12.EQ.'PT') THEN IF(IPROC.NE.3) CALL XABORT('LIBINP: PT MAIN OPTION NOT ' > //'SET.') GIR(NEWISO)=-998.0 ELSE IF(TEXT12.EQ.'PTSL') THEN IF(IPROC.NE.4) CALL XABORT('LIBINP: PTSL MAIN OPTION NO' > //'T SET.') GIR(NEWISO)=-999.0 ELSE IF(TEXT12.EQ.'PTMC') THEN IF(IPROC.NE.5) CALL XABORT('LIBINP: PTMC MAIN OPTION NO' > //'T SET.') GIR(NEWISO)=-1000.0 ELSE IF(TEXT12.EQ.'RSE') THEN IF(IPROC.NE.6) CALL XABORT('LIBINP: RSE MAIN OPTION NOT' > //' SET.') GIR(NEWISO)=-1001.0 ELSE CALL XABORT('LIBINP: PT, PTSL OR PTMC EXPECTED.') ENDIF ELSE CALL XABORT('LIBINP: REAL OR CHARACTER DATA EXPECTED.') ENDIF CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DBLINP) IF(INDIC.EQ.1) THEN IF((NITMA.LT.0).OR.(NITMA.GT.NGRO)) CALL > XABORT('LIBINP: INVALID VALUE OF NIR.') NIR(NEWISO)=NITMA ELSE IF((INDIC.EQ.3).AND.(TEXT12.EQ.'NONE')) THEN NIR(NEWISO)=NGRO+1 ELSE CALL XABORT('LIBINP: NONE OR INTEGER DATA EXPECTED.') ENDIF ELSE IF(TEXT12.EQ.'NOEV') THEN IEVOL(NEWISO)=1 ELSE IF(TEXT12.EQ.'EVOL') THEN IEVOL(NEWISO)=2 ELSE IF(TEXT12.EQ.'SAT') THEN IEVOL(NEWISO)=3 ELSE IF(INDIC.NE.3) CALL XABORT('LIBINP: CHARACTER DATA EXPECTED'// > '(12).') GO TO 40 ENDIF GO TO 90 *---- * INCLUDE SOME DEFAULT EXTRA EDITS. *---- 100 IF((NGRO.EQ.0).OR.(NGT.EQ.0)) CALL XABORT('LIBINP: NUMBER OF GRO' > //'UPS REQUIRED.') DO 120 I=1,NHOBL DO 110 IED=1,NEDMAC IF(HVECT(IED).EQ.HOBL(I)) GO TO 120 110 CONTINUE NEDMAC=NEDMAC+1 IF(NEDMAC.GT.MAXED) CALL XABORT('LIBINP: TOO MANY EXTRA EDITS R' > //'EQUESTED.') HVECT(NEDMAC)=HOBL(I) 120 CONTINUE *---- * ADD THE MISSING ISOTOPES FROM THE DEPLETION CHAIN. *---- IF((NDEPL.NE.0).AND.(ISOADD.EQ.0)) THEN NBISOL=NBISO CALL LCMSIX(IPLIB,'DEPL-CHAIN',1) CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE) IF(ISTATE(1).NE.NDEPL) CALL XABORT('LIBINP: INVALID NUMBER OF' > //' DEPLETING ISOTOPES.') NFISS=ISTATE(2) NSUPF=ISTATE(5) NSUPS=ISTATE(7) NREAC=ISTATE(8) NPAR=ISTATE(9) CALL LIBEAD(IPLIB,MAXISO,MAXMIX,IMPX,NDEPL,NFISS,NSUPS, 1 NREAC,NPAR,NBISO,ISONAM,ISONRF,HLIB,ILLIB,ISOMIX,TMPISO, 2 IEVOL,ITYP,NCOMB) CALL LCMSIX(IPLIB,' ',2) * DO 140 ISOT=NBISOL+1,NBISO SNISO(ISOT)=1.0E10 SBISO(ISOT)=1.0E10 DENISO(ISOT)=0.0 NTFG(ISOT)=0 SHINA(ISOT)=' ' HLIB(ISOT,2:4)=' ' LSHI(ISOT)=0 GIR(ISOT)=1.0 NIR(ISOT)=0 MASKI(ISOT)=.TRUE. 140 CONTINUE ENDIF *---- * SET THE MIXTURE MASKS. *---- DO 170 I=1,NBMIX MASK(I)=.FALSE. DO 150 JJ=1,NBISO IF((ISOMIX(JJ).EQ.I).AND.MASKI(JJ)) THEN MASK(I)=.TRUE. GO TO 160 ENDIF 150 CONTINUE 160 CONTINUE 170 CONTINUE *---- * FIND AND NAME DISTINCT ISOTOPES. *---- DO 200 I=1,NBISO IF(MASKI(I).AND.(ILLIB(I).NE.0)) THEN * CATENATE THE 4-DIGIT MIXTURE SUFFIX. DO 190 J=1,I-1 IF((ISONAM(1,I).NE.ISONAM(1,J)).OR.(ISONAM(2,I).NE.ISONAM(2,J))) > GO TO 190 IF((ISONRF(1,I).NE.ISONRF(1,J)).OR.(ISONRF(2,I).NE.ISONRF(2,J)) > .OR.(ISONRF(3,I).NE.ISONRF(3,J))) GO TO 190 IF(SHINA(I).NE.SHINA(J)) GO TO 190 IF((LSHI(I).NE.0).AND.(LSHI(J).NE.0).AND.(DENISO(I).EQ.0.0) > .AND.(DENISO(J).NE.0.0)) GO TO 190 IF((LSHI(I).NE.0).AND.(LSHI(J).NE.0).AND.(DENISO(I).NE.0.0) > .AND.(DENISO(J).EQ.0.0)) GO TO 190 DO 180 IOP=1,4 IF(HLIB(I,IOP).NE.HLIB(J,IOP)) GO TO 190 180 CONTINUE IF(ILLIB(I).NE.ILLIB(J)) GO TO 190 IF((NTFG(I).NE.NTFG(J)).OR.(GIR(I).NE.GIR(J)).OR. > (NIR(I).NE.NIR(J)).OR.(TMPISO(I).NE.TMPISO(J))) GO TO 190 IF(((LSHI(I).EQ.0).AND.(LSHI(J).EQ.0)) > .OR.((IPROC.NE.0).AND.(LSHI(I).EQ.LSHI(J)))) THEN MASKI(I)=.FALSE. WRITE(TEXT4,'(I4.4)') ISOMIX(J) GO TO 195 ENDIF 190 CONTINUE WRITE(TEXT4,'(I4.4)') ISOMIX(I) 195 READ(TEXT4,'(A4)') ISONAM(3,I) ENDIF 200 CONTINUE * IF(IMPX.GT.1) THEN WRITE (IOUT,320) DO 210 I=1,NBISO IF(ISOMIX(I).EQ.0) GO TO 210 DZN=DENMIX(ISOMIX(I)) IF(DZN.EQ.-1.0) THEN WRITE (IOUT,330) I,(ISONAM(I0,I),I0=1,3),(ISONRF(I0,I), > I0=1,3),HLIB(I,1),ILLIB(I),ISOMIX(I),DENISO(I), > TMPISO(I),SNISO(I),LSHI(I),SHINA(I),NTFG(I),HLIB(I,3), > HLIB(I,4),HLIB(I,2) ELSE WRITE (IOUT,340) I,(ISONAM(I0,I),I0=1,3),(ISONRF(I0,I), > I0=1,3),HLIB(I,1),ILLIB(I),ISOMIX(I),DZN,DENISO(I), > TMPISO(I),SNISO(I),LSHI(I),SHINA(I),NTFG(I),HLIB(I,3), > HLIB(I,4),HLIB(I,2) ENDIF 210 CONTINUE ENDIF *---- * READ OLD DILUTIONS IF PRESENT. *---- NGIS=NGRO*NBISO ALLOCATE(GSN(NGIS),GSB(NGIS)) GSN(:NGIS)=1.0E10 GSB(:NGIS)=1.0E10 CALL LCMLEN(IPLIB,'ISOTOPESDSN',NELSN,ITYLCM) IF(NELSN.GT.0) THEN CALL LCMGET(IPLIB,'ISOTOPESDSN',GSN) CALL LCMGET(IPLIB,'ISOTOPESDSB',GSB) ENDIF ILOCSN=0 ILOCSB=0 DO 215 ISO=1,NBISO IF(SNISO(ISO).GT.0.0) THEN GSN(ILOCSN+1:ILOCSN+NGRO)=SNISO(ISO) GSB(ILOCSB+1:ILOCSB+NGRO)=SBISO(ISO) ENDIF ILOCSN=ILOCSN+NGRO ILOCSB=ILOCSB+NGRO 215 CONTINUE *---- * SAVE THE LIBRARY SPECIFIC INFORMATION. *---- NBMIX=0 DO 220 I=1,NBISO NBMIX=MAX(NBMIX,ISOMIX(I)) 220 CONTINUE IF(NBMIX.GT.MAXMIX) CALL XABORT('LIBINP: MAXMIX TOO SMALL.') TEXT12='L_LIBRARY' CALL LCMPTC(IPLIB,'SIGNATURE',12,TEXT12) ISTATE(:NSTATE)=0 ISTATE(1)=MAXMIX ISTATE(2)=NBISO ISTATE(3)=NGRO ISTATE(4)=NL ISTATE(5)=ITRANC ISTATE(6)=IPROB ISTATE(7)=ITIME ISTATE(8)=NLIB ISTATE(9)=MIN(NGF,NGRO+1) ISTATE(10)=IGRMAX ISTATE(11)=NDEPL ISTATE(12)=NCOMB ISTATE(13)=NEDMAC ISTATE(14)=NBMIX ISTATE(15)=NRES ISTATE(17)=IPROC ISTATE(18)=IMAC ISTATE(19)=NDEL ISTATE(20)=0 ISTATE(21)=ISOADD ISTATE(22)=MAXISM ISTATE(23)=IPRECI ISTATE(27)=STERN CALL LCMPUT(IPLIB,'STATE-VECTOR',NSTATE,1,ISTATE) CALL LCMPUT(IPLIB,'ISOTOPESUSED',3*NBISO,3,ISONAM) CALL LCMPUT(IPLIB,'ISOTOPERNAME',3*NBISO,3,ISONRF) CALL LCMPUT(IPLIB,'ISOTOPESMIX',NBISO,1,ISOMIX) CALL LCMPUT(IPLIB,'ISOTOPESTODO',NBISO,1,IEVOL) CALL LCMPUT(IPLIB,'ISOTOPESTYPE',NBISO,1,ITYP) IF(NLIB.GT.0) THEN CALL LCMPTC(IPLIB,'ILIBRARYTYPE',8,NBISO,HLIB(:NBISO,1)) CALL LCMPUT(IPLIB,'ILIBRARYINDX',NBISO,1,ILLIB) CALL LCMPTC(IPLIB,'ISOTOPESCOH',8,NBISO,HLIB(:NBISO,2)) CALL LCMPTC(IPLIB,'ISOTOPESINC',8,NBISO,HLIB(:NBISO,3)) CALL LCMPTC(IPLIB,'ISOTOPESRESK',8,NBISO,HLIB(:NBISO,4)) CALL LCMPUT(IPLIB,'ISOTOPESNTFG',NBISO,1,NTFG) CALL LCMPTC(IPLIB,'ISOTOPESHIN',12,NBISO,SHINA) CALL LCMPUT(IPLIB,'ISOTOPESSHI',NBISO,1,LSHI) CALL LCMPUT(IPLIB,'ISOTOPESDSN',NGIS,2,GSN) CALL LCMPUT(IPLIB,'ISOTOPESDSB',NGIS,2,GSB) CALL LCMPUT(IPLIB,'ISOTOPESGIR',NBISO,2,GIR) CALL LCMPUT(IPLIB,'ISOTOPESNIR',NBISO,1,NIR) ENDIF CALL LCMPUT(IPLIB,'ISOTOPESTEMP',NBISO,2,TMPISO) IF(NEDMAC.GT.0) THEN CALL LCMPTC(IPLIB,'ADDXSNAME-P0',8,NEDMAC,HVECT) ENDIF CALL LCMPUT(IPLIB,'MIXTUREGAS',NBMIX,1,KGAS) DEALLOCATE(GSB,GSN) *---- * CHECK FOR DUPLICATE ALIAS. *---- DO 255 I=1,NBISO IF(ISOMIX(I).EQ.0) GO TO 255 DO 250 J=I+1,NBISO IF((ISOMIX(I).EQ.ISOMIX(J)).AND.(ISONRF(1,I).EQ.ISONRF(1,J)) 1 .AND.(ISONRF(2,I).EQ.ISONRF(2,J)) 2 .AND.(ISONRF(3,I).EQ.ISONRF(3,J)).AND.(LSHI(I).NE.0)) THEN WRITE(HSMG,390) (ISONAM(I1,I),I1=1,3),(ISONAM(I1,J),I1=1,3), > (ISONRF(I1,I),I1=1,3),ISOMIX(I) CALL XABORT(HSMG) ENDIF 250 CONTINUE 255 CONTINUE *---- * READ AND INTERPOLATE IN THE MICROSCOPIC X-SECTIONS LIBRARIES. *---- IF(NGRO.EQ.0) CALL XABORT('LIBINP: NUMBER OF GROUPS NOT DEFINED.') IF((IPROC.EQ.0).AND.(NLIB.GT.0)) THEN * ------------------------------------ CALL LIBLIB (IPLIB,NBISO,MASKI,IMPX) * ------------------------------------ ELSE IF((IPROC.GT.0).AND.(NLIB.GT.0)) THEN CALL LIBSUB (MAXISO,MAXTRA,IPLIB,IPROC,NGRO,NBISO,NLIB,ISONAM, 1 TMPISO,MASKI,IPRECI,SVDEPS,IMPX) ELSE IF((IPROC.EQ.-1).AND.(NLIB.GT.0)) THEN JPLIB=LCMLID(IPLIB,'ISOTOPESLIST',NBISO) ENDIF CALL LCMVAL(IPLIB,' ') * IF(IMPX.GT.0) THEN CALL LCMGET(IPLIB,'STATE-VECTOR',ISTATE) ITRANC=ISTATE(5) NGF=ISTATE(9) IGRMAX=ISTATE(10) NDEPL=ISTATE(11) NBESP=ISTATE(16) NDEL=ISTATE(19) NFISS=ISTATE(20) NPART=ISTATE(26) STERN=ISTATE(27) WRITE (IOUT,300) IMPX,IPROB,ITIME,NLIB,NGF,IGRMAX,NBISO,NBMIX, 1 NRES,NCOMB,NEDMAC,NGRO,NL WRITE (IOUT,305) ITRANC,NBESP,IPROC,IMAC,NDEL,NDEPL,NFISS, 1 ISOADD,MAXISM,IPRECI,NPART,STERN IF(IPROC.EQ.6) WRITE(IOUT,306) SVDEPS IF(NEDMAC.GT.0) WRITE (IOUT,310) (I,HVECT(I),I=1,NEDMAC) IF(NLIB.GT.0) THEN WRITE(IOUT,315) DO 260 ILIB=1,NLIB WRITE(IOUT,'(1X,I4,4H -- ,A)') ILIB,HNAME(ILIB) 260 CONTINUE ENDIF ENDIF *---- * COMPUTE AND STORE THE EFFECTIVE DENSITY FROM AWR AND MATERIAL DENSITY *---- DO 270 IMX=1,NBMIX IF(MASK(IMX).AND.(DENMIX(IMX).GE.0.0)) THEN CALL LIBCON(IPLIB,IMX,NBISO,ISOMIX,DENISO,DENMIX(IMX),1) ENDIF 270 CONTINUE IF(IMPX.GT.0) THEN WRITE (IOUT,370) DO 280 I=1,NBISO IF(ISOMIX(I).EQ.0) GO TO 280 IF(MASK(ISOMIX(I))) THEN WRITE (IOUT,380) I,(ISONAM(I0,I),I0=1,3),(ISONRF(I0,I), > I0=1,3),HLIB(I,1),ILLIB(I),ISOMIX(I),DENISO(I), > TMPISO(I),SNISO(I),LSHI(I),SHINA(I),NTFG(I), > HLIB(I,3),HLIB(I,4),HLIB(I,2) ENDIF 280 CONTINUE ENDIF CALL LCMPUT(IPLIB,'ISOTOPESDENS',NBISO,2,DENISO) *---- * STORE MIXTURES DENSITIES *---- CALL LCMPUT(IPLIB,'MIXTURESDENS',NBMIX,2,DENMIX) *---- * COMPUTE THE MACROSCOPIC X-SECTIONS. *---- IF(IMAC.EQ.1) THEN ALLOCATE(MASKL(NGRO)) MASKL(:NGRO)=.TRUE. ITSTMP=0 TMPDAY(1)=0.0 TMPDAY(2)=0.0 TMPDAY(3)=0.0 CALL LIBMIX(IPLIB,NBMIX,NGRO,NBISO,ISONAM,ISOMIX,DENISO,MASK, > MASKL,ITSTMP,TMPDAY) DEALLOCATE(MASKL) ENDIF *---- * SCRATCH STORAGE DEALLOCATION *---- DEALLOCATE(HNAME) DEALLOCATE(MASKI,MASK) DEALLOCATE(HLIB) DEALLOCATE(TMPMIX,GIR,SBISO,SNISO,TMPISO,DENMIX,DENISO) DEALLOCATE(KGAS,ITYP,IEVOL,ILLIB,NIR,LSHI,NTFG,ISOMIX, > ISONRF,ISONAM) RETURN * 300 FORMAT(/8H OPTIONS/8H -------/ 1 7H IMPX ,I6,30H (0=NO PRINT/1=SHORT/2=MORE)/ 2 7H IPROB ,I6,23H (0=DIRECT/1=ADJOINT)/ 3 7H ITIME ,I6,28H (1=STEADY-STATE/2=PROMPT)/ 4 7H NLIB ,I6,32H (NUMBER OF SETS OF LIBRARIES)/ 5 7H NGF ,I6,48H (NUMBER OF FAST GROUP WITHOUT SELF-SHIELDING)/ 6 7H IGRMAX,I6,41H (LAST GROUP INDEX WITH SELF-SHIELDING)/ 7 7H NBISO ,I6,36H (NUMBER OF ISOTOPES OR MATERIALS)/ 8 7H NBMIX ,I6,23H (NUMBER OF MIXTURES)/ 9 7H NRES ,I6,40H (NUMBER OF SETS OF RESONANT MIXTURES)/ 1 7H NCOMB ,I6,33H (NUMBER OF DEPLETING MIXTURES)/ 2 7H NEDMAC,I6,34H (NUMBER OF CROSS SECTION EDITS)/ 3 7H NGRO ,I6,28H (NUMBER OF ENERGY GROUPS)/ 4 7H NL ,I6,30H (NUMBER OF LEGENDRE ORDERS)) 305 FORMAT( 1 7H ITRANC,I6,45H (0=NO TRANSPORT CORRECTION/1=APOLLO TYPE/2, 2 57H=RECOVER FROM LIBRARY/3=WIMS-D TYPE/4=LEAKAGE CORRECTION)/ 3 7H NBESP ,I6,47H (NUMBER OF ENERGY-DEPENDENT FISSION SPECTRA)/ 4 7H IPROC ,I6,47H (-1=SKIP LIBRARY PROCESSING/0=DILUTION INTER, 5 49HPOLATION/1=USE PHYSICAL TABLES/2=BUILD A DRAGLIB// 6 17X,56H3=COMPUTE CALENDF TABLES/4=SLOWING-DOWN TABLES/5=ALL CAL, 7 11HENDF/6=RSE)/ 8 7H IMAC ,I6,45H (0=DO NOT/1=DO BUILD AN EMBEDDED MACROLIB)/ 9 7H NDEL ,I6,31H (NUMBER OF PRECURSOR GROUPS)/ 1 7H NDEPL ,I6,33H (NUMBER OF DEPLETING ISOTOPES)/ 2 7H NFISS ,I6,48H (NUMBER OF FISSILE ISOTOPES WITH PYIELD DATA)/ 3 7H ISOADD,I6,37H (0=COMPLETE BURNUP CHAIN/1=DO NOT)/ 4 7H MAXISM,I6,40H (MAX. NUMBER OF ISOTOPES PER MIXTURE)/ 5 7H IPRECI,I6,34H (CALENDF ACCURACY FLAG:1/2/3/4)/ 6 7H NPART ,I6,34H (NUMBER OF COMPANION PARTICLES)/ 7 7H STERN ,I6,47H (STERNHEIMER FLAG FOR CHARGED PARTICLES:0/1)) 306 FORMAT(7H SVDEPS,1P,E10.3,27H (RANK ACCURACY OF THE SVD)) 310 FORMAT(/45H CROSS SECTION EDIT NAME (LCM DIRECTORY NAME)/1X, 1 44(1H-)/(1X,I3,2X,A6,5X,I3,2X,A6,5X,I3,2X,A6)) 315 FORMAT(/35H AVAILABLE CROSS-SECTION LIBRARIES:) 320 FORMAT(/' SPEC LOCAL NAME ISOTOPE FROM LIBRARY MI', 1 'X DENSITY WEIGHT% TEMP(K) SIGZERO SELF-SHIEL ', 2 'THERMAL CORRECTION'/' ------- ------------ ------------ --', 3 '---------- ---- ---------- ---------- --------- --------', 4 ' ---------- ------------------') 330 FORMAT(1X,I7,2X,3A4,2X,3A4,2X,A8,I4,2X,I4,1P,E12.4,12X,E11.3, 1 E10.2,I4,2X,A8,I4,1X,3A8) 340 FORMAT(1X,I7,2X,3A4,2X,3A4,2X,A8,I4,2X,I4,1P,2E12.4,E11.3,E10.2, 1 I4,2X,A8,I4,1X,3A8) 370 FORMAT(/58X,'NUMBER'/' SPEC LOCAL NAME ISOTOPE FRO', 1 'M LIBRARY MIX DENSITY TEMP(K) SIGZERO SELF-SHIEL', 2 ' THERMAL CORRECTION'/' ------- ------------ ------------ ', 3 '------------ ---- ---------- --------- --------- -------', 4 '--- ------------------') 380 FORMAT(1X,I7,2X,3A4,2X,3A4,2X,A8,I4,2X,I4,1P,E12.4,2E11.3,I4,2X, 1 A8,I4,1X,3A8) 390 FORMAT(9HLIBINP: ',3A4,7H' AND ',3A4,24H' ARE BOTH ALIAS FOR THE, 1 23H SAME LIBRARY ISOTOPE ',3A4,12H' IN MIXTURE,I5,1H.) 400 FORMAT('LIBINP: Invalid group structure',2I10) END