1 c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
2 c Copyright (C) Scilab Enterprises - 2013
4 c This file must be used under the terms of the CeCILL.
5 c This source file is licensed as described in the file COPYING, which
6 c you should have received as part of this distribution. The terms
7 c are also available at
8 c http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
10 subroutine bpsold (neq, t, y, ydot, savr, wk, cj, wght,
11 * wp, iwp, b, eplin, ier, rpar, ipar)
13 c ======================================================================
14 c Management of external dealing with preconditioned linear systems.
15 c ======================================================================
23 character tmpbuf * (bsiz)
24 double precision t,y(*),ydot(*),savr(*),wk(*),cj,wght(*),wp(*),
26 integer neq,iwp(*),ier,ipar(*)
27 integer vol,tops,nordre,hsize
28 data nordre/4/,mlhs/2/
35 write(tmpbuf(1:12),'(3i4)') top,r,sym
36 call basout(io,wte,' bpsold top:'//tmpbuf(1:4))
38 c nordre is the external's order number in the data structure,
39 c mlhs (mrhs) is the number of output (input) parameters
51 if(istk(ils).eq.10) then
52 c Fortran simulator case
53 call fpsold(neq, t, y, ydot, savr, wk, cj, wght,
54 * wp, iwp, b, eplin, ier, rpar, ipar)
57 c external is a Scilab function
59 c On return iero=1 is used to notify to the ode solver that
60 c scilab was not able to evaluate the external
63 c Putting Fortran arguments on Scilab stack
65 c Minimum entry arguments for the simulator. The value of these arguments
66 c comes from the Fortran context (call list)
70 call ftob(wp,lwp,istk(il+1))
71 if(err.gt.0.or.err1.gt.0) return
72 c call ftob(iwp,isize,istk(il+2))
73 ilx=iadr(lstk(istk(il+2)))
82 err=lstk(top)+sadr(hsize)+liwp-lstk(bot)
87 call icopy(hsize,istk(ilx),1,istk(il2),1)
93 if(err.gt.0.or.err1.gt.0) return
94 call ftob(b,neq,istk(il+3))
95 if(err.gt.0.or.err1.gt.0) return
98 if(istk(ils).eq.15) goto 10
100 c Retrieving the simulator's address
104 c If the simulator is defined by a list
109 c Retrieving the simulator's address
112 c Managing the additional simulator parameters coming from
113 c the context (elements of the list describing the simulator)
117 l=l+istk(ils+1)-istk(ils)
118 vol=istk(ils+nelt+1)-istk(ils+1)
119 if(top+1+nelt.ge.bot) then
123 err=lstk(top+1)+vol-lstk(bot)
128 call unsfdcopy(vol,stk(l),1,stk(lstk(top+1)),1)
131 lstk(top+1)=lstk(top)+istk(ils+i+1)-istk(ils+i)
137 c Executing the macro defining the simulator
154 include 'callinter.h'
161 c Transferring the output to Fortran
163 if(err.gt.0.or.err1.gt.0) return
165 if(err.gt.0.or.err1.gt.0) return
167 c Normal return iero set to 0