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
|
subroutine bgety(y, incr, istart)
c ======================================================================
c macros or list externals for corr
c ======================================================================
c Copyright INRIA
INCLUDE '../stack.h'
integer iadr,sadr
double precision y(*)
character*(nlgh+1) namex,namey
common / corrname / namex,namey
common / corradr / kgxtop,kgytop,ksec,kisc
common / corrtyp / itxcorr,itycorr
common/ iercorr /iero
logical allowptr
data mlhs/1/
c
iadr(l)=l+l-1
sadr(l)=(l/2)+1
c number of arguments of the external
mrhs=2
c Putting Fortran arguments on Scilab stack
c+
call ftob(dble(incr),1,ksec)
call ftob(dble(istart),1,kisc)
c+
if(itycorr.ne.15) then
fin=lstk(kgytop)
else
ils=iadr(lstk(kgytop))
nelt=istk(ils+1)
l=sadr(ils+3+nelt)
ils=ils+2
c external adress
fin=l
c Extra arguments in calling list that we store on the Scilab stack
call extlarg(l,ils,nelt,mrhs)
if (err.gt.0) goto 9999
endif
c Macro execution
pt=pt+1
if(pt.gt.psiz) then
call error(26)
goto 9999
endif
ids(1,pt)=lhs
ids(2,pt)=rhs
rstk(pt)=1001
lhs=mlhs
rhs=mrhs
niv=niv+1
fun=0
c
c
icall=5
include '../callinter.h'
c
200 lhs=ids(1,pt)
rhs=ids(2,pt)
pt=pt-1
c+
c transfert des variables de sortie vers fortran
call btof(y,incr)
if(err.gt.0) goto 9999
c+
niv=niv-1
return
c
9999 continue
iero=1
niv=niv-1
return
end
|
