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
|
*DECK GUITOC
SUBROUTINE GUITOC(INTVAR,CARVAR,NC4 ,NELEM )
C
C------------------------------ GUITOC ------------------------------
C
C PROGRAMME STATISTICS:
C NAME : GUITOC
C ENTRY : GUITOC
C USE : GANLIB UTILITY PROGRAM
C TRANSFERS INTEGER VARIABLE TO CHARACTER VARIABLE
C MODIFIED : 98/11/23 G. MARLEAU
C CREATION DATE
C
C ROUTINE PARAMETERS:
C INPUT
C INTVAR : INTEGER VARIABLE I(NC4,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 CARVAR : CHARACTER VARIABLE C(NELEM)*(*)
C
C------------------------------ GUITOC ------------------------------
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*1
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 LARGER OF EQUAL TO SPACE IN
C INTEGER VARIABLE
C TRANSFER FROM INTEGER VARIABLE ONLY 4*NC4 ELEMENTS
C---
WRITE(FMT,1000) NC4
DO 100 IELEM=1,NELEM
WRITE(CARVAR(IELEM),FMT) (INTVAR(IC4,IELEM),IC4=1,NC4)
DO 101 IC4=4*NC4+1,LENCAR
WRITE(CARVAR(IELEM)(IC4:IC4),'(A1)') BLANK
101 CONTINUE
100 CONTINUE
ELSE
C----
C CHARACTER VARIABLE SHORTER THAN SPACE IN
C INTEGER VARIABLE
C TRANSFER FROM INTEGER VARIABLE ONLY 4*NBC4 ELEMENTS
C AND PART OF NBC4+1 ELEMENT AS DESCRIBED BY NRESTE
C---
WRITE(FMT,1000) NBC4
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)
110 CONTINUE
NRESTE=MOD(LENCAR,4)
IF(NRESTE .NE. 0 ) THEN
C----
C LENGHT OF CHARACTER VARIABLE IS NOT A FACTOR OF 4
C----
WRITE(FMT,1001) NRESTE
IDC=4*NBC4+1
IFC=4*NBC4+NRESTE
DO 120 IELEM=1,NELEM
WRITE(CARVAR(IELEM)(IDC:IFC),FMT) INTVAR(NBC4+1,IELEM)
120 CONTINUE
ENDIF
ENDIF
C----
C RETURN
C----
RETURN
C----
C FORMAT
C----
1000 FORMAT('(',I4,'A4)')
1001 FORMAT('(A',I1,') ')
END
|
