From 7dfcc480ba1e19bd3232349fc733caef94034292 Mon Sep 17 00:00:00 2001 From: stainer_t Date: Mon, 8 Sep 2025 13:48:49 +0200 Subject: Initial commit from Polytechnique Montreal --- Dragon/src/USSONE.f | 190 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 190 insertions(+) create mode 100644 Dragon/src/USSONE.f (limited to 'Dragon/src/USSONE.f') diff --git a/Dragon/src/USSONE.f b/Dragon/src/USSONE.f new file mode 100644 index 0000000..89dbd9e --- /dev/null +++ b/Dragon/src/USSONE.f @@ -0,0 +1,190 @@ +*DECK USSONE + SUBROUTINE USSONE(IPLI0,IPTRK,IPLIB,IFTRAK,CDOOR,IMPX,IGRMIN, + 1 IGRMAX,NIRES,NBNRS,IREX,NGRP,NBMIX,NREG,NUN,NBISO,NL,NED,NDEL, + 2 ISONAM,IHSUF,HCAL,DEN,MIX,IAPT,MAT,VOL,KEYFLX,LEAKSW,ITRANC, + 3 IPHASE,TITR,KSPH,ICORR,ISUBG,MAXST) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Perform a resonance self-shielding calculation named HCAL and build +* a corresponding internal library. +* +*Copyright: +* Copyright (C) 2003 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 +* IPLI0 pointer to the internal microscopic cross section library +* builded by the self-shielding module (L_LIBRARY signature). +* IPTRK pointer to the tracking. (L_TRACK signature). +* IPLIB pointer to the internal microscopic cross section library +* with subgroups (L_LIBRARY signature). +* IFTRAK unit number of the sequential binary tracking file. +* CDOOR name of the geometry/solution operator. +* IMPX print flag (equal to zero for no print). +* IGRMIN first group where the self-shielding is applied. +* IGRMAX most thermal group where the self-shielding is applied. +* NIRES number of correlated resonant isotopes in fuel regions. +* NBNRS number of correlated fuel regions. Note that NBNRS=max(IREX). +* IREX fuel region index assigned to each mixture. Equal to zero +* in non-resonant mixtures or in mixtures not used. +* NGRP number of energy groups. +* NBMIX number of mixtures in the internal library. +* NREG number of regions. +* NUN number of unknowns per energy group. +* NBISO number of isotopes specifications in the internal library. +* NL number of Legendre orders required in the calculation +* (NL=1 or higher). +* NED number of extra vector edits. +* NDEL number of delayed neutron precursor groups. +* ISONAM alias name of isotopes. +* IHSUF suffix name of isotopes. +* HCAL name of the self-shielding calculation. +* DEN density of each isotope. +* MIX mix number of each isotope (can be zero). +* IAPT resonant isotope index associated with isotope I. Mixed +* moderator if IAPT(I)=NIRES+1. Out-of-fuel isotope if +* IAPT(I)=0. +* MAT index-number of the mixture type assigned to each volume. +* VOL volumes. +* KEYFLX pointers of fluxes in unknown vector. +* LEAKSW leakage flag (LEAKSW=.TRUE. if neutron leakage through +* external boundary is present). +* ITRANC type of transport correction. +* IPHASE type of flux solution (=1 use a native flux solution door; +* =2 use collision probabilities). +* TITR title. +* KSPH SPH equivalence flag (=0 no SPH correction; =1 SPH correction +* in the fuel). +* ICORR mutual resonance shielding flag (=1 to suppress the model +* in cases it is required in LIB operator). +* ISUBG type of self-shielding model (=1 use physical probability +* tables; =3 use original Ribon method; =4 use Ribon extended +* method; =6 use resonance spectrum expansion method). +* MAXST maximum number of fixed point iterations for the ST scattering +* source. +* +*----------------------------------------------------------------------- +* + USE GANLIB +*---- +* SUBROUTINE ARGUMENTS +*---- + TYPE(C_PTR) IPLI0,IPTRK,IPLIB + INTEGER IFTRAK,IMPX,IGRMIN,IGRMAX,NIRES,NBNRS,IREX(NBMIX), + 1 NGRP,NBMIX,NREG,NUN,NBISO,NL,NED,NDEL,ISONAM(3,NBISO), + 2 IHSUF(NBISO),MIX(NBISO),IAPT(NBISO),MAT(NREG),KEYFLX(NREG), + 3 ITRANC,IPHASE,KSPH,ICORR,ISUBG,MAXST + REAL DEN(NBISO),VOL(NREG) + LOGICAL LEAKSW + CHARACTER CDOOR*12,HCAL*12,TITR*72 +*---- +* ALLOCATABLE ARRAYS +*---- + INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ISOBIS + REAL, ALLOCATABLE, DIMENSION(:) :: SIGAR,UNGAR,DELTAU + REAL, ALLOCATABLE, DIMENSION(:,:) :: GOLD + REAL, ALLOCATABLE, DIMENSION(:,:,:) :: SPH,PHGAR,STGAR,SFGAR,SWGAR + REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: SSGAR,SAGAR,SDGAR + REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:) :: S0GAR + LOGICAL, ALLOCATABLE, DIMENSION(:) :: MASKI + LOGICAL, ALLOCATABLE, DIMENSION(:,:) :: MASKG +*---- +* SCRATCH STORAGE ALLOCATION +*---- + ALLOCATE(ISOBIS(3,NBISO)) + ALLOCATE(SPH(NBNRS,NIRES,NGRP),PHGAR(NBNRS,NIRES,NGRP), + 1 STGAR(NBNRS,NIRES,NGRP),SFGAR(NBNRS,NIRES,NGRP), + 2 SSGAR(NBNRS,NIRES,NL,NGRP),S0GAR(NBNRS,NIRES,NL,NGRP,NGRP), + 3 SAGAR(NBNRS,NIRES,NED,NGRP),SDGAR(NBNRS,NIRES,NDEL,NGRP), + 4 SWGAR(NBNRS,NIRES,NGRP),DELTAU(NGRP)) + ALLOCATE(MASKI(NBISO),MASKG(NGRP,NIRES)) +*---- +* FIND THE NEW ISOTOPE NAMES IN IPLI0. +*---- + CALL LCMLEN(IPLI0,'ISOTOPESUSED',ILONG,ITYLCM) + IF(ILONG.NE.0) THEN + CALL LCMGET(IPLI0,'ISOTOPESUSED',ISOBIS) + ELSE + CALL LCMGET(IPLIB,'ISOTOPESUSED',ISOBIS) + ENDIF + DO 10 ISO=1,NBISO + IF((IAPT(ISO).GT.0).AND.(IAPT(ISO).LE.NIRES)) THEN + ISOBIS(3,ISO)=IHSUF(ISO) + ENDIF + 10 CONTINUE + CALL LCMPUT(IPLI0,'ISOTOPESUSED',3*NBISO,3,ISOBIS) +* + ALLOCATE(SIGAR(4*NBMIX*(NIRES+1)*NGRP),UNGAR(NUN*NIRES*NGRP), + 1 GOLD(NIRES,NGRP)) +*---- +* COMPUTE THE NEUTRON FLUX. +*---- + IF(ISUBG.EQ.6) THEN + ! resonance spectrum expansion method + CALL USSRSE(IPTRK,IPLIB,IPLI0,IFTRAK,NREG,NUN,NBMIX,NBISO, + 1 NIRES,NL,NED,NDEL,ISONAM,ISOBIS,HCAL,MAT,VOL,KEYFLX,CDOOR, + 2 LEAKSW,IMPX,DEN,MIX,IAPT,IPHASE,NGRP,IGRMIN,IGRMAX,NBNRS, + 3 IREX,TITR,ICORR,MAXST,GOLD,UNGAR,PHGAR,STGAR,SFGAR,SSGAR, + 4 S0GAR,SAGAR,SDGAR,MASKG,SIGAR) + ELSE + ! subgroup method + CALL USSFLU(IPTRK,IPLIB,IPLI0,IFTRAK,NREG,NUN,NBMIX,NBISO, + 1 NIRES,NL,NED,NDEL,ISONAM,ISOBIS,HCAL,MAT,VOL,KEYFLX,CDOOR, + 2 LEAKSW,IMPX,DEN,MIX,IAPT,IPHASE,NGRP,IGRMIN,IGRMAX,NBNRS, + 3 IREX,TITR,ICORR,ISUBG,MAXST,GOLD,UNGAR,PHGAR,STGAR,SFGAR, + 4 SSGAR,S0GAR,SAGAR,SDGAR,SWGAR,MASKG,SIGAR) + ENDIF +*---- +* COMPUTE THE SPH FACTORS. +*---- + SPH(:NBNRS,:NIRES,:NGRP)=1.0 + IF(KSPH.EQ.1) THEN + CALL LCMGET(IPLI0,'DELTAU',DELTAU) + CALL USSSPH(IPLI0,IPTRK,IFTRAK,NREG,NUN,NBMIX,NBISO,NIRES,NL, + 1 NED,NDEL,ISONAM,HCAL,MAT,VOL,KEYFLX,CDOOR,LEAKSW,IMPX,DEN,MIX, + 2 IAPT,ITRANC,IPHASE,NGRP,MASKG,NBNRS,IREX,TITR,ISUBG,SIGAR, + 3 GOLD,UNGAR,PHGAR,STGAR,SFGAR,SSGAR,S0GAR,SAGAR,SDGAR,SWGAR, + 4 DELTAU,SPH) + ENDIF +* + DEALLOCATE(GOLD,UNGAR,SIGAR) +*---- +* CREATE THE SELF-SHIELDED INTERNAL LIBRARY USING A SIMPLE +* TRANSCRIPTION OF THE SELF-SHIELDED CROSS SECTIONS. +*---- + CALL KDRCPU(TK1) +* SIMPLE TRANSCRIPTION OF THE SELF-SHIELDED CROSS SECTIONS. + DO 100 ISO=1,NBISO + MASKI(ISO)=(IAPT(ISO).GT.0).AND.(IAPT(ISO).LE.NIRES) + 100 CONTINUE + DO 120 ISO=1,NBISO + IF(MASKI(ISO)) THEN + DO 110 JSO=ISO+1,NBISO + IF((ISOBIS(1,ISO).EQ.ISOBIS(1,JSO)).AND. + 1 (ISOBIS(2,ISO).EQ.ISOBIS(2,JSO)).AND. + 2 (ISOBIS(3,ISO).EQ.ISOBIS(3,JSO))) MASKI(JSO)=.FALSE. + 110 CONTINUE + ENDIF + 120 CONTINUE + CALL USSIN1(IPLI0,IPLIB,NGRP,NBMIX,NBISO,NIRES,NBNRS,NL,NED,NDEL, + 1 IREX,IMPX,ISONAM,ISOBIS,MIX,IAPT,MASKI,SPH,PHGAR,STGAR,SFGAR, + 2 SSGAR,S0GAR,SAGAR,SDGAR) + CALL KDRCPU(TK2) + IF(IMPX.GT.1) WRITE(6,'(/36H USSONE: CPU TIME SPENT TO BUILD THE, + 1 33H SELF-SHIELDED INTERNAL LIBRARY =,F8.1,8H SECOND.)') TK2-TK1 +*---- +* SCRATCH STORAGE DEALLOCATION +*---- + DEALLOCATE(MASKG,MASKI) + DEALLOCATE(DELTAU,SWGAR,SDGAR,SAGAR,S0GAR,SSGAR,SFGAR,STGAR, + 1 PHGAR,SPH) + DEALLOCATE(ISOBIS) + RETURN + END -- cgit v1.2.3