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/GUCTOI.f | 94 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 94 insertions(+)
 create mode 100644 Utilib/src/GUCTOI.f

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

diff --git a/Utilib/src/GUCTOI.f b/Utilib/src/GUCTOI.f
new file mode 100644
index 0000000..eeaf738
--- /dev/null
+++ b/Utilib/src/GUCTOI.f
@@ -0,0 +1,94 @@
+*DECK GUCTOI
+      SUBROUTINE GUCTOI(CARVAR,INTVAR,NC4   ,NELEM )
+C
+C------------------------------  GUCTOI  ------------------------------
+C
+C  PROGRAMME STATISTICS:
+C     NAME     : GUCTOI
+C     ENTRY    : GUCTOI
+C     USE      : GANLIB UTILITY ROUTINE
+C                TRANSFERS CHARACTER VARIABLE IN INTEGER VARIABLE
+C     MODIFIED : 98/11/23 G. MARLEAU
+C                CREATION DATE
+C
+C  ROUTINE PARAMETERS:
+C   INPUT
+C     CARVAR  : CHARACTER VARIABLE                  C(NELEM)*(*)
+C     NC4     : NUMBER OF CHARACTER*4 BLOCKS IN
+C               CARVAR TO TRANSFER IN INTVAR        I
+C     NBELEM  : NUMBER OF ELEMENTS TO TRANSFER FROM
+C               CARVAR
+C   INPUT/OUTPUT
+C     INTVAR  : INTEGER VARIABLE                    I(NC4,NELEM)
+C
+C------------------------------  GUCTOI  ------------------------------
+C
+      IMPLICIT         NONE
+      INTEGER          NC4,NELEM,INTVAR(NC4,NELEM)
+      CHARACTER        CARVAR(NELEM)*(*)
+C----
+C  LOCAL PARAMETERS
+C----
+      INTEGER          LENCAR,NBC4,NRESTE,IELEM,IC4,IDC,IFC
+      CHARACTER        FMT*8,BLANK*4,TEXT4*4
+      SAVE             BLANK
+      DATA             BLANK /'    '/
+C----
+C  FIND LENGTH OF CHARACTER VARIABLE
+C----
+      LENCAR=LEN(CARVAR(1))
+      NBC4  =LENCAR/4
+      IF(NBC4 .GE. NC4) THEN
+C----
+C  CHARACTER VARIABLE LONGUER OR EQUAL TO SPACE ALLOWED IN
+C  INTEGER VARIABLE
+C  TRANSFER ONLY 4*NC4 ELEMENTS TO INTEGER VARIABLE
+C---
+        WRITE(FMT,1000) NC4
+        DO 100 IELEM=1,NELEM
+          READ(CARVAR(IELEM),FMT) (INTVAR(IC4,IELEM),IC4=1,NC4)
+ 100    CONTINUE
+      ELSE
+C----
+C  CHARACTER VARIABLE SHORTER THAN SPACE ALLOWED IN
+C  INTEGER VARIABLE
+C  TRANSFER ALL CHARACTER VARIABLE IN INTCAR AND
+C  FILL REMAINING SPACE WITH BLANKS
+C---
+        WRITE(FMT,1000) NBC4
+        NRESTE=MOD(LENCAR,4)
+        IF(NRESTE .EQ. 0 ) THEN
+C----
+C  LENGHT OF CHARACTER VARIABLE IS A FACTOR OF 4
+C----
+          DO 110 IELEM=1,NELEM
+            READ(CARVAR(IELEM),FMT) (INTVAR(IC4,IELEM),IC4=1,NBC4)
+            DO 111 IC4=NBC4+1,NC4
+              READ(BLANK,'(A4)') INTVAR(IC4,IELEM)
+ 111        CONTINUE
+ 110      CONTINUE
+        ELSE
+C----
+C  LENGHT OF CHARACTER VARIABLE IS NOT A FACTOR OF 4
+C----
+          IDC=4*NBC4+1
+          IFC=4*NBC4+NRESTE
+          DO 120 IELEM=1,NELEM
+            READ(CARVAR(IELEM),FMT) (INTVAR(IC4,IELEM),IC4=1,NBC4)
+            TEXT4=CARVAR(IELEM)(IDC:IFC)//BLANK(NRESTE+1:4)
+            READ(TEXT4,'(A4)') INTVAR(NBC4+1,IELEM)
+            DO 121 IC4=NBC4+2,NC4
+              READ(BLANK,'(A4)') INTVAR(IC4,IELEM)
+ 121        CONTINUE
+ 120      CONTINUE
+        ENDIF
+      ENDIF
+C----
+C  RETURN
+C----
+      RETURN
+C----
+C  FORMAT
+C----
+ 1000 FORMAT('(',I4,'A4)')
+      END
-- 
cgit v1.2.3