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/LIBXS6.f | 92 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 92 insertions(+)
 create mode 100644 Dragon/src/LIBXS6.f

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

diff --git a/Dragon/src/LIBXS6.f b/Dragon/src/LIBXS6.f
new file mode 100644
index 0000000..8c4ed53
--- /dev/null
+++ b/Dragon/src/LIBXS6.f
@@ -0,0 +1,92 @@
+*DECK LIBXS6
+      SUBROUTINE LIBXS6 (MAXDIL,NAMFIL,HSHI,NDIL,DILUT)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Find the dilutions corresponding to a resonant isotope within a
+* library in Apolib-XSM format.
+*
+*Copyright:
+* Copyright (C) 2014 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
+* MAXDIL  maximum number of dilutions.
+* NAMFIL  name of the APOLIB-XSM file.
+* HSHI    library name of the self-shielding data.
+*
+*Parameters: output
+* NDIL    number of finite dilutions.
+* DILUT   dilutions.
+*
+*-----------------------------------------------------------------------
+*
+      USE GANLIB
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER MAXDIL,NDIL
+      CHARACTER HSHI*12
+      CHARACTER NAMFIL*(*)
+      REAL DILUT(MAXDIL)
+*----
+*  LOCAL VARIABLES
+*----
+      TYPE(C_PTR) IPAP
+      CHARACTER TEXT20*20,TEXT12*12,HSMG*131
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: NOMS
+*----
+*  OPEN AND PROBE THE APOLIB-XSM FILE.
+*----
+      CALL LCMOP(IPAP,NAMFIL,2,2,0)
+      CALL LCMSIX(IPAP,'PHEAD',1)
+      CALL LCMLEN(IPAP,'NOMS',NV,ITYLCM)
+      NISOTS=NV/5
+      ALLOCATE(NOMS(5*NISOTS))
+      CALL LCMGET(IPAP,'NOMS',NOMS)
+      KISEG=0
+      DO ISO=1,NISOTS
+        WRITE(TEXT20,'(5A4)') (NOMS((ISO-1)*5+II),II=1,5)
+        IF(TEXT20(:12).EQ.HSHI) THEN
+          KISEG=ISO
+          EXIT
+        ENDIF
+      ENDDO
+      DEALLOCATE(NOMS)
+      IF(KISEG.EQ.0) THEN
+        WRITE(HSMG,'(45HLIBXS6: UNABLE TO FIND SELF-SHIELDED ISOTOPE ,
+     1  A12,1H.)') HSHI
+        CALL XABORT(HSMG)
+      ENDIF
+      CALL LCMSIX(IPAP,' ',2)
+*----
+*  RECOVER DILUTIONS
+*----
+      CALL LCMSIX(IPAP,'QFIXS',1)
+      WRITE(TEXT12,'(4HISOT,I8.8)') KISEG
+      CALL LCMSIX(IPAP,TEXT12,1)
+      CALL LCMSIX(IPAP,'SSDATA',1)
+      CALL LCMLEN(IPAP,'SEQHOM',NDIL,ITYLCM)
+      IF(NDIL.EQ.0) THEN
+        WRITE(HSMG,'(47HLIBXS6: NO DILUTIONS FOR SELF-SHIELDED ISOTOPE ,
+     1  A12,1H.)') HSHI
+        CALL XABORT(HSMG)
+      ELSE IF(NDIL.GT.MAXDIL) THEN
+        WRITE(HSMG,'(46HLIBXS6: MAXDIL OVERFLOW SELF-SHIELDED ISOTOPE ,
+     1  A12,1H.)') HSHI
+        CALL XABORT(HSMG)
+      ENDIF
+      NDIL=NDIL-1
+      CALL LCMGET(IPAP,'SEQHOM',DILUT)
+      CALL LCMSIX(IPAP,' ',2)
+      CALL LCMSIX(IPAP,' ',2)
+      CALL LCMSIX(IPAP,' ',2)
+      CALL LCMCL(IPAP,1)
+      RETURN
+      END
-- 
cgit v1.2.3