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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
subroutine matc(chai,lda,m,n,name,job)
c!but
c this routine reads or writes a matrix of strings in scilab's
c stack
c
c!calling sequence
c
c integer lda,m,n,job
c character*(*) chai,name
c
c chai :array of size n*lda containing the matrix
c lda : number of rows of chai in the calling routine
c
c name : character string = name of scilab variable
c job : job= 0 scilab -> fortran
c job= 1 fortran -> scilab
c
c CAUTION: if job=1 m and n are defined by matc.
c must call matc as follows
c call matc(ch,lda,m,n,name,0)
c and NOT as:
c call matc(ch,lda,10,10,name,0) if e.g. ch is a
c 10 by 10 matrix of character string.
c
integer lda,m,n,job
character*(*) chai(lda,*),name
character*8 h
include '../stack.h'
integer iadr,sadr
c
integer i,j,k,k1,m1,n1
integer il,it,l,l4,lec,nc,srhs,id(nsiz)
c
c
iadr(l)=l+l-1
sadr(l)=(l/2)+1
c
it=0
if(job.ge.10) it=1
lec=job-10*it
c
nc=min(8,len(name))
h=name(1:nc)
call cvname(id,h,0)
srhs=rhs
rhs=0
c
nc=len(chai(1,1))
if(lec.ge.1) goto 10
c
c lecture : scilab -> fortran
c -------
c
fin=-1
call stackg(id)
if(err.gt.0) return
if(fin.eq.0) call putid(ids(1,pt+1),id)
if(fin.eq.0) call error(4)
if(err.gt.0) return
il=iadr(lstk(fin))
if(istk(il).ne.10) call error(44)
if(err.gt.0) return
c
m=istk(il+1)
n=istk(il+2)
l=il+5
k=l+m*n
do 3 j=1,n
do 2 i=1,m
k1=istk(l)-istk(l-1)
if(i.le.lda) then
n1=min(k1,nc)
chai(i,j)=' '
call cvstr(n1,istk(k),chai(i,j),1)
endif
l=l+1
k=k+k1
2 continue
3 continue
m=min(m,lda)
c
goto 99
c
c ecriture : fortran -> scilab
c --------
c
10 continue
if(top+2.ge.bot) call error(18)
if(err.gt.0) return
top=top+1
il=iadr(lstk(top))
c
m1=max(0,min(lda,m))
n1=max(0,n)
l=il+5
err=l+m1*n1*(nc+1)-lstk(bot)
if(err.gt.0) call error(17)
if(err.gt.0) return
istk(il)=10
istk(il+1)=m1
istk(il+2)=n1
istk(il+4)=1
c
k1=l+n1*m1
do 13 j=1,n1
do 12 i=1,m1
do 11 k=1,nc
call cvstr(1,istk(k1),chai(i,j)(k:k),0)
k1=k1+1
11 continue
istk(l)=istk(l-1)+nc
l=l+1
12 continue
13 continue
c
lstk(top+1)=sadr(l+(nc+1)*m1*n1)
l4=lct(4)
lct(4)=-1
call stackp(id,0)
lct(4)=l4
if(err.gt.0) return
goto 99
c
c
99 rhs=srhs
c
end
|
