summaryrefslogtreecommitdiff
path: root/Utilib/src/GUCTOI.f
diff options
context:
space:
mode:
Diffstat (limited to 'Utilib/src/GUCTOI.f')
-rw-r--r--Utilib/src/GUCTOI.f94
1 files changed, 94 insertions, 0 deletions
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