1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
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
|
