bug_13121 : execution on Windows fixed. 10/13310/3
Cedric Delamarre [Tue, 3 Dec 2013 10:50:55 +0000 (11:50 +0100)]
Change-Id: I805c3b7d7dd3fcb5414159f9f33ad9bf06281455

scilab/modules/core/includes/stack.h.in
scilab/modules/core/includes/stack.h.vc
scilab/modules/differential_equations/sci_gateway/fortran/bydot.f
scilab/modules/differential_equations/src/fortran/lsrgk.f
scilab/modules/differential_equations/src/fortran/odeint.f
scilab/modules/differential_equations/src/fortran/rkqc.f

index 398262f..69cea77 100644 (file)
@@ -1,18 +1,18 @@
 c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
 c Copyright (C) INRIA
-c 
+c
 c This file must be used under the terms of the CeCILL.
 c This source file is licensed as described in the file COPYING, which
 c you should have received as part of this distribution.  The terms
-c are also available at    
+c are also available at
 c http://www.cecill.info/licences/Licence_CeCILL_V2.1-en.txt
 
 c*------------------------------------------------------------------
-c vsiz  size of internal scilab stack 
+c vsiz  size of internal scilab stack
 c
-c bsiz  size of internal chain buf 
+c bsiz  size of internal chain buf
 c
-c isizt  maximum number of scilab variables global and local 
+c isizt  maximum number of scilab variables global and local
 c isiz maximum number of scilab local variables
 c psiz  defines recursion size
 c lsiz  dim. of vector containing the command line
@@ -20,7 +20,7 @@ c nlgh  length of variable names
 c csiz  used for character coding
 c intersiz used in interfaces
 c*-------------------------------------------------------------------
-Cc (DLL Digital Visual Fortran)     
+Cc (DLL Digital Visual Fortran)
 cDEC$ IF DEFINED (FORDLL)
 cDEC$ ATTRIBUTES DLLIMPORT:: /stack/, /vstk/, /recu/, /iop/
 cDEC$ ATTRIBUTES DLLIMPORT:: /errgst/, /com/, /adre/
@@ -79,5 +79,7 @@ c
      $  ladc(intersiz),lhsvar(intersiz)
       common/intersci/nbvars,iwhere,nbrows,nbcols,
      $ itflag,ntypes,lad,ladc,lhsvar
+      integer ierror
+      common/ierode/ierror
 c*------------------------------------------------------------------
 
index 73a73c0..047ccef 100644 (file)
@@ -25,6 +25,7 @@ cDEC$ IF DEFINED (FORDLL)
 cDEC$ ATTRIBUTES DLLIMPORT:: /stack/, /vstk/, /recu/, /iop/
 cDEC$ ATTRIBUTES DLLIMPORT:: /errgst/, /com/, /adre/
 cDEC$ ATTRIBUTES DLLIMPORT:: /intersci/ ,/cha1/, /dbg/
+cDEC$ ATTRIBUTES DLLIMPORT:: /ierode/
 cDEC$ ENDIF
 C     ---------------------------------------------------------------
       integer   csiz,bsiz,isizt,psiz,nsiz,lsiz
@@ -79,9 +80,11 @@ c
       integer lbot,ie,is,ipal,nbarg,ladr(intersiz)
       common/adre/lbot,ie,is,ipal,nbarg,ladr
       integer nbvars,iwhere(intersiz),
-     $ nbrows(intersiz),nbcols(intersiz),
-     $  itflag(intersiz),ntypes(intersiz),lad(intersiz),
-     $  ladc(intersiz),lhsvar(intersiz)
+     $ nbrows(intersiz),nbcols(intersiz),
+     $ itflag(intersiz),ntypes(intersiz),lad(intersiz),
+     $ ladc(intersiz),lhsvar(intersiz)
       common/intersci/nbvars,iwhere,nbrows,nbcols,
      $ itflag,ntypes,lad,ladc,lhsvar
+      integer ierror
+      common/ierode/ierror
 c*------------------------------------------------------------------
index f6a5fa7..4eff2da 100644 (file)
@@ -13,8 +13,6 @@ c
       INCLUDE 'stack.h'
       integer iadr,sadr
 c     
-      common/ierode/iero
-c     
       logical allowptr
       double precision t(*), y(*),ydot(*)
       integer vol,tops,nordre
@@ -28,7 +26,7 @@ c     nordre=external number
 c     mlhs (mrhs) = number ot output (input) parameters of the 
 c     external 
 c     
-      iero=0
+      ierror=0
       mrhs=2
 c     
       ilp=iadr(lstk(top))
@@ -45,9 +43,9 @@ c     fortran external
 
 c     external is a Scilab function
 
-c     on return iero=1 is used to notify to the ode solver that
+c     on return ierror=1 is used to notify to the ode solver that
 c     scilab was not able to evaluate the external
-      iero=1
+      ierror=1
 
 c     
 c     transfer of input parameters
@@ -127,8 +125,8 @@ c     transfer of output parameters of external to fortran
       endif
       call btof(ydot,n)
       if(err.gt.0.or.err1.gt.0) return
-c     normal return iero set to 0
-      iero=0
+c     normal return ierror set to 0
+      ierror=0
 c+    
       return
 c     
index 67c0563..478d8da 100644 (file)
@@ -8,19 +8,17 @@ c     array + blas use. Serge Steer INRIA- feb 2012
 c     ====================================
       subroutine lsrgk (f, neq, y, t, tout, itol, rtol, atol, itask,
      1            istate, iopt, rwork, lrw, iwork, liw, jac, mf)
-     
+      include 'stack.h'
       external f, jac,rkqc
       integer neq, itol, itask, istate, iopt, lrw, iwork, liw, mf
       double precision y, t, tout, rtol, atol, rwork
       integer nok,nbad
       dimension neq(*), y(*), rtol(*), atol(*), rwork(lrw), iwork(liw)
-      integer iero
-      common/ierode/iero
-      iero=0
+      ierror=0
       call odeint(y, neq, t,tout,atol(1),1.0d-4,0.0d0,nok,nbad,f,rkqc,
      $     rwork)
       t=tout
-      if (iero.gt.0) istate=-1
+      if (ierror.gt.0) istate=-1
       return
       end
 c     ====================================
index 3bf2d07..98f96bc 100644 (file)
@@ -20,6 +20,7 @@ c     array + blas use. Serge Steer INRIA- feb 2012
 c     ====================================
       subroutine odeint(ystart,nvar,x1,x2,eps,h1,hmin,nok,nbad,derivs,
      $     rkqc,rwork)
+      include 'stack.h'
       external derivs,rkqc
       integer maxstp,kount,nvar,i,nok,nbad,nstp
       double precision two,zero,tiny,x,h
@@ -29,15 +30,13 @@ c     ====================================
       double precision rwork(*)
       character*80 messag
       integer ly,lyscal,ldydx,lwork
-      integer iero
-      common/ierode/iero
 c     
       ly=1
       lyscal=ly+nvar
       ldydx=lyscal+nvar
       lwork=ldydx+nvar
 
-      iero=0
+      ierror=0
       if ( abs(x2-x1).le.tiny) return
       x=x1
       h=sign(h1,x2-x1)
@@ -48,7 +47,7 @@ c
 
       do 16 nstp=1,maxstp
          call derivs(nvar,x,rwork(ly),rwork(ldydx))
-         if (iero.gt.0) return 
+         if (ierror.gt.0) return
          do 12 i=0,nvar-1
             rwork(lyscal+i)=abs(rwork(ly+i))+abs(h*rwork(ldydx+i))+tiny
  12      continue
@@ -56,7 +55,7 @@ c
          if((x+h-x2)*(x+h-x1).gt.zero) h=x2-x
          call rkqc(rwork(ly),rwork(ldydx),nvar,x,h,eps,rwork(lyscal),
      $        hdid,hnext,derivs,rwork(lwork))
-         if(iero.gt.0) return
+         if(ierror.gt.0) return
          if(hdid.eq.h)then
             nok=nok+1
          else
@@ -72,7 +71,7 @@ c
          endif
          h=hnext
  16   continue
-      iero=-1
+      ierror=-1
 c     print *, 'Trop d''iterations a faire pour la precision demandee.'
       return
  17   format('stepsize ',e10.3,' smaller than minimum ',e10.3)
index e44bce7..d997375 100644 (file)
@@ -26,7 +26,7 @@ c
 c     The original version has been modified to replace statically
 c     allocated arrays dysav, ytemp and ysav by rwork arguments parts
 c     array + blas use. Serge Steer INRIA- feb 2012
-
+      include 'stack.h'
       integer n,i
       double precision fcor,one,safety,errcon
       parameter (fcor=.0666666667,one=1.0,safety=0.9,errcon=6.e-4)
@@ -36,15 +36,13 @@ c     array + blas use. Serge Steer INRIA- feb 2012
       double precision rwork(*)
 
       external derivs
-      integer iero
-      common/ierode/iero
 
       lysav=1
       ldysav=lysav+n
       lytemp=ldysav+n
       lwork=lytemp+n
 
-      iero=0
+      ierror=0
       pgrow=-0.20d0
       pshrnk=-0.25d0
       xsav=x
@@ -55,19 +53,19 @@ c     array + blas use. Serge Steer INRIA- feb 2012
 1     hh=0.5*h
       call rk4(rwork(lysav),rwork(ldysav),n,xsav,hh,rwork(lytemp),
      $     derivs,rwork(lwork))
-      if (iero.gt.0) return
+      if (ierror.gt.0) return
       x=xsav+hh
       call derivs(n,x,rwork(lytemp),dydx)
-      if (iero.gt.0) return
+      if (ierror.gt.0) return
       call rk4(rwork(lytemp),dydx,n,x,hh,y,derivs,rwork(lwork))
       x=xsav+h
       if(x.eq.xsav) then
-         iero=1
+         ierror=1
          return
       endif
       call rk4(rwork(lysav),rwork(ldysav),n,xsav,h,rwork(lytemp),
      $     derivs,rwork(lwork))
-      if (iero.gt.0) return
+      if (ierror.gt.0) return
       errmax=0.0d0
        do 12 i=0,n-1
         rwork(lytemp+i)=y(i+1)-rwork(lytemp+i)