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/AUTPRD.f | 55 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 55 insertions(+) create mode 100644 Dragon/src/AUTPRD.f (limited to 'Dragon/src/AUTPRD.f') diff --git a/Dragon/src/AUTPRD.f b/Dragon/src/AUTPRD.f new file mode 100644 index 0000000..5061a7a --- /dev/null +++ b/Dragon/src/AUTPRD.f @@ -0,0 +1,55 @@ +*DECK AUTPRD + SUBROUTINE AUTPRD(NGRP,LBIN,NFS,SIGT) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Cross section or source spreading. +* +*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 +* NGRP number of macro energy groups. +* LBIN number of fine energy groups. +* NFS number of fine energy groups in each coarse energy group. +* SIGT cross section or source before spreading. +* +*Parameters: output +* SIGT cross section or source after spreading. +* +*----------------------------------------------------------------------- +* +*---- +* SUBROUTINE ARGUMENTS +*---- + INTEGER NGRP,LBIN,NFS(NGRP) + REAL SIGT(LBIN) +*---- +* ALLOCATABLE ARRAYS +*---- + REAL, ALLOCATABLE, DIMENSION(:) :: GAR +* + ALLOCATE(GAR(NGRP)) + GAR(:NGRP)=SIGT(:NGRP) + SIGT(:LBIN)=0.0 + IPO=LBIN + DO J=NGRP,1,-1 + ND=ABS(NFS(J)) + SS=GAR(J) + DO L=1,ND + K=IPO-L+1 + SIGT(K)=SS + ENDDO + IPO=IPO-ND + ENDDO + DEALLOCATE(GAR) + IF(IPO.NE.0) CALL XABORT('AUTPRD: SPREAD FAILURE.') + RETURN + END -- cgit v1.2.3