Bug 13268 fixed: There was a missing return in C++ code (ScilabObjet::getArgumentId)
[scilab.git] / scilab / modules / differential_equations / sci_gateway / fortran / bint2d.f
1 c     Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
2 c     Copyright (C) INRIA
3 c     ...
4 c     
5 c     This file must be used under the terms of the CeCILL.
6 c     This source file is licensed as described in the file COPYING, which
7 c     you should have received as part of this distribution.  The terms
8 c     are also available at
9 c     http://www.cecill.info/licences/Licence_CeCILL_V2.1-en.txt
10 c     
11       double precision function bint2d(x,y)
12 c     
13 c     ======================================================================
14 c     gestion des macros externals pour le primitive INTG
15 c     ======================================================================
16 c     
17       INCLUDE 'stack.h'
18       integer iadr,sadr
19 c     
20       double precision x,y,xx
21       integer       iero
22       common/iertwo/iero
23       logical allowptr
24 c     
25       integer vol,tops,nordre
26       data nordre/1/,mlhs/1/
27 c     
28       iadr(l)=l+l-1
29       sadr(l)=(l/2)+1
30 c
31       bint2d=0.0d0
32 c     
33 c     nordre est le numero d'ordre de cet external dans la structure
34 c     de donnee,
35 c     mlhs (mrhs) est le nombre de parametres de sortie (entree)
36 c     du simulateur
37 c     
38       iero=0
39       mrhs=2
40 c     
41       ilp=iadr(lstk(top))
42       il=istk(ilp+nordre)
43
44 c     external is a Scilab function
45
46 c     on return iero=1 is used to notify to the ode solver that
47 c     scilab was not able to evaluate the external
48       iero=1
49 c     Putting Fortran arguments on Scilab stack
50
51 c     +
52       call ftob(x,1,istk(il+1))
53       if(err.gt.0.or.err1.gt.0) return
54       call ftob(y,1,istk(il+2))
55       if(err.gt.0.or.err1.gt.0) return
56 c     +
57 c     
58       tops=istk(il)
59       ils=iadr(lstk(tops))
60       if(istk(ils).eq.15) goto 10
61 c     
62 c     recuperation de l'adresse du simulateur
63       fin=lstk(tops)
64 c     
65       goto 40
66 c     cas ou le simulateur est decrit par une liste
67  10   nelt=istk(ils+1)
68       l=sadr(ils+3+nelt)
69       ils=ils+2
70 c     
71 c     recuperation de l'adresse du simulateur
72       fin=l
73 c     
74 c     gestion des parametres supplementaires du simulateur
75 c     proviennent du contexte  (elements de la liste
76 c     decrivant le simulateur
77 c     
78       nelt=nelt-1
79       if(nelt.eq.0) goto 40
80       l=l+istk(ils+1)-istk(ils)
81       vol=istk(ils+nelt+1)-istk(ils+1)
82       if(top+1+nelt.ge.bot) then
83          call error(18)
84          return
85       endif
86       err=lstk(top+1)+vol-lstk(bot)
87       if(err.gt.0) then
88          call error(17)
89          return
90       endif
91       call unsfdcopy(vol,stk(l),1,stk(lstk(top+1)),1)
92       do 11 i=1,nelt
93          top=top+1
94          lstk(top+1)=lstk(top)+istk(ils+i+1)-istk(ils+i)
95  11   continue
96       mrhs=mrhs+nelt
97  40   continue
98 c     
99 c     execution de la macro definissant le simulateur
100 c     
101       pt=pt+1
102       if(pt.gt.psiz) then
103          call error(26)
104          return
105       endif
106       ids(1,pt)=lhs
107       ids(2,pt)=rhs
108       rstk(pt)=1001
109       lhs=mlhs
110       rhs=mrhs
111       niv=niv+1
112       fun=0
113 c     
114 c     
115       icall=5
116
117       include 'callinter.h.f'
118 c     
119  200  lhs=ids(1,pt)
120       rhs=ids(2,pt)
121       pt=pt-1
122       niv=niv-1
123 c     +
124 c     transfert des variables  de sortie vers fortran
125       call btof(xx,1)
126       bint2d=xx
127       if(err.gt.0.or.err1.gt.0) return
128 c     normal return iero set to 0
129       iero=0
130       return
131
132 c     
133  9999 continue
134       niv=niv-1
135       if(err1.gt.0) then
136          lhs=ids(1,pt)
137          rhs=ids(2,pt)
138          pt=pt-1
139          fun=0
140       endif
141       bint2d=0.0d0
142       return
143       end