diff options
Diffstat (limited to 'Dragon/src/LIBLIC.F')
| -rw-r--r-- | Dragon/src/LIBLIC.F | 253 |
1 files changed, 253 insertions, 0 deletions
diff --git a/Dragon/src/LIBLIC.F b/Dragon/src/LIBLIC.F new file mode 100644 index 0000000..a669c9d --- /dev/null +++ b/Dragon/src/LIBLIC.F @@ -0,0 +1,253 @@ +*DECK LIBLIC + SUBROUTINE LIBLIC (IPLIB,NBISO,MASKI,IMPX,NGRO,NL,ITRANC,ITIME, + 1 NLIB,NED,HVECT,ISONAM,ISONRF,IPISO,ISHINA,TMPISO,IHLIB,ILLIB, + 2 INAME,NTFG,LSHI,SN,SB,NIR,GIR,NGF,IGRMAX,NDEL,NBESP,NPART,IPROC) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Transcription of the useful interpolated microscopic cross section +* data from various format of libraries to lcm. A two dimensional +* interpolation in temperature and dilution is performed (Part B). +* +*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 +* IPLIB pointer to the lattice microscopic cross section library +* (L_LIBRARY signature). +* NBISO number of isotopes present in the calculation domain. +* MASKI isotopic masks. An isotope with index I is processed if +* MASKI(I)=.true. +* IMPX print flag. +* NGRO number of energy groups. +* 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. +* ITIME MATXS type of fission spectrum: +* =1 steady-state; =2 prompt. +* NLIB number of independent libraries. +* NED number of requested vector edits. +* HVECT names of the requested vector edits. +* ISONAM alias name of each isotope. +* ISONRF library reference name of each isotope. +* IPISO pointer array towards microlib isotopes. +* ISHINA self-shielding name of each isotope. +* TMPISO temperature of each isotope. +* IHLIB isotope options. +* ILLIB xs library index for each isotope (.le.NLIB). +* INAME names of the NLIB xs libraries. +* NTFG number of thermal groups where the thermal inelastic +* correction is applied. +* LSHI resonant region number associated with each isotope. +* Infinite dilution will be assumed if LSHI(i)=0. +* SN dilution cross section in each energy group of each +* isotope. a value of 1.0E10 is used for infinite dilution. +* SB dilution cross section as used in Livolant and Jeanpierre +* normalization. +* NIR first group index with an imposed IR slowing-down model; +* =0 for no IR model. +* GIR value of the imposed Goldstein-Cohen parameter for groups +* with an IR model. +* NGF number of fast groups without self-shielding. +* IGRMAX maximum group index with self-shielding. +* NDEL number of precursor groups for delayed neutrons. +* NBESP number of energy-dependent fission spectra. +* NPART number of particles. +* IPROC type of library processing. +* +*----------------------------------------------------------------------- +* + USE GANLIB +#if defined(HDF5_LIB) + USE hdf5_wrap +#endif /* defined(HDF5_LIB) */ + IMPLICIT NONE +*---- +* SUBROUTINE ARGUMENTS +*---- + TYPE(C_PTR) IPLIB,IPISO(NBISO) + INTEGER NBISO,IMPX,NGRO,NL,ITRANC,ITIME,NLIB,NED,NGF,IGRMAX,NDEL, + > NBESP,NPART,IPROC,ISONAM(3,NBISO),ISONRF(3,NBISO), + > ISHINA(3,NBISO),IHLIB(2,NBISO,4),ILLIB(NBISO),INAME(16,NLIB), + > NTFG(NBISO),LSHI(NBISO),NIR(NBISO) + LOGICAL MASKI(NBISO) + CHARACTER*(*) HVECT(NED) + REAL TMPISO(NBISO),SN(NGRO,NBISO),SB(NGRO,NBISO),GIR(NBISO) +*---- +* INTERNAL PARAMETERS +*---- + TYPE(C_PTR) IPDRL,IPMIC + INTEGER MAXDIL + PARAMETER (MAXDIL=65) +*---- +* LOCAL VARIABLES +*---- + INTEGER I,J,IND1,NBIS,NDEL0,NGF0,NGFR0,MAXTRA,ILIB,ILONG,NBESP0, + 1 NPART0 + CHARACTER NAMLBT*8,NAMFIL*64,HSMG*131,NAMLCM*12,NAMMY*12 + LOGICAL LTEST,EMPTY,LCM,LEXIST +*---- +* CHECK FOR DUPLICATE ISOTOPE NAMES. +*---- + DO 40 I=1,NBISO + IF(MASKI(I).AND.(ILLIB(I).NE.0).AND.(LSHI(I).NE.0)) THEN + DO 30 J=I+1,NBISO + IF(MASKI(J).AND.(ISONAM(1,I).EQ.ISONAM(1,J)).AND. + 1 (ISONAM(2,I).EQ.ISONAM(2,J)).AND. + 2 (ISONAM(3,I).EQ.ISONAM(3,J))) THEN + WRITE (HSMG,200) ISONAM(1,I),ISONAM(2,I),ISONAM(3,I) + CALL XABORT(HSMG) + ENDIF + 30 CONTINUE + ENDIF + 40 CONTINUE +* + NPART=1 + NGF0=NGRO+1 + NGFR0=0 + IND1=1 + 50 NBIS=1 + LTEST=MASKI(IND1) + DO 60 I=IND1+1,NBISO + IF(ILLIB(I).EQ.0) THEN + NBIS=NBIS+1 + ELSE IF((IHLIB(1,I,1).EQ.IHLIB(1,IND1,1)).AND. + 1 (IHLIB(2,I,1).EQ.IHLIB(2,IND1,1)).AND. + 2 (ILLIB(I).EQ.ILLIB(IND1))) THEN + NBIS=NBIS+1 + LTEST=LTEST.OR.MASKI(I) + ELSE + GO TO 70 + ENDIF + 60 CONTINUE + 70 WRITE(NAMLBT,'(2A4)') IHLIB(1,IND1,1),IHLIB(2,IND1,1) + ILIB=ILLIB(IND1) + IF(ILIB.EQ.0) THEN + NAMFIL=' ' + ELSE + WRITE(NAMFIL,'(16A4)') (INAME(I,ILIB),I=1,16) + ENDIF + NDEL0=0 + CALL LCMINF(IPLIB,NAMLCM,NAMMY,EMPTY,ILONG,LCM) + IF(LTEST.AND.(NAMLBT.EQ.'DRAGON')) THEN +* TRANSFER INFORMATION FROM DRAGON LIBRARY TO LCM. + CALL LCMOP(IPDRL,NAMFIL(:12),2,2,0) + CALL LIBDRA(IPLIB,IPDRL,NAMFIL,NGRO,NBIS,NL,ISONAM(1,IND1), + 1 ISONRF(1,IND1),IPISO(IND1),TMPISO(IND1),SN(1,IND1),SB(1,IND1), + 2 MASKI(IND1),NED,HVECT,IMPX,NGF0,NGFR0,NDEL0,NBESP0) + CALL LCMCL(IPDRL,1) + NBESP=MAX(NBESP,NBESP0) + ELSE IF(LTEST.AND.(NAMLBT(1:4).EQ.'WIMS')) THEN +* TRANSFER INFORMATION FROM WIMS LIBRARY FILE TO LCM. + IF(NAMLBT.EQ.'WIMSD4') THEN +* WIMS-D4 FORMAT + CALL LIBWD4(IPLIB,IMPX,NAMFIL,NGRO,NBIS,NL,ISONAM(1,IND1), + 1 ISONRF(1,IND1),IPISO(IND1),ISHINA(1,IND1),TMPISO(IND1), + 2 SN(1,IND1),SB(1,IND1),MASKI(IND1),NGF0,NGFR0) + ELSE IF(NAMLBT.EQ.'WIMSE') THEN +* WIMS-E FORMAT + CALL LIBWE(IPLIB,IMPX,NAMFIL,NGRO,NBIS,NL,ISONAM(1,IND1), + 1 ISONRF(1,IND1),IPISO(IND1),ISHINA(1,IND1),TMPISO(IND1), + 2 SN(1,IND1),SB(1,IND1),MASKI(IND1),NGF0,NGFR0) + ELSE IF(NAMLBT.EQ.'WIMSAECL') THEN +* WIMS-AECL FORMAT + CALL LIBWIM(IPLIB,IMPX,NAMFIL,NGRO,NBIS,NL,ISONAM(1,IND1), + 1 ISONRF(1,IND1),IPISO(IND1),ISHINA(1,IND1),TMPISO(IND1), + 2 SN(1,IND1),SB(1,IND1),MASKI(IND1),NGF0,NGFR0) + ENDIF + ELSE IF(LTEST.AND.(NAMLBT.EQ.'MATXS')) THEN +* TRANSFER INFORMATION FROM MATXS (NJOY-89) TO LCM. + CALL LIBTR1(IPLIB,NAMFIL,NGRO,NBIS,NL,ISONAM(1,IND1), + 1 ISONRF(1,IND1),IPISO(IND1),IHLIB(1,IND1,2),IHLIB(1,IND1,3), + 2 NTFG(IND1),TMPISO(IND1),SN(1,IND1),SB(1,IND1),MASKI(IND1),NED, + 3 HVECT,ITIME,IMPX,NGF0,NGFR0) + ELSE IF(LTEST.AND.(NAMLBT.EQ.'MATXS2')) THEN +* TRANSFER INFORMATION FROM MATXS (NJOY-91) TO LCM. + CALL LIBTR2(IPLIB,NAMFIL,NGRO,NBIS,NL,ISONAM(1,IND1), + 1 ISONRF(1,IND1),IPISO(IND1),IHLIB(1,IND1,2),IHLIB(1,IND1,3), + 2 IHLIB(1,IND1,4),NTFG(IND1),TMPISO(IND1),SN(1,IND1),SB(1,IND1), + 3 MASKI(IND1),NED,HVECT,ITIME,IMPX,NGF0,NGFR0,NPART0) + NPART=MAX(NPART,NPART0) + ELSE IF(LTEST.AND.(NAMLBT.EQ.'APLIB1')) THEN +* TRANSFER INFORMATION FROM APOLIB-1 TO LCM. + MAXTRA=NL*NGRO**2 + CALL LIBAPL(IPLIB,NAMFIL,MAXTRA,NGRO,NBIS,NL,ISONAM(1,IND1), + 1 ISONRF(1,IND1),IPISO(IND1),ISHINA(1,IND1),MASKI(IND1), + 2 TMPISO(IND1),SN(1,IND1),SB(1,IND1),IMPX,NGF0,NGFR0) + ELSE IF(LTEST.AND.(NAMLBT.EQ.'APLIB2')) THEN +* TRANSFER INFORMATION FROM APOLIB-2 TO LCM. + CALL LIBA20(IPLIB,NAMFIL,NGRO,NBIS,NL,IPROC,ISONAM(1,IND1), + 1 ISONRF(1,IND1),IPISO(IND1),ISHINA(1,IND1),MASKI(IND1), + 2 TMPISO(IND1),SN(1,IND1),SB(1,IND1),IMPX,NGF0,NGFR0,NDEL0) + ELSE IF(LTEST.AND.(NAMLBT.EQ.'APXSM')) THEN +* TRANSFER INFORMATION FROM APOLIB-XSM TO LCM. + CALL LIBXS4(IPLIB,NAMFIL,NGRO,NBIS,NL,IPROC,ISONAM(1,IND1), + 1 ISONRF(1,IND1),IPISO(IND1),ISHINA(1,IND1),MASKI(IND1), + 2 TMPISO(IND1),SN(1,IND1),SB(1,IND1),IMPX,NGF0,NGFR0,NDEL0) + ELSE IF(LTEST.AND.(NAMLBT.EQ.'APLIB3')) THEN +* TRANSFER INFORMATION FROM APOLIB-3 TO LCM. +#if defined(HDF5_LIB) + CALL LIBA30 (IPLIB,NAMFIL,NGRO,NBIS,NL,ISONAM(1,IND1), + 1 ISONRF(1,IND1),IPISO(IND1),MASKI(IND1),TMPISO(IND1),LSHI(IND1), + 2 SN(1,IND1),SB(1,IND1),IMPX,NGF0,NGFR0,NDEL0) +#else + CALL XABORT('LIBLIC: THE HDF5 API IS NOT AVAILABLE.') +#endif /* defined(HDF5_LIB) */ + ELSE IF(LTEST.AND.(NAMLBT.EQ.'NDAS')) THEN + CALL LIBND1(IPLIB,NAMFIL,NGRO,NBIS,NL,ISONAM(1,IND1), + 1 ISONRF(1,IND1),IPISO(IND1),MASKI(IND1),TMPISO(IND1),SN(1,IND1), + 2 SB(1,IND1),IMPX,NGF0,NGFR0,NDEL0) + ELSE IF(LTEST.AND.(NAMLBT.EQ.'MICROLIB')) THEN +* TRANSFER INFORMATION FROM MICROLIB LIBRARY TO LCM. + CALL LCMINF(IPLIB,NAMLCM,NAMMY,EMPTY,ILONG,LCM) + IF(NAMFIL.EQ.NAMLCM) THEN + IPMIC=IPLIB + ELSE + INQUIRE(FILE=TRIM(NAMFIL),EXIST=LEXIST) + IF(.NOT.LEXIST) THEN + WRITE(HSMG,'(17HLIBLIC: XSM FILE ,A,14H DOESNT EXIST.)') + 1 TRIM(NAMFIL) + CALL XABORT(HSMG) + ENDIF + CALL LCMOP(IPMIC,NAMFIL(:12),2,2,0) + ENDIF + CALL LIBMIC(IPLIB,IPMIC,NAMFIL,NGRO,NBIS,ISONAM(1,IND1), + 1 ISONRF(1,IND1),IPISO(IND1),MASKI(IND1),IMPX,NGF0,NGFR0,NDEL0, + 2 NBESP0) + IF(NAMFIL.NE.NAMLCM) CALL LCMCL(IPMIC,1) + NBESP=MAX(NBESP,NBESP0) + ENDIF + IF(LTEST) THEN + NGF=MIN(NGF,NGF0) + IGRMAX=MAX(IGRMAX,NGFR0) + IF(NDEL.EQ.0) THEN + NDEL=NDEL0 + ELSE IF((NDEL0.NE.NDEL).AND.(NDEL0.NE.0)) THEN + ILIB=ILLIB(IND1) + IF(ILIB.GT.0) WRITE(6,210) (INAME(I,ILIB),I=1,4),NDEL0,NDEL + NDEL=MAX(NDEL,NDEL0) + ENDIF +* +* COMPUTE THE TRANSPORT XS AND ADD COMPLEMENTARY INFORMATION. + CALL LIBADD(IPLIB,NBIS,MASKI(IND1),IMPX,NGRO,NL,ITRANC, + 1 ISONAM(1,IND1),IPISO(IND1),NIR(IND1),GIR(IND1)) + ENDIF +* + IND1=IND1+NBIS + IF(IND1.LE.NBISO) GO TO 50 + RETURN +* + 200 FORMAT(8HLIBLIC: ,3A4,34H IS A DUPLICATE ISOTOPE/MATERIAL N, + 1 4HAME.) + 210 FORMAT(/51H LIBLIC: INVALID NB OF PRECURSOR GROUPS IN LIBRARY , + 1 4A4,8H (NDEL0=,I3,6H NDEL=,I3,2H).) + END |