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
|
subroutine bydot(n,t,y,ydot)
c
c
INCLUDE '../stack.h'
integer iadr,sadr
c
common/ierode/iero
c
double precision t(*), y(*),ydot(*)
integer vol,tops,nordre
data nordre/1/,mlhs/1/
c
iadr(l)=l+l-1
sadr(l)=(l/2)+1
c
c
c nordre=external number
c mlhs (mrhs) = number ot output (input) parameters of the
c external
c
iero=0
mrhs=2
c
ilp=iadr(lstk(top))
il=istk(ilp+nordre)
c
tops=istk(il)
ils=iadr(lstk(tops))
c
if(istk(ils).eq.10) then
c fortran external
call fydot(n,t,y,ydot)
return
endif
c
c transfer of input parameters
c+
call ftob(t,1,istk(il+1))
if(err.gt.0) goto 9999
call ftob(y,n,istk(il+2))
if(err.gt.0) goto 9999
c+
c adress of external
fin=lstk(tops)
c
c external in a list
if(istk(ils).eq.15) then
nelt=istk(ils+1)
l=sadr(ils+3+nelt)
ils=ils+2
c
c adress of external
fin=l
c
c additional parameters
c
nelt=nelt-1
if(nelt.ne.0) then
l=l+istk(ils+1)-istk(ils)
vol=istk(ils+nelt+1)-istk(ils+1)
if(top+1+nelt.ge.bot) then
call error(18)
if(err.gt.0) goto 9999
endif
err=lstk(top+1)+vol-lstk(bot)
if(err.gt.0) then
call error(17)
if(err.gt.0) goto 9999
endif
call dcopy(vol,stk(l),1,stk(lstk(top+1)),1)
do 11 i=1,nelt
top=top+1
lstk(top+1)=lstk(top)+istk(ils+i+1)-istk(ils+i)
11 continue
mrhs=mrhs+nelt
endif
endif
c
c execute scilab external
c
iero=0
pt=pt+1
if(pt.gt.psiz) then
call error(26)
if(err.gt.0) goto 9999
endif
ids(1,pt)=lhs
ids(2,pt)=rhs
rstk(pt)=1001
lhs=mlhs
rhs=mrhs
niv=niv+1
fun=0
c
icall=5
krec=12
include '../callinter.h'
c
200 lhs=ids(1,pt)
rhs=ids(2,pt)
pt=pt-1
c+
c transfer of output parameters of external to fortran
call btof(ydot,n)
if(err.gt.0) goto 9999
c+
niv=niv-1
return
c
9999 continue
iero=1
niv=niv-1
return
end
|
