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

---
 Utilib/src/XDRSDB.f | 51 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 51 insertions(+)
 create mode 100644 Utilib/src/XDRSDB.f

(limited to 'Utilib/src/XDRSDB.f')

diff --git a/Utilib/src/XDRSDB.f b/Utilib/src/XDRSDB.f
new file mode 100644
index 0000000..345b3f1
--- /dev/null
+++ b/Utilib/src/XDRSDB.f
@@ -0,0 +1,51 @@
+*DECK XDRSDB
+      SUBROUTINE XDRSDB(NBELEM,RVECT,DBVECT,KDIR)
+C
+C---------------------------  XDRSDB  ---------------------------------
+C
+C   1-  PROGRAMME STATISTICS:
+C
+C          NAME       :  XDRSDB
+C          FUNCTION   :  DOUBLE PRECISION TO/FROM SIMPLE PRECISION
+C          DATE       :  20-02-1987
+C          AUTHOR     :  G.MARLEAU
+C
+C   2-  INPUT AND OUTPUT PARAMETERS:
+C
+C         NBELEM  : NUMBER OF WORDS TO TRANSLATE
+C         RVECT   : SIMPLE PRECISION VECTOR         -    RVECT(NBELEM)
+C         DBVECT  : DOUBLE PRECISION VECTOR         -  DBRVECT(NBELEM)
+C         KDIR    : DIRECTION OF TRANSLATION
+C                 : KDIR = 1   FROM DOUBLE TO SIMPLE PRECISION
+C                 : KDIR = 2   FROM SIMPLE TO DOUBLE PRECISION
+C
+C---------------------------   XDRSDB  --------------------------------
+C
+      CHARACTER         CERROR*4
+      INTEGER           NBELEM,KDIR
+      REAL              RVECT(*)
+      DOUBLE PRECISION  DBVECT(*)
+      IF(KDIR.EQ.1) THEN
+C------
+C  FROM DOUBLE TO SIMPLE PRECISION
+C------
+        DO 100 IELEM=1,NBELEM
+          RVECT(IELEM)=REAL(DBVECT(IELEM))
+ 100    CONTINUE
+      ELSE IF(KDIR.EQ.2) THEN
+C------
+C  FROM SIMPLE TO DOUBLE PRECISION
+C------
+        DO 200 IELEM=NBELEM,1,-1
+          DBVECT(IELEM)=DBLE(RVECT(IELEM))
+ 200    CONTINUE
+      ELSE
+C------
+C  INVALID VALUE FOR KDIR
+C------
+        WRITE(CERROR,'(I4)') KDIR
+        CALL XABORT('XDRSDB: ONLY KDIR=1 AND KDIR=2 ALLOWED; KDIR='
+     >  //CERROR//' FOUND')
+      ENDIF
+      RETURN
+      END
-- 
cgit v1.2.3