From 7dfcc480ba1e19bd3232349fc733caef94034292 Mon Sep 17 00:00:00 2001
From: stainer_t <thomas.stainer@oecd-nea.org>
Date: Mon, 8 Sep 2025 13:48:49 +0200
Subject: Initial commit from Polytechnique Montreal

---
 Dragon/src/LIBWSC.f | 73 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 73 insertions(+)
 create mode 100644 Dragon/src/LIBWSC.f

(limited to 'Dragon/src/LIBWSC.f')

diff --git a/Dragon/src/LIBWSC.f b/Dragon/src/LIBWSC.f
new file mode 100644
index 0000000..79e3858
--- /dev/null
+++ b/Dragon/src/LIBWSC.f
@@ -0,0 +1,73 @@
+*DECK LIBWSC
+      SUBROUTINE LIBWSC(NGROUP,NGD,NGF,NSCT,CSCAT,XSCAT,SIGS)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Expand WIMS format scattering cross sections.
+*
+*Copyright:
+* Copyright (C) 1997 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): 
+* G. Marleau
+*
+*Parameters: input
+* NGROUP  number of groups.                         
+* NGD     starting group number.                    
+* NGF     finishing group number.                   
+* NSCT    number of elements in CSCAT.              
+* CSCAT   WIMS condense scattering at input.        
+*
+*Parameters: output
+* XSCAT   DRAGON format expanded scattering.
+*         SCAT(JG,IG) is from IG to JG.              
+* SIGS    total scattering out of group.            
+*
+*-----------------------------------------------------------------------
+*
+      IMPLICIT NONE
+*----
+* INTERFACE VARIABLES
+*----
+      INTEGER  NGROUP,NGD,NGF,NSCT
+      REAL     CSCAT(NSCT),XSCAT(NGROUP,NGROUP),SIGS(NGROUP)
+*----
+* LOCAL VARIABLES
+*----
+      INTEGER          LG,IG1,IG2,N2,IGG
+      DOUBLE PRECISION SUMSCT
+*
+*----
+*
+      LG=0
+      DO 100 IG1=NGD,NGF
+        XSCAT(:NGROUP,IG1)=0.0
+        LG=LG+1
+        IG2=IG1-INT(CSCAT(LG)+0.1)
+        LG=LG+1
+        N2=INT(CSCAT(LG)+0.1)
+        SUMSCT=0.0D0
+        DO 110 IGG=1,N2
+          LG=LG+1
+          IG2=IG2+1
+          IF(IG2.LT.1) THEN
+            CALL XABORT('LIBWSC: IG2 < 1')
+          ELSE IF(IG2.GT.NGROUP) THEN
+            CALL XABORT('LIBWSC: IG2 > NGROUP')
+          ENDIF
+          XSCAT(IG2,IG1)=CSCAT(LG)
+          SUMSCT=SUMSCT+DBLE(CSCAT(LG))
+ 110    CONTINUE
+        SIGS(IG1)=REAL(SUMSCT)
+ 100  CONTINUE
+      IF(LG.NE.NSCT) CALL XABORT('LIBWSC: INVALID COUNT')
+*----
+*  RETURN LIBWSC
+*----
+      RETURN
+      END
-- 
cgit v1.2.3