fix import/export of ierode common on Windows 50/13350/2
Antoine ELIAS [Tue, 10 Dec 2013 13:43:18 +0000 (14:43 +0100)]
Change-Id: Ibebda6a9e8dcada17a4451116d1babe5f5cf7b32

35 files changed:
scilab/modules/differential_equations/sci_gateway/fortran/badd.f
scilab/modules/differential_equations/sci_gateway/fortran/bj2.f
scilab/modules/differential_equations/sci_gateway/fortran/bjac.f
scilab/modules/differential_equations/sci_gateway/fortran/bjacd.f
scilab/modules/differential_equations/sci_gateway/fortran/bpjacd.f
scilab/modules/differential_equations/sci_gateway/fortran/bpsold.f
scilab/modules/differential_equations/sci_gateway/fortran/bresd.f
scilab/modules/differential_equations/sci_gateway/fortran/bresid.f
scilab/modules/differential_equations/sci_gateway/fortran/bsurf.f
scilab/modules/differential_equations/sci_gateway/fortran/bsurfd.f
scilab/modules/differential_equations/sci_gateway/fortran/bydot2.f
scilab/modules/differential_equations/sci_gateway/fortran/sci_f_daskr.f
scilab/modules/differential_equations/sci_gateway/fortran/sci_f_dasrt.f
scilab/modules/differential_equations/sci_gateway/fortran/sci_f_dassl.f
scilab/modules/differential_equations/sci_gateway/fortran/sci_f_impl.f
scilab/modules/differential_equations/src/fortran/ainvg.f
scilab/modules/differential_equations/src/fortran/ddasrt.f
scilab/modules/differential_equations/src/fortran/ddassl.f
scilab/modules/differential_equations/src/fortran/lsdisc.f
scilab/modules/differential_equations/src/fortran/lsoda.f
scilab/modules/differential_equations/src/fortran/lsodar.f
scilab/modules/differential_equations/src/fortran/lsode.f
scilab/modules/differential_equations/src/fortran/lsodi.f
scilab/modules/differential_equations/src/fortran/prepj.f
scilab/modules/differential_equations/src/fortran/prepji.f
scilab/modules/differential_equations/src/fortran/prja.f
scilab/modules/differential_equations/src/fortran/rchek.f
scilab/modules/differential_equations/src/fortran/rchek2.f
scilab/modules/differential_equations/src/fortran/rkf45.f
scilab/modules/differential_equations/src/fortran/rksimp.f
scilab/modules/differential_equations/src/fortran/stoda.f
scilab/modules/differential_equations/src/fortran/stode.f
scilab/modules/differential_equations/src/fortran/stodi.f
scilab/modules/differential_equations/src/fortran/xerrwv.f
scilab/modules/scicos_blocks/src/fortran/sciblk.f

index e623c0f..b735b24 100644 (file)
@@ -18,7 +18,6 @@ c
       integer iadr,sadr
 c     
       double precision y(ny),p(nrowp,ny),t(*)
-      common/ierode/iero
       logical allowptr
 c     
       integer vol,tops,nordre
@@ -30,16 +29,16 @@ c
 c     nordre=external number
 c     mlhs (mrhs) = number ot output (input) parameters of the 
 c     external 
-      iero=0
+      ierror=0
       mrhs=3
 c     
       ilp=iadr(lstk(top))
       il=istk(ilp+nordre)
 
 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
@@ -138,7 +137,7 @@ c     transfer of output parameters of external to fortran
       if(err.gt.0.or.err1.gt.0) return
 c+    
 c     normal return
-      iero=0
+      ierror=0
       return
 c     
  9999 continue
index 84867dc..0bcc8d2 100644 (file)
@@ -18,8 +18,7 @@ c
       integer iadr,sadr
 c     
       double precision y(n),s(n),jac(nrowj,n),t(*)
-      common/ierode/iero
-c     
+      
       logical allowptr
       integer vol,tops,nordre
       data nordre/3/,mlhs/1/
@@ -32,16 +31,16 @@ c     de donnee,
 c     mlhs (mrhs) est le nombre de parametres de sortie (entree)
 c     du simulateur 
 c     
-      iero=0
+      ierror=0
       mrhs=3
 c     
       ilp=iadr(lstk(top))
       il=istk(ilp+nordre)
 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     Putting Fortran arguments on Scilab stack 
 c+    
@@ -121,8 +120,8 @@ c+
 c     transfert des variables  de sortie vers fortran
       call btof(jac,n*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 
       return
 
 c+    
index db00e10..088d56f 100644 (file)
@@ -14,7 +14,6 @@ c
       integer iadr,sadr
 c     
       double precision y(ny),jac(nrowj,ny),t(*)
-      common/ierode/iero
 c     
       logical allowptr
       integer vol,tops,nordre
@@ -23,7 +22,7 @@ c
       iadr(l)=l+l-1
       sadr(l)=(l/2)+1
 c     
-      iero=0
+      ierror=0
       mrhs=2
 c     
       ilp=iadr(lstk(top))
@@ -39,9 +38,9 @@ c     Case of a Fortran simulator
       endif
 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     Putting Fortran arguments on Scilab stack 
 c+    
@@ -124,8 +123,8 @@ c     Transferring the output to Fortran
       endif
       if(err.gt.0.or.err1.gt.0) return
 c+    
-c     normal return iero set to 0
-      iero=0 
+c     normal return ierror set to 0
+      ierror=0 
       return
 c     
  9999 continue
index 17ca611..25434e6 100644 (file)
@@ -17,9 +17,7 @@ c ======================================================================
 c
       INCLUDE 'stack.h'
       integer iadr,sadr
-c     
-      common/ierode/iero
-c     
+
       character tmpbuf * (bsiz) 
       logical allowptr
       double precision t, y(*),ydot(*),res(*),rpar(*),cj
@@ -40,7 +38,7 @@ c     data structure,
 c     mlhs (mrhs) is the number of output (input) parameters
 c     of the simulator
 c     
-      iero=0
+      ierror=0
       mrhs=4
 c     
       ilp=iadr(lstk(top))
@@ -56,9 +54,9 @@ c     Case of a Fortran simulator
       endif
 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     Putting Fortran arguments on Scilab stack 
 c+    
@@ -146,8 +144,8 @@ c+
 c     Transferring the output to Fortran
       call btof(res,neq*neq)
       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 
       return
 c     
  9999 continue
index dc04994..4136b8f 100644 (file)
@@ -17,7 +17,6 @@ c
       INCLUDE 'stack.h'
       integer iadr,sadr
 c
-      common/ierode/iero
       logical allowptr
 c
       character tmpbuf * (bsiz)
@@ -42,7 +41,7 @@ c     mlhs (mrhs) is the number of output (input) parameters
 c     of the simulator
 c
       mrhs=8
-      iero=0
+      ierror=0
 c
       ilp=iadr(lstk(top))
       il=istk(ilp+nordre)
@@ -58,9 +57,9 @@ c     Fortran simulator case
       endif
 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     Putting Fortran arguments on Scilab stack
 c
@@ -174,8 +173,8 @@ c     Test if the variable on the stack has same type and size as the theoretica
       if(err.gt.0.or.err1.gt.0) return
 c+
 
-c     Normal return iero set to 0
-      iero=0
+c     Normal return ierror set to 0
+      ierror=0
       return
 c
  9999 continue
index 0b708b8..8193b7b 100644 (file)
@@ -17,7 +17,6 @@ c
       INCLUDE 'stack.h'
       integer iadr,sadr
 c
-      common/ierode/iero
       logical allowptr
 c
       character tmpbuf * (bsiz)
@@ -40,7 +39,7 @@ c     mlhs (mrhs) is the number of output (input) parameters
 c     of the simulator
 c
       mrhs=3
-      iero=0
+      ierror=0
 c
       ilp=iadr(lstk(top))
       il=istk(ilp+nordre)
@@ -56,9 +55,9 @@ c     Fortran simulator case
       endif
 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     Putting Fortran arguments on Scilab stack
 c
@@ -164,8 +163,8 @@ c     Transferring the output to Fortran
       call btof(b,neq)
       if(err.gt.0.or.err1.gt.0) return
 c+
-c     Normal return iero set to 0
-      iero=0
+c     Normal return ierror set to 0
+      ierror=0
       return
 c
  9999 continue
index 3f81297..7a77946 100644 (file)
@@ -18,7 +18,6 @@ c
       INCLUDE 'stack.h'
       integer iadr,sadr
 c     
-      common/ierode/iero
       logical allowptr
 c      
       character tmpbuf * (bsiz) 
@@ -41,7 +40,7 @@ c     mlhs (mrhs) is the number of output (input) parameters
 c     of the simulator
 c     
       mrhs=3
-      iero=0
+      ierror=0
 c     
       ilp=iadr(lstk(top))
       il=istk(ilp+nordre)
@@ -56,9 +55,9 @@ c     Case of a Fortran simulator
       endif
 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     Putting Fortran arguments on Scilab stack 
 c     
@@ -145,8 +144,8 @@ c     Transferring the output to Fortran
       call btof(res,neq)
       if(err.gt.0.or.err1.gt.0) return
 c+    
-c     normal return iero set to 0
-      iero=0 
+c     normal return ierror set to 0
+      ierror=0 
       return
 c     
  9999 continue
index d608a2d..3bd920f 100644 (file)
@@ -19,7 +19,6 @@ c
 c     
       logical allowptr
       double precision t(*), y(n),res(n),s(n)
-      common/ierode/iero
 c     
       integer vol,tops,nordre
       data nordre/1/,mlhs/1/
@@ -32,16 +31,16 @@ c     nordre=external number
 c     mlhs (mrhs) = number ot output (input) parameters of the 
 c     external 
 c     
-      iero=0
+      ierror=0
       mrhs=3
 c     
       ilp=iadr(lstk(top))
       il=istk(ilp+nordre)
 c     
 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
       call ftob(t,1,istk(il+1))
@@ -118,7 +117,7 @@ c     transfert des variables  de sortie vers fortran
       if(err.gt.0.or.err1.gt.0) return
 c+    
 c     normal return
-      iero=0
+      ierror=0
       return
 c     
  9999 continue
index bf4e319..76e0993 100644 (file)
@@ -20,7 +20,6 @@ c
 c     
       logical allowptr
       double precision y(ny),gout(ng),t(*)
-      common/ierode/iero
 c     
       character tmpbuf * (bsiz) 
       integer vol,tops,nordre
@@ -39,7 +38,7 @@ c
          call basout(io,wte,' bsurf   top:'//tmpbuf(1:4))
       endif
 c
-      iero=0
+      ierror=0
       mrhs=2
 c     
       ilp=iadr(lstk(top))
@@ -55,9 +54,9 @@ c     cas d'un simulateur en fortran
       endif
 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     Putting Fortran arguments on Scilab stack 
 c+    
@@ -134,8 +133,8 @@ c     transfert des variables  de sortie vers fortran
       call btof(gout,ng)
       if(err.gt.0.or.err1.gt.0) return
 c+    
-c     normal return iero set to 0
-      iero=0 
+c     normal return ierror set to 0
+      ierror=0 
       return
 c     
  9999 continue
index 62534c9..321e681 100644 (file)
@@ -16,9 +16,7 @@ c     ====================================
 c
       INCLUDE 'stack.h'
       integer iadr,sadr
-c     
-      common/ierode/iero
-c     
+
       character tmpbuf * (bsiz) 
       logical allowptr
       double precision y(ny),gout(ng),t(*)
@@ -40,7 +38,7 @@ c     data structure,
 c     mlhs (mrhs) is the number of output (input) parameters
 c     of the simulator
 c     
-      iero=0
+      ierror=0
       mrhs=2
 c     
       ilp=iadr(lstk(top))
@@ -57,9 +55,9 @@ c     Case of a Fortran simulator
 c     
 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     Putting Fortran arguments on Scilab stack 
 c+    
@@ -135,8 +133,8 @@ c     transfert des variables  de sortie vers Fortran
       call btof(gout,ng)
       if(err.gt.0.or.err1.gt.0) return
 c+    
-c     normal return iero set to 0
-      iero=0 
+c     normal return ierror set to 0
+      ierror=0 
       return
 c     
  9999 continue
index 7af5659..a9c77a4 100644 (file)
@@ -13,7 +13,6 @@ c
       INCLUDE 'stack.h'
       integer iadr,sadr
 c     
-      common/ierode/iero
       common/odecd/nd,iflag
 c     
       logical allowptr
@@ -29,7 +28,7 @@ c     nordre=external number
 c     mlhs (mrhs) = number ot output (input) parameters of the 
 c     external 
 c  
-      iero=0
+      ierror=0
       mrhs=4
 c     
       ilp=iadr(lstk(top))
@@ -47,9 +46,9 @@ c     fortran external
 c     
 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     transfer of input parameters
 c+    
@@ -159,8 +158,8 @@ c     transfer of output parameters of external to fortran
       endif
       if(err.gt.0.or.err1.gt.0) return
 c+    
-c     normal return iero set to 0
-      iero=0 
+c     normal return ierror set to 0
+      ierror=0 
       return
 c     
  9999 continue
index 15ddc1b..38905fb 100644 (file)
@@ -34,7 +34,6 @@ c
       common /dassln/ namer,namej,names,namep,namepj
       external bresd,bjacd,bsurfd,bpsold,bpjacd
       external setfresd,setfjacd,setfsurfd,setfpsold,setfpjacd
-      common/ierode/iero
 c
       data atol/1.d-7/,rtol/1.d-9/
 c
@@ -45,7 +44,7 @@ c     SCILAB function : daskr
 c     --------------------------
 c     [y0,nvs[,hotdata]]=daskr(y0,t0,t1[,atol[,rtol]],res[,jac],nh,h[,info
 c     [,psol][,pjac]][,hotdata])
-      iero=0
+      ierror=0
       maxord=5
       lbuf = 1
       topk=top
index ba61531..5e76a9e 100644 (file)
@@ -29,7 +29,6 @@ c
       common /dassln/ namer,namej,names
       external bresd,bjacd,bsurfd
       external setfresd,setfjacd,setfsurfd
-      common/ierode/iero
 c     
       data atol/1.d-7/,rtol/1.d-9/
 c     
@@ -40,7 +39,7 @@ c     SCILAB function : dasrt
 c     --------------------------
 c     [y0,nvs,[,hotdata]]=dasrt(y0,t0,t1[,atol,rtol],res[,jac],nh,h,info
 c     [,hotdata])
-      iero=0
+      ierror=0
       maxord=5
       lbuf = 1
       topk=top
index 00a293b..59eba07 100644 (file)
@@ -25,7 +25,6 @@ c
       external setfresd,setfjacd
 
       common /dassln/ namer,namej,names
-      common/ierode/iero
       common/cjac/namjac
 c     
       data atol/1.d-7/,rtol/1.d-9/
@@ -37,7 +36,7 @@ c     SCILAB function : dassl
 c     --------------------------
 c     [y0 [,hotdata]]=dassl(y0,t0,t1 [,atol,rtol],res [,jac],info..
 c     [,hotdata])
-      iero=0
+      ierror=0
       maxord=5
       lbuf = 1
       topk=top
index 699c048..7f9eb4b 100644 (file)
@@ -29,7 +29,6 @@ c
       character*1 strf
       common/cjac/namjac
       external setfres,setfadda,setfj2
-      common/ierode/iero
 c     
       data atol/1.d-7/,rtol/1.d-9/
 c     
@@ -39,7 +38,7 @@ c
 C     XXXXXX : pour l'instant 
       if (.not.checklhs(fname,1,3)) return
 c     ---------------------------------
-      iero=0
+      ierror=0
       topk=top
       topw=top+1
       iskip=1
index 9811673..0baea1e 100644 (file)
@@ -2,13 +2,13 @@ C/MEMBR ADD NAME=AINVG,SSI=0
       subroutine ainvg (res, adda, neq, t, y, ydot, miter,
      1                   ml, mu, pw, ipvt, ier )
 clll. optimize
+      
+      include 'stack.h'
       external res, adda
       integer neq, miter, ml, mu, ipvt, ier
       integer i, lenpw, mlp1, nrowpw
       double precision t, y, ydot, pw
       dimension y(*), ydot(*), pw(*), ipvt(*)
-      integer         iero
-      common /ierode/ iero
 c-----------------------------------------------------------------------
 c%purpose
 c this subroutine computes the initial value
@@ -33,11 +33,11 @@ c
 c
       ier = 1
       call res ( neq, t, y, pw, ydot, ier )
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       if (ier .gt. 1) return
 c
       call adda ( neq, t, y, 0, 0, pw, neq )
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       call dgefa ( pw, neq, neq, ipvt, ier )
       if (ier .eq. 0) go to 20
          ier = -ier
@@ -55,12 +55,12 @@ c
 c
       ier = 1
       call res ( neq, t, y, pw, ydot, ier )
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       if (ier .gt. 1) return
 c
       mlp1 = ml + 1
       call adda ( neq, t, y, ml, mu, pw(mlp1), nrowpw )
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       call dgbfa ( pw, nrowpw, neq, ml, mu, ipvt, ier )
       if (ier .eq. 0) go to 120
          ier = -ier
index cbf8cc8..88ef75a 100644 (file)
@@ -859,7 +859,12 @@ C***END PROLOGUE  DDASRT
 C
 C**End
 C
+      
+      
       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
+
+      include 'stack.h'
+      
       LOGICAL DONE
       EXTERNAL RES, JAC, G
       DIMENSION Y(*),YPRIME(*)
@@ -884,7 +889,6 @@ C     SET POINTERS INTO RWORK
      *  LALPHA=11, LBETA=17, LGAMMA=23,
      *  LPSI=29, LSIGMA=35, LT0=41, LTLAST=42, LALPHR=43, LX2=44,
      *  LDELTA=51)
-      common/ierode/iero
 C
 C***FIRST EXECUTABLE STATEMENT  DDASRT
      
@@ -1029,7 +1033,7 @@ C
 C
 C     SET ERROR WEIGHT VECTOR WT
       CALL DDAWTS(NEQ,INFO(2),RTOL,ATOL,Y,RWORK(LWT),RPAR,IPAR)
-c      if(iero.gt.0) return
+c      if(ierror.gt.0) return
       DO 305 I = 1,NEQ
          IF(RWORK(LWT+I-1).LE.0.0D0) GO TO 713
 305      CONTINUE
@@ -1075,7 +1079,7 @@ C     COMPUTE INITIAL DERIVATIVE, UPDATING TN AND Y, IF APPLICABLE
      *  RWORK(LPHI),RWORK(LDELTA),RWORK(LE),
      *  RWORK(LWM),IWORK(LIWM),HMIN,RWORK(LROUND),
      *  INFO(10),NTEMP)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       IF (IDID .LT. 0) GO TO 390
 C
 C     LOAD H WITH H0.  STORE H IN RWORK(LH)
@@ -1101,7 +1105,7 @@ C
      *  RWORK(LPSI),IWORK(LKOLD),RWORK(LG0),RWORK(LG1),
      *  RWORK(LGX),JROOT,IRT,RWORK(LROUND),INFO(3),
      *  RWORK,IWORK,RPAR,IPAR)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       IF(IRT .NE. 0) GO TO 732
 C
 C     Check for a root in the interval (T0,TN], unless DDASRT
@@ -1112,7 +1116,7 @@ C
      *  RWORK(LPSI),IWORK(LKOLD),RWORK(LG0),RWORK(LG1),
      *  RWORK(LGX),JROOT,IRT,RWORK(LROUND),INFO(3),
      *  RWORK,IWORK,RPAR,IPAR)
-      if (iero.gt.0) return
+      if (ierror.gt.0) return
       IF(IRT .NE. 1) GO TO 390
       IWORK(LIRFND) = 1
       IDID = 4
@@ -1143,7 +1147,7 @@ C
      *  RWORK(LPSI),IWORK(LKOLD),RWORK(LG0),RWORK(LG1),
      *  RWORK(LGX),JROOT,IRT,RWORK(LROUND),INFO(3),
      *  RWORK,IWORK,RPAR,IPAR)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       IF(IRT .NE. 1) GO TO 405
       IWORK(LIRFND) = 1
       IDID = 4
@@ -1165,7 +1169,7 @@ C
       IF((TN-TOUT)*H.LT.0.0D0)GO TO 490
       CALL DDATRP(TN,TOUT,Y,YPRIME,NEQ,IWORK(LKOLD),
      *  RWORK(LPHI),RWORK(LPSI))
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       T=TOUT
       IDID = 3
       DONE = .TRUE.
@@ -1174,7 +1178,7 @@ C
       IF((TN - TOUT)*H .GT. 0.0D0) GO TO 425
       CALL DDATRP(TN,TN,Y,YPRIME,NEQ,IWORK(LKOLD),
      *  RWORK(LPHI),RWORK(LPSI))
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       T = TN
       IDID = 1
       DONE = .TRUE.
@@ -1182,7 +1186,7 @@ C
 425   CONTINUE
       CALL DDATRP(TN,TOUT,Y,YPRIME,NEQ,IWORK(LKOLD),
      *  RWORK(LPHI),RWORK(LPSI))
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       T = TOUT
       IDID = 3
       DONE = .TRUE.
@@ -1194,7 +1198,7 @@ C
       IF((TN-TOUT)*H.LT.0.0D0)GO TO 450
       CALL DDATRP(TN,TOUT,Y,YPRIME,NEQ,IWORK(LKOLD),
      *   RWORK(LPHI),RWORK(LPSI))
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       T=TOUT
       IDID = 3
       DONE = .TRUE.
@@ -1206,7 +1210,7 @@ C
       IF((TN - TOUT)*H .GT. 0.0D0) GO TO 445
       CALL DDATRP(TN,TN,Y,YPRIME,NEQ,IWORK(LKOLD),
      *  RWORK(LPHI),RWORK(LPSI))
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       T = TN
       IDID = 1
       DONE = .TRUE.
@@ -1214,7 +1218,7 @@ C
 445   CONTINUE
       CALL DDATRP(TN,TOUT,Y,YPRIME,NEQ,IWORK(LKOLD),
      *  RWORK(LPHI),RWORK(LPSI))
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       T = TOUT
       IDID = 3
       DONE = .TRUE.
@@ -1225,7 +1229,7 @@ C     CHECK WHETHER WE ARE WITH IN ROUNDOFF OF TSTOP
      *   (DABS(TN)+DABS(H)))GO TO 460
       CALL DDATRP(TN,TSTOP,Y,YPRIME,NEQ,IWORK(LKOLD),
      *  RWORK(LPHI),RWORK(LPSI))
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       IDID=2
       T=TSTOP
       DONE = .TRUE.
@@ -1260,7 +1264,7 @@ C
 C     UPDATE WT
 510   CALL DDAWTS(NEQ,INFO(2),RTOL,ATOL,RWORK(LPHI),
      *  RWORK(LWT),RPAR,IPAR)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       DO 520 I=1,NEQ
          IF(RWORK(I+LWT-1).GT.0.0D0)GO TO 520
            IDID=-3
@@ -1303,7 +1307,7 @@ C
      *   RWORK(LS),HMIN,RWORK(LROUND),
      *   IWORK(LPHASE),IWORK(LJCALC),IWORK(LK),
      *   IWORK(LKOLD),IWORK(LNS),INFO(10),NTEMP)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
 527   IF(IDID.LT.0)GO TO 600
 C
 C--------------------------------------------------------
@@ -1319,7 +1323,7 @@ C
      *  RWORK(LPSI),IWORK(LKOLD),RWORK(LG0),RWORK(LG1),
      *  RWORK(LGX),JROOT,IRT,RWORK(LROUND),INFO(3),
      *  RWORK,IWORK,RPAR,IPAR)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       IF(IRT .NE. 1) GO TO 529
       IWORK(LIRFND) = 1
       IDID = 4
@@ -1334,7 +1338,7 @@ C
              IF((TN-TOUT)*H.LT.0.0D0)GO TO 500
              CALL DDATRP(TN,TOUT,Y,YPRIME,NEQ,
      *         IWORK(LKOLD),RWORK(LPHI),RWORK(LPSI))
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
              IDID=3
              T=TOUT
              GO TO 580
@@ -1344,7 +1348,7 @@ C
              GO TO 580
 535          CALL DDATRP(TN,TOUT,Y,YPRIME,NEQ,
      *         IWORK(LKOLD),RWORK(LPHI),RWORK(LPSI))
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
              IDID=3
              T=TOUT
              GO TO 580
@@ -1352,7 +1356,7 @@ C
       IF((TN-TOUT)*H.LT.0.0D0)GO TO 542
          CALL DDATRP(TN,TOUT,Y,YPRIME,NEQ,
      *     IWORK(LKOLD),RWORK(LPHI),RWORK(LPSI))
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
          T=TOUT
          IDID=3
          GO TO 580
@@ -1364,7 +1368,7 @@ C
       GO TO 500
 545   CALL DDATRP(TN,TSTOP,Y,YPRIME,NEQ,
      *  IWORK(LKOLD),RWORK(LPHI),RWORK(LPSI))
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       IDID=2
       T=TSTOP
       GO TO 580
       GO TO 580
 552   CALL DDATRP(TN,TSTOP,Y,YPRIME,NEQ,
      *  IWORK(LKOLD),RWORK(LPHI),RWORK(LPSI))
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       IDID=2
       T=TSTOP
       GO TO 580
 555   CALL DDATRP(TN,TOUT,Y,YPRIME,NEQ,
      *   IWORK(LKOLD),RWORK(LPHI),RWORK(LPSI))
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       T=TOUT
       IDID=3
 580   CONTINUE
@@ -1582,7 +1586,11 @@ C***DATE WRITTEN   821001   (YYMMDD)
 C***REVISION DATE  900926   (YYMMDD)
 C***END PROLOGUE  DRCHEK
 C
+      
       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
+
+      include 'stack.h'
+
       PARAMETER (LNGE=16, LIRFND=18, LLAST=19, LIMAX=20,
      *           LT0=41, LTLAST=42, LALPHR=43, LX2=44)
       EXTERNAL G
@@ -1634,7 +1642,6 @@ C          STORED IN THE GLOBAL ARRAY IWORK.
 C INFO3  = COPY OF INFO(3) (INPUT ONLY).
 C-----------------------------------------------------------------------
 C     
-      common/ierode/iero
       H = PSI(1)
       IRT = 0
       DO 10 I = 1,NG
@@ -1647,9 +1654,9 @@ C EVALUATE G AT INITIAL T (STORED IN RWORK(LT0)), AND CHECK FOR
 C ZERO VALUES.----------------------------------------------------------
  100  CONTINUE
       CALL DDATRP(TN,RWORK(LT0),Y,YP,NEQ,KOLD,PHI,PSI)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       CALL G (NEQ, RWORK(LT0), Y, NG, G0, RPAR, IPAR)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       IWORK(LNGE) = 1
       ZROOT = .FALSE.
       DO 110 I = 1,NG
@@ -1662,7 +1669,7 @@ C G HAS A ZERO AT T.  LOOK AT G AT T + (SMALL INCREMENT). --------------
       DO 120 I = 1,NEQ
  120    Y(I) = Y(I) + TEMP2*PHI(I,2)
       CALL G (NEQ, RWORK(LT0), Y, NG, G0, RPAR, IPAR)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       IWORK(LNGE) = IWORK(LNGE) + 1
       ZROOT = .FALSE.
       DO 130 I = 1,NG
@@ -1680,9 +1687,9 @@ C
       IF (IWORK(LIRFND) .EQ. 0) GO TO 260
 C IF A ROOT WAS FOUND ON THE PREVIOUS STEP, EVALUATE G0 = G(T0). -------
       CALL DDATRP (TN, RWORK(LT0), Y, YP, NEQ, KOLD, PHI, PSI)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       CALL G (NEQ, RWORK(LT0), Y, NG, G0, RPAR, IPAR)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       IWORK(LNGE) = IWORK(LNGE) + 1
       ZROOT = .FALSE.
       DO 210 I = 1,NG
@@ -1697,9 +1704,9 @@ C G HAS A ZERO AT T0.  LOOK AT G AT T + (SMALL INCREMENT). -------------
  220    Y(I) = Y(I) + TEMP2*PHI(I,2)
       GO TO 240
  230  CALL DDATRP (TN, RWORK(LT0), Y, YP, NEQ, KOLD, PHI, PSI)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
  240  CALL G (NEQ, RWORK(LT0), Y, NG, G0, RPAR, IPAR)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       IWORK(LNGE) = IWORK(LNGE) + 1
       ZROOT = .FALSE.
       DO 250 I = 1,NG
@@ -1722,13 +1729,13 @@ C SET T1 TO TN OR TOUT, WHICHEVER COMES FIRST, AND GET G AT T1. --------
       T1 = TOUT
       IF ((T1 - RWORK(LT0))*H .LE. 0.0D0) GO TO 390
       CALL DDATRP (TN, T1, Y, YP, NEQ, KOLD, PHI, PSI)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       GO TO 330
  310  T1 = TN
       DO 320 I = 1,NEQ
  320    Y(I) = PHI(I,1)
  330  CALL G (NEQ, T1, Y, NG, G1, RPAR, IPAR)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       IWORK(LNGE) = IWORK(LNGE) + 1
 C CALL DROOTS TO SEARCH FOR ROOT IN INTERVAL FROM T0 TO T1. ------------
       JFLAG = 0
@@ -1736,12 +1743,12 @@ C CALL DROOTS TO SEARCH FOR ROOT IN INTERVAL FROM T0 TO T1. ------------
       CALL DROOTS (NG, HMING, JFLAG, RWORK(LT0), T1, G0, G1, GX, X,
      *             JROOT, IWORK(LIMAX), IWORK(LLAST), RWORK(LALPHR),
      *             RWORK(LX2))
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       IF (JFLAG .GT. 1) GO TO 360
       CALL DDATRP (TN, X, Y, YP, NEQ, KOLD, PHI, PSI)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       CALL G (NEQ, X, Y, NG, GX, RPAR, IPAR)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       IWORK(LNGE) = IWORK(LNGE) + 1
       GO TO 350
  360  RWORK(LT0) = X
@@ -1749,7 +1756,7 @@ C CALL DROOTS TO SEARCH FOR ROOT IN INTERVAL FROM T0 TO T1. ------------
       IF (JFLAG .EQ. 4) GO TO 390
 C FOUND A ROOT.  INTERPOLATE TO X AND RETURN. --------------------------
       CALL DDATRP (TN, X, Y, YP, NEQ, KOLD, PHI, PSI)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       IRT = 1
       RETURN
 C
@@ -1769,6 +1776,9 @@ C***REVISION DATE  900926   (YYMMDD)
 C***END PROLOGUE  DROOTS
 C
       IMPLICIT DOUBLE PRECISION(A-H,O-Z)
+
+      include 'stack.h'
+      
       INTEGER NG, JFLAG, JROOT, IMAX, LAST
       DOUBLE PRECISION HMIN, X0, X1, G0, G1, GX, X, ALPHA, X2
       DIMENSION G0(NG), G1(NG), GX(NG), JROOT(NG)
@@ -1853,7 +1863,6 @@ C-----------------------------------------------------------------------
       INTEGER I, IMXOLD, NXLAST
       DOUBLE PRECISION T2, TMAX, ZERO
       LOGICAL ZROOT, SGNCHG, XROOT
-      common/ierode/iero
       DATA ZERO/0.0D0/
 C
       IF (JFLAG .EQ. 1) GO TO 200
index c0c58fa..a55b268 100644 (file)
@@ -1,7 +1,7 @@
       SUBROUTINE DDAINI (X, Y, YPRIME, NEQ, RES, JAC, H, WT, IDID, RPAR,
      +   IPAR, PHI, DELTA, E, WM, IWM, HMIN, UROUND, NONNEG, NTEMP)
-      common/ierode/iero
 
+      include 'stack.h'
 C***BEGIN PROLOGUE  DDAINI
 C***SUBSIDIARY
 C***PURPOSE  Initialization routine for DDASSL.
@@ -66,7 +66,7 @@ C
       INTEGER  I, IER, IRES, JCALC, LNJE, LNRE, M, MAXIT, MJAC, NCF,
      *   NEF, NSF
       DOUBLE PRECISION
-     *   CJ, DAMP, DELNRM, ERR, OLDNRM, R, RATE, S, XOLD, YNORM
+     *   CJ, DAMP, DELNRM, IERR, OLDNRM, R, RATE, S, XOLD, YNORM
       LOGICAL  CONVGD
 C
       PARAMETER (LNRE=12)
@@ -212,9 +212,9 @@ C-----------------------------------------------------
 C
       DO 510 I=1,NEQ
 510      E(I)=Y(I)-PHI(I,1)
-      ERR=DDANRM(NEQ,E,WT,RPAR,IPAR)
+      IERR=DDANRM(NEQ,E,WT,RPAR,IPAR)
 C
-      IF (ERR.LE.1.0D0) RETURN
+      IF (IERR.LE.1.0D0) RETURN
 C
 C
 C
@@ -249,7 +249,7 @@ C
          RETURN
 C
 640   NEF=NEF+1
-      R=0.90D0/(2.0D0*ERR+0.0001D0)
+      R=0.90D0/(2.0D0*IERR+0.0001D0)
       R=MAX(0.1D0,MIN(0.5D0,R))
       H=H*R
       IF (ABS(H).GE.HMIN.AND.NEF.LT.10) GO TO 690
@@ -262,7 +262,7 @@ C-------------END OF SUBROUTINE DDAINI----------------------
       SUBROUTINE DDAJAC (NEQ, X, Y, YPRIME, DELTA, CJ, H,
      +   IER, WT, E, WM, IWM, RES, IRES, UROUND, JAC, RPAR,
      +   IPAR, NTEMP)
-      common/ierode/iero
+      include 'stack.h'
 
 C***BEGIN PROLOGUE  DDAJAC
 C***SUBSIDIARY
@@ -549,7 +549,7 @@ C------END OF SUBROUTINE DDASLV------
       END
       SUBROUTINE DDASSL (RES, NEQ, T, Y, YPRIME, TOUT, INFO, RTOL, ATOL,
      +   IDID, RWORK, LRW, IWORK, LIW, RPAR, IPAR, JAC)
-      common/ierode/iero
+      include 'stack.h'
 C***BEGIN PROLOGUE  DDASSL
 C***PURPOSE  This code solves a system of differential/algebraic
 C            equations of the form G(T,Y,YPRIME) = 0.
@@ -2159,7 +2159,8 @@ C-----------END OF SUBROUTINE DDASSL------------------------------------
      +   IDID, RPAR, IPAR, PHI, DELTA, E, WM, IWM, ALPHA, BETA, GAMMA,
      +   PSI, SIGMA, CJ, CJOLD, HOLD, S, HMIN, UROUND, IPHASE, JCALC,
      +   K, KOLD, NS, NONNEG, NTEMP)
-      common/ierode/iero
+      
+      include 'stack.h'
 
 C***BEGIN PROLOGUE  DDASTP
 C***SUBSIDIARY
@@ -2265,7 +2266,7 @@ C
      *   LETF, LMXORD, LNJE, LNRE, LNST, M, MAXIT, NCF, NEF, NSF, NSP1
       DOUBLE PRECISION
      *   ALPHA0, ALPHAS, CJLAST, CK, DELNRM, ENORM, ERK, ERKM1,
-     *   ERKM2, ERKP1, ERR, EST, HNEW, OLDNRM, PNORM, R, RATE, TEMP1,
+     *   ERKM2, ERKP1, IERR, EST, HNEW, OLDNRM, PNORM, R, RATE, TEMP1,
      *   TEMP2, TERK, TERKM1, TERKM2, TERKP1, XOLD, XRATE
       LOGICAL  CONVGD
 C
@@ -2565,8 +2566,8 @@ C
 C     CALCULATE THE LOCAL ERROR FOR THE CURRENT STEP
 C     TO SEE IF THE STEP WAS SUCCESSFUL
 430   CONTINUE
-      ERR = CK * ENORM
-      IF(ERR .GT. 1.0D0)GO TO 600
+      IERR = CK * ENORM
+      IF(IERR .GT. 1.0D0)GO TO 600
 C
 C
 C
index 90b5770..08b04ba 100644 (file)
@@ -35,13 +35,11 @@ C
 c-----------------------------------------------------------------------
       integer  it,itout
       double precision tt
-      integer         iero
-      common /ierode/ iero
       include 'stack.h'
 c
       it=int(t)
       itout=int(tout)
-      iero=0   
+      ierror=0 
       if ( itout.lt.it) then 
          istate=-3
          return
@@ -52,7 +50,7 @@ c
          do 10 j=it,itout-1
             tt=dble(j)
             call f (neq,tt, y, rwork)
-            if(iero.gt.0) then
+            if(ierror.gt.0) then
                istate=-4
                return
             endif
index d7eb70b..9a1d2c2 100644 (file)
@@ -975,6 +975,8 @@ c-----------------------------------------------------------------------
 c the following card is for optimized compilation on lll compilers.
 clll. optimize
 c-----------------------------------------------------------------------
+      
+      include 'stack.h'
       external prja, solsy
       integer illin, init, lyh, lewt, lacor, lsavf, lwm, liwm,
      1   mxstep, mxhnil, nhnil, ntrep, nslast, nyh, iowns
@@ -1008,8 +1010,6 @@ c in subroutines lsoda, stoda, and prja.  groups of variables are
 c replaced by dummy arrays in the common declarations in routines
 c where those variables are not used.
 c-----------------------------------------------------------------------
-      integer         iero
-      common /ierode/ iero
       common /ls0001/ tret, rowns(209),
      1   ccmax, el0, h, hmin, hmxi, hu, rc, tn, uround,
      2   illin, init, lyh, lewt, lacor, lsavf, lwm, liwm,
@@ -1028,7 +1028,7 @@ c if istate .gt. 1 but the flag init shows that initialization has
 c not yet been done, an error return occurs.
 c if istate = 1 and tout = t, jump to block g and return immediately.
 c-----------------------------------------------------------------------
-      iero=0
+      ierror=0
       if (istate .lt. 1 .or. istate .gt. 3) go to 601
       if (itask .lt. 1 .or. itask .gt. 5) go to 602
       if (istate .eq. 1) go to 10
@@ -1219,7 +1219,7 @@ c-----------------------------------------------------------------------
 c initial call to f.  (lf0 points to yh(*,2).) -------------------------
       lf0 = lyh + nyh
       call f (neq, t, y, rwork(lf0))
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nfe = 1
 c load the initial value vector in yh. ---------------------------------
       do 115 i = 1,n
@@ -1365,7 +1365,7 @@ c-----------------------------------------------------------------------
       call stoda (neq, y, rwork(lyh), nyh, rwork(lyh), rwork(lewt),
      1   rwork(lsavf), rwork(lacor), rwork(lwm), iwork(liwm),
      2   f, jac, prja, solsy)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       kgo = 1 - kflag
       go to (300, 530, 540), kgo
 c-----------------------------------------------------------------------
index be4fa6d..e4fa421 100644 (file)
@@ -1092,6 +1092,9 @@ c-----------------------------------------------------------------------
 c the following card is for optimized compilation on lll compilers.
 clll. optimize
 c-----------------------------------------------------------------------
+      
+      include 'stack.h'
+      
       external prja, solsy
       integer illin, init, lyh, lewt, lacor, lsavf, lwm, liwm,
      1   mxstep, mxhnil, nhnil, ntrep, nslast, nyh, iowns
@@ -1130,8 +1133,6 @@ c in subroutines lsodar, rchek, and roots.  groups of variables are
 c replaced by dummy arrays in the common declarations in routines
 c where those variables are not used.
 c-----------------------------------------------------------------------
-      integer         iero
-      common /ierode/ iero
       common /ls0001/ tret, rowns(209),
      1   ccmax, el0, h, hmin, hmxi, hu, rc, tn, uround,
      2   illin, init, lyh, lewt, lacor, lsavf, lwm, liwm,
@@ -1361,7 +1362,7 @@ c-----------------------------------------------------------------------
 c initial call to f.  (lf0 points to yh(*,2).) -------------------------
       lf0 = lyh + nyh
       call f (neq, t, y, rwork(lf0))
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nfe = 1
 c load the initial value vector in yh. ---------------------------------
       do 115 i = 1,n
@@ -1428,7 +1429,7 @@ c check for a zero of g at t. ------------------------------------------
       if (ngc .eq. 0) go to 270
       call rchek (1, g, neq, y, rwork(lyh), nyh,
      1   rwork(lg0), rwork(lg1), rwork(lgx), jroot, irt)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       if (irt .eq. 0) go to 270
       go to 632
 c-----------------------------------------------------------------------
@@ -1447,7 +1448,7 @@ c
       if (itask .eq. 1 .or. itask .eq. 4) toutc = tout
       call rchek (2, g, neq, y, rwork(lyh), nyh,
      1   rwork(lg0), rwork(lg1), rwork(lgx), jroot, irt)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       if (irt .lt. 0) go to 632
       if (irt .ne. 1) go to 205
       irfnd = 1
@@ -1538,7 +1539,7 @@ c-----------------------------------------------------------------------
       call stoda (neq, y, rwork(lyh), nyh, rwork(lyh), rwork(lewt),
      1   rwork(lsavf), rwork(lacor), rwork(lwm), iwork(liwm),
      2   f, jac, prja, solsy)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       kgo = 1 - kflag
       go to (300, 530, 540), kgo
 c-----------------------------------------------------------------------
@@ -1575,7 +1576,7 @@ c
       if (ngc .eq. 0) go to 315
       call rchek (3, g, neq, y, rwork(lyh), nyh,
      1   rwork(lg0), rwork(lg1), rwork(lgx), jroot, irt)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       if (irt .ne. 1) go to 315
       irfnd = 1
       istate = 3
index f41025c..d1b0564 100644 (file)
@@ -1,5 +1,8 @@
       subroutine lsode (f, neq, y, t, tout, itol, rtol, atol, itask,
      1            istate, iopt, rwork, lrw, iwork, liw, jac, mf)
+      
+      include 'stack.h'
+      
       external f, jac
       integer neq, itol, itask, istate, iopt, lrw, iwork, liw, mf
       double precision y, t, tout, rtol, atol, rwork
@@ -973,8 +976,6 @@ c lsode, intdy, stode, prepj, and solsy.  groups of variables are
 c replaced by dummy arrays in the common declarations in routines
 c where those variables are not used.
 c-----------------------------------------------------------------------
-      integer         iero
-      common /ierode/ iero
       common /ls0001/ tret, rowns(209),
      1   ccmax, el0, h, hmin, hmxi, hu, rc, tn, uround,
      2   illin, init, lyh, lewt, lacor, lsavf, lwm, liwm,
@@ -992,7 +993,7 @@ c if istate .gt. 1 but the flag init shows that initialization has
 c not yet been done, an error return occurs.
 c if istate = 1 and tout = t, jump to block g and return immediately.
 c-----------------------------------------------------------------------
-      iero=0
+      ierror=0
       if (istate .lt. 1 .or. istate .gt. 3) go to 601
       if (itask .lt. 1 .or. itask .gt. 5) go to 602
       if (istate .eq. 1) go to 10
@@ -1134,7 +1135,7 @@ c-----------------------------------------------------------------------
 c initial call to f.  (lf0 points to yh(*,2).) -------------------------
       lf0 = lyh + nyh
       call f (neq, t, y, rwork(lf0))
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nfe = 1
 c load the initial value vector in yh. ---------------------------------
       do 115 i = 1,n
@@ -1269,7 +1270,7 @@ c-----------------------------------------------------------------------
       call stode (neq, y, rwork(lyh), nyh, rwork(lyh), rwork(lewt),
      1   rwork(lsavf), rwork(lacor), rwork(lwm), iwork(liwm),
      2   f, jac, prepj, solsy)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       kgo = 1 - kflag
       go to (300, 530, 540), kgo
 c-----------------------------------------------------------------------
index af15c50..91c96ba 100644 (file)
@@ -1136,6 +1136,8 @@ c-----------------------------------------------------------------------
 c the following card is for optimized compilation on llnl compilers.
 clll. optimize
 c-----------------------------------------------------------------------
+      include 'stack.h'
+
       external prepji, solsy
       integer illin, init, lyh, lewt, lacor, lsavr, lwm, liwm,
      1   mxstep, mxhnil, nhnil, ntrep, nslast, nyh, iowns
@@ -1165,8 +1167,6 @@ c lsodi, intdy, stodi, prepji, and solsy.  groups of variables are
 c replaced by dummy arrays in the common declarations in routines
 c where those variables are not used.
 c-----------------------------------------------------------------------
-      integer         iero
-      common /ierode/ iero
       common /ls0001/ tret, rowns(209),
      1   ccmax, el0, h, hmin, hmxi, hu, rc, tn, uround,
      2   illin, init, lyh, lewt, lacor, lsavr, lwm, liwm,
@@ -1184,7 +1184,7 @@ c not yet been done, an error return occurs.
 c if istate = 0 or 1 and tout = t, jump to block g and return
 c immediately.
 c-----------------------------------------------------------------------
-      iero=0
+      ierror=0
       if (istate .lt. 0 .or. istate .gt. 3) go to 601
       if (itask .lt. 1 .or. itask .gt. 5) go to 602
       if (istate .le. 1) go to 10
@@ -1338,7 +1338,7 @@ c lsodi must compute initial dy/dt (lyd0 points to yh(*,2)). -----------
             goto 565
          endif
  110     continue
-         if(iero.gt.0) return
+         if(ierror.gt.0) return
          do 115  i = 1, n
  115        rwork(i+lyh-1) = y(i)
          go to 130
@@ -1479,7 +1479,7 @@ c-----------------------------------------------------------------------
       call stodi (neq, y, rwork(lyh), nyh, rwork(lyh), rwork(lewt),
      1   ydoti, rwork(lsavr), rwork(lacor), rwork(lwm),
      2   iwork(liwm), res, adda, jac, prepji, solsy )
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       kgo = 1 - kflag
       go to (300, 530, 540, 400, 550), kgo
 c
@@ -1637,7 +1637,7 @@ c compute residual if relevant. ----------------------------------------
  585     y(i) = rwork( i+lyh-1 )
       ires = 1
       call res ( neq, tn, y, rwork(lsavr), ydoti, ires )
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nre = nre + 1
       if (ires .le. 1) go to 595
       call xerrwv('lsodi--  routine for evaluation od residue returns',
index 5357222..365a460 100644 (file)
@@ -2,6 +2,9 @@ C/MEMBR ADD NAME=PREPJ,SSI=0
       subroutine prepj (neq, y, yh, nyh, ewt, ftem, savf, wm, iwm,
      1   f, jac)
 clll. optimize
+
+      include 'stack.h'
+
       external f, jac
       integer neq, nyh, iwm
       integer iownd, iowns,
@@ -16,8 +19,6 @@ clll. optimize
      1   vnorm
       dimension neq(*), y(*), yh(nyh,*), ewt(*), ftem(*), savf(*),
      1   wm(*), iwm(*)
-      integer         iero
-      common /ierode/ iero
       common /ls0001/ rownd, rowns(209),
      2   ccmax, el0, h, hmin, hmxi, hu, rc, tn, uround,
      3   iownd(14), iowns(6),
@@ -71,7 +72,7 @@ c if miter = 1, call jac and multiply by scalar. -----------------------
       do 110 i = 1,lenp
  110    wm(i+2) = 0.0d+0
       call jac (neq, tn, y, 0, 0, wm(3), n)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       con = -hl0
       do 120 i = 1,lenp
  120    wm(i+2) = wm(i+2)*con
@@ -88,7 +89,7 @@ c if miter = 2, make n calls to f to approximate j. --------------------
         y(j) = y(j) + r
         fac = -hl0/r
         call f (neq, tn, y, ftem)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
         do 220 i = 1,n
  220      wm(i+j1) = (ftem(i) - savf(i))*fac
         y(j) = yj
@@ -110,7 +111,7 @@ c if miter = 3, construct a diagonal approximation to j and p. ---------
       do 310 i = 1,n
  310    y(i) = y(i) + r*(h*savf(i) - yh(i,2))
       call f (neq, tn, y, wm(3))
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nfe = nfe + 1
       do 320 i = 1,n
         r0 = h*savf(i) - yh(i,2)
@@ -136,7 +137,7 @@ cc fin
       do 410 i = 1,lenp
  410    wm(i+2) = 0.0d+0
       call jac (neq, tn, y, ml, mu, wm(ml3), meband)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       con = -hl0
       do 420 i = 1,lenp
  420    wm(i+2) = wm(i+2)*con
@@ -158,7 +159,7 @@ c if miter = 5, make mband calls to f to approximate j. ----------------
           r = max(srur*abs(yi),r0/ewt(i))
  530      y(i) = y(i) + r
         call f (neq, tn, y, ftem)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
         do 550 jj = j,n,mband
           y(jj) = yh(jj,1)
           yjj = y(jj)
index acfa0da..c7426cd 100644 (file)
@@ -2,6 +2,8 @@ C/MEMBR ADD NAME=PREPJI,SSI=0
       subroutine prepji (neq, y, yh, nyh, ewt, rtem, savr, s, wm, iwm,
      1   res, jac, adda)
 clll. optimize
+      include 'stack.h'
+      
       external res, jac, adda
       integer neq, nyh, iwm
       integer iownd, iowns,
@@ -20,8 +22,6 @@ clll. optimize
      3   iownd(14), iowns(6),
      4   icf, ierpj, iersl, jcur, jstart, kflag, l, meth, miter,
      5   maxord, maxcor, msbp, mxncf, n, nq, nst, nre, nje, nqu
-      integer         iero
-      common /ierode/ iero
 c-----------------------------------------------------------------------
 c%purpose
 c prepji is called by stodi to compute and process the matrix
@@ -69,14 +69,14 @@ c-----------------------------------------------------------------------
 c if miter = 1, call res, then jac, and multiply by scalar. ------------
  100  ires = 1
       call res (neq, tn, y, s, savr, ires)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nre = nre + 1
       if (ires .gt. 1) go to 600
       lenp = n*n
       do 110 i = 1,lenp
  110    wm(i+2) = 0.0d+0
       call jac ( neq, tn, y, s, 0, 0, wm(3), n )
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       con = -hl0
       do 120 i = 1,lenp
  120    wm(i+2) = wm(i+2)*con
@@ -85,7 +85,7 @@ c if miter = 2, make n + 1 calls to res to approximate j. --------------
  200  continue
       ires = -1
       call res (neq, tn, y, s, savr, ires)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nre = nre + 1
       if (ires .gt. 1) go to 600
       srur = wm(1)
@@ -96,7 +96,7 @@ c if miter = 2, make n + 1 calls to res to approximate j. --------------
         y(j) = y(j) + r
         fac = -hl0/r
         call res ( neq, tn, y, s, rtem, ires )
-        if(iero.gt.0) return
+        if(ierror.gt.0) return
         nre = nre + 1
         if (ires .gt. 1) go to 600
         do 220 i = 1,n
@@ -106,13 +106,13 @@ c if miter = 2, make n + 1 calls to res to approximate j. --------------
  230    continue
       ires = 1
       call res (neq, tn, y, s, savr, ires)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nre = nre + 1
       if (ires .gt. 1) go to 600
 c add matrix a. --------------------------------------------------------
  240  continue
       call adda(neq, tn, y, 0, 0, wm(3), n)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
 c do lu decomposition on p. --------------------------------------------
       call dgefa (wm(3), n, n, iwm(21), ier)
       if (ier .ne. 0) ierpj = 1
@@ -122,7 +122,7 @@ c dummy section for miter = 3
 c if miter = 4, call res, then jac, and multiply by scalar. ------------
  400  ires = 1
       call res (neq, tn, y, s, savr, ires)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nre = nre + 1
       if (ires .gt. 1) go to 600
       ml = iwm(1)
@@ -137,7 +137,7 @@ cc fin
       do 410 i = 1,lenp
  410    wm(i+2) = 0.0d+0
       call jac ( neq, tn, y, s, ml, mu, wm(ml3), meband)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       con = -hl0
       do 420 i = 1,lenp
  420    wm(i+2) = wm(i+2)*con
@@ -146,7 +146,7 @@ c if miter = 5, make ml + mu + 2 calls to res to approximate j. --------
  500  continue
       ires = -1
       call res (neq, tn, y, s, savr, ires)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nre = nre + 1
       if (ires .gt. 1) go to 600
       ml = iwm(1)
@@ -163,7 +163,7 @@ c if miter = 5, make ml + mu + 2 calls to res to approximate j. --------
           r = max(srur*abs(yi),0.010d+0/ewt(i))
  530      y(i) = y(i) + r
         call res ( neq, tn, y, s, rtem, ires)
-        if(iero.gt.0) return
+        if(ierror.gt.0) return
         nre = nre + 1
         if (ires .gt. 1) go to 600
         do 550 jj = j,n,mband
@@ -180,13 +180,13 @@ c if miter = 5, make ml + mu + 2 calls to res to approximate j. --------
  560    continue
       ires = 1
       call res (neq, tn, y, s, savr, ires)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nre = nre + 1
       if (ires .gt. 1) go to 600
 c add matrix a. --------------------------------------------------------
  570  continue
       call adda(neq, tn, y, ml, mu, wm(ml3), meband)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
 c do lu decomposition of p. --------------------------------------------
       call dgbfa (wm(3), meband, n, ml, mu, iwm(21), ier)
       if (ier .ne. 0) ierpj = 1
index 6cecbac..d9def4c 100644 (file)
@@ -2,6 +2,9 @@ C/MEMBR ADD NAME=PRJA,SSI=0
       subroutine prja (neq, y, yh, nyh, ewt, ftem, savf, wm, iwm,
      1   f, jac)
 clll. optimize
+      
+      include 'stack.h'
+      
       external f, jac
       integer neq, nyh, iwm
       integer iownd, iowns,
@@ -18,8 +21,6 @@ clll. optimize
      1   vmnorm, fnorm, bnorm
       dimension neq(*), y(*), yh(nyh,*), ewt(*), ftem(*), savf(*),
      1   wm(*), iwm(*)
-      integer         iero
-      common /ierode/ iero
       common /ls0001/ rownd, rowns(209),
      2   ccmax, el0, h, hmin, hmxi, hu, rc, tn, uround,
      3   iownd(14), iowns(6),
@@ -74,7 +75,7 @@ c if miter = 1, call jac and multiply by scalar. -----------------------
       do 110 i = 1,lenp
  110    wm(i+2) = 0.0d+0
       call jac (neq, tn, y, 0, 0, wm(3), n)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       con = -hl0
       do 120 i = 1,lenp
  120    wm(i+2) = wm(i+2)*con
@@ -91,7 +92,7 @@ c if miter = 2, make n calls to f to approximate j. --------------------
         y(j) = y(j) + r
         fac = -hl0/r
         call f (neq, tn, y, ftem)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
         do 220 i = 1,n
  220      wm(i+j1) = (ftem(i) - savf(i))*fac
         y(j) = yj
@@ -122,7 +123,7 @@ c if miter = 4, call jac and multiply by scalar. -----------------------
       do 410 i = 1,lenp
  410    wm(i+2) = 0.0d+0
       call jac (neq, tn, y, ml, mu, wm(ml3), meband)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       con = -hl0
       do 420 i = 1,lenp
  420    wm(i+2) = wm(i+2)*con
@@ -144,7 +145,7 @@ c if miter = 5, make mband calls to f to approximate j. ----------------
           r = max(srur*abs(yi),r0/ewt(i))
  530      y(i) = y(i) + r
         call f (neq, tn, y, ftem)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
         do 550 jj = j,n,mband
           y(jj) = yh(jj,1)
           yjj = y(jj)
index 6257230..c9d762f 100644 (file)
@@ -1,5 +1,7 @@
       subroutine rchek (job, g, neq, y, yh, nyh, g0, g1, gx, jroot, irt)
 clll. optimize
+      include 'stack.h'
+      
       external g
       integer job, neq, nyh, jroot, irt
       double precision y, yh, g0, g1, gx
@@ -21,8 +23,6 @@ clll. optimize
      5   maxord, maxcor, msbp, mxncf, n, nq, nst, nfe, nje, nqu
       common /lsr001/ rownr3(2), t0, tlast, toutc,
      1   iownd3(3), iownr3(2), irfnd, itaskc, ngc, nge      
-      integer         iero
-      common /ierode/ iero
 
 
 c!purpose
@@ -74,7 +74,7 @@ c evaluate g at initial t, and check for zero values. ------------------
  100  continue
       t0 = tn
       call g (neq, t0, y, ngc, g0)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nge = 1
       zroot = .false.
       do 110 i = 1,ngc
@@ -87,7 +87,7 @@ c g has a zero at t.  look at g at t + (small increment). --------------
       do 120 i = 1,n
  120    y(i) = y(i) + temp2*yh(i,2)
       call g (neq, t0, y, ngc, g0)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nge = nge + 1
       zroot = .false.
       do 130 i = 1,ngc
@@ -106,7 +106,7 @@ c
 c if a root was found on the previous step, evaluate g0 = g(t0). -------
       call intdy (t0, 0, yh, nyh, y, iflag)
       call g (neq, t0, y, ngc, g0)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nge = nge + 1
       zroot = .false.
       do 210 i = 1,ngc
@@ -126,7 +126,7 @@ c g has a zero at t0.  look at g at t + (small increment). -------------
       go to 240
  230  call intdy (t0, 0, yh, nyh, y, iflag)
  240  call g (neq, t0, y, ngc, g0)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nge = nge + 1
       zroot = .false.
       do 250 i = 1,ngc
@@ -157,7 +157,7 @@ c set t1 to tn or toutc, whichever comes first, and get g at t1. -------
       do 320 i = 1,n
  320    y(i) = yh(i,1)
  330  call g (neq, t1, y, ngc, g1)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nge = nge + 1
 c call roots to search for root in interval from t0 to t1. -------------
       jflag = 0
@@ -166,7 +166,7 @@ c call roots to search for root in interval from t0 to t1. -------------
       if (jflag .gt. 1) go to 360
       call intdy (x, 0, yh, nyh, y, iflag)
       call g (neq, x, y, ngc, gx)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nge = nge + 1
       go to 350
  360  t0 = x
index cc60939..6503232 100644 (file)
@@ -1,6 +1,8 @@
       subroutine rchek2(job, g, neq, y, yh, nyh, g0, g1, gx, jroot, irt
      $     ,IWORK)
 clll. optimize
+      include 'stack.h'
+      
       external g
       integer job, neq, nyh, jroot, irt
       double precision y, yh, g0, g1, gx
@@ -22,8 +24,6 @@ clll. optimize
      5   maxord, maxcor, msbp, mxncf, n, nq, nst, nfe, nje, nqu
       common /lsr001/ rownr3(2), t0, tlast, toutc,
      1   iownd3(3), iownr3(2), irfnd, itaskc, ngc, nge      
-      integer         iero
-      common /ierode/ iero
 c     ------------------ masking ----------------
       integer IWORK
       dimension IWORK(*)
@@ -134,7 +134,7 @@ c set t1 to tn or toutc, whichever comes first, and get g at t1. -------
       do 320 i = 1,n
  320    y(i) = yh(i,1)
  330  call g (neq, t1, y, ngc, g1)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nge = nge + 1
 
 C     Call DROOTS to search for root in interval from T0 to T1. -----------
@@ -149,7 +149,7 @@ C     Call DROOTS to search for root in interval from T0 to T1. -----------
       IF (JFLAG .GT. 1) GO TO 360
       call intdy (x, 0, yh, nyh, y, iflag)
       call g (neq, x, y, ngc, gx)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nge = nge + 1
       GO TO 350
       
index 417a063..b93e52d 100644 (file)
@@ -180,10 +180,11 @@ c    required for subsequent integration. accordingly, work and iwork
 c    should not be altered.
 c
 c
+      include 'stack.h'
+      
       integer neqn,iflag,iwork(5)
       double precision y(neqn),t,tout,rerr,aerr,work(1)
 c
-      common/ierode/iero
       external fydot
 c
       integer k1,k2,k3,k4,k5,k6,k1m
@@ -232,13 +233,13 @@ c         h  - an appropriate stepsize to be used for the next step
 c         nfe- counter on the number of derivative function evaluations
 c
 c
+      
       logical hfaild,output
 c
       integer  neqn,iflag,nfe,kop,init,jflag,kflag
       double precision  y(neqn),t,tout,rerr,aerr,h,yp(neqn),
      1  f1(neqn),f2(neqn),f3(neqn),f4(neqn),f5(neqn),savre,
      2  savae,savey(*)
-      common/ierode/iero
 c
       external fydot
 c
@@ -359,7 +360,7 @@ c
 c
       a=t
       call fydot(neqn,a,y,yp)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nfe=1
       if (t .ne. tout) go to 65
       iflag=2
@@ -404,7 +405,7 @@ c
    90   y(k)=y(k)+dt*yp(k)
       a=tout
       call fydot(neqn,a,y,yp)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nfe=nfe+1
       go to 300
 c
@@ -539,7 +540,7 @@ c
   270   y(k)=f1(k)
       a=t
       call fydot(neqn,a,y,yp)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nfe=nfe+1
 c
 c
@@ -599,43 +600,45 @@ c
       double precision  y(neqn),t,h,yp(neqn),f1(neqn),f2(neqn),
      1  f3(neqn),f4(neqn),f5(neqn),s(neqn),savey(neqn)
 c
+      
+      include 'stack.h'
+      
       double precision  ch
       integer  k
       external fydot
-      common/ierode/iero
 c
       ch=h/4.0d0
       do 221 k=1,neqn
   221   y(k)=savey(k)+ch*yp(k)
       call fydot(neqn,t+ch,y,f1)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
 c
       ch=3.0d0*h/32.0d0
       do 222 k=1,neqn
   222   y(k)=savey(k)+ch*(yp(k)+3.0d0*f1(k))
       call fydot(neqn,t+3.0d0*h/8.0d0,y,f2)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
 c
       ch=h/2197.0d0
       do 223 k=1,neqn
   223 y(k)=savey(k)+ch*(1932.0d0*yp(k)+
      1    (7296.0d0*f2(k)-7200.0d0*f1(k)))
       call fydot(neqn,t+12.0d0*h/13.0d0,y,f3)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
 c
       ch=h/4104.0d0
       do 224 k=1,neqn
   224   y(k)=savey(k)+ch*((8341.0d0*yp(k)-845.0d0*f3(k))+
      1                            (29440.0d0*f2(k)-32832.0d0*f1(k)))
       call fydot(neqn,t+h,y,f4)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
 c
       ch=h/20520.0d0
       do 225 k=1,neqn
   225   y(k)=savey(k)+ch*((-6080.0d0*yp(k)+(9295.0d0*f3(k)-
      1         5643.0d0*f4(k)))+(41040.0d0*f1(k)-28352.0d0*f2(k)))
       call fydot(neqn,t+h/2.0d0,y,f5)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
 c
 c     compute approximate solution at t+h
 c
index 1bd5847..ab4bf56 100644 (file)
@@ -4,15 +4,16 @@ c
 c     fehlberg fourth-fifth order runge-kutta method
 c
 c
+      include 'stack.h'
+      
       integer neqn,iflag,iwork(*)
       double precision y(*),t,tout,rerr,aerr,work(*),h
 c
       double precision ae,scale,eeoet,et,esttol,ee
-      common/ierode/iero
       external fydot2
 c
       integer k1,k2,k3,k4,k5,k6
-      iero=0
+      ierror=0
 c
 c     compute indices for the splitting of the work array
 c
@@ -76,45 +77,46 @@ c
       double precision  y(*),t,h,yp(neqn),f1(neqn),f2(neqn),
      1  f3(neqn),f4(neqn),f5(neqn),s(neqn)
 c
+      include 'stack.h'      
+      
       double precision  ch
       integer  k
       external fydot2
-      common/ierode/iero
 c
 c      write(6,*) 'inputfelh2:',y(1),y(2)
       call fydot2(neqn,t,y,yp)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       ch=h/4.0d0
       do 221 k=1,neqn
   221   y(k)=y(k)+ch*yp(k)
       call fydot2(neqn,t+ch,y,f1)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
 c
       ch=3.0d0*h/32.0d0
       do 222 k=1,neqn
   222   y(k)=s(k)+ch*(yp(k)+3.0d0*f1(k))
       call fydot2(neqn,t+3.0d0*h/8.0d0,y,f2)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
 c
       ch=h/2197.0d0
       do 223 k=1,neqn
   223   y(k)=s(k)+ch*(1932.0d0*yp(k)+(7296.0d0*f2(k)-7200.0d0*f1(k)))
       call fydot2(neqn,t+12.0d0*h/13.0d0,y,f3)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
 c
       ch=h/4104.0d0
       do 224 k=1,neqn
   224   y(k)=s(k)+ch*((8341.0d0*yp(k)-845.0d0*f3(k))+
      1                            (29440.0d0*f2(k)-32832.0d0*f1(k)))
       call fydot2(neqn,t+h,y,f4)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
 c
       ch=h/20520.0d0
       do 225 k=1,neqn
   225   y(k)=s(k)+ch*((-6080.0d0*yp(k)+(9295.0d0*f3(k)-
      1         5643.0d0*f4(k)))+(41040.0d0*f1(k)-28352.0d0*f2(k)))
       call fydot2(neqn,t+h/2.0d0,y,f5)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
 c
 c     compute approximate solution at t+h
 c
index 7f91f5c..5dd70eb 100644 (file)
@@ -2,6 +2,8 @@ C/MEMBR ADD NAME=STODA,SSI=0
       subroutine stoda (neq, y, yh, nyh, yh1, ewt, savf, acor,
      1   wm, iwm, f, jac, pjac, slvs)
 clll. optimize
+      
+      include 'stack.h'
       external f, jac, pjac, slvs
       integer neq, nyh, iwm
       integer iownd, ialth, ipup, lmax, meo, nqnyh, nslp,
@@ -23,8 +25,6 @@ clll. optimize
       dimension neq(*), y(*), yh(nyh,*), yh1(*), ewt(*), savf(*),
      1   acor(*), wm(*), iwm(*)
       dimension sm1(12)
-      integer         iero
-      common /ierode/ iero
       common /ls0001/ rownd, conit, crate, el(13), elco(13,12),
      1   hold, rmax, tesco(3,12),
      2   ccmax, el0, h, hmin, hmxi, hu, rc, tn, uround, iownd(14),
@@ -259,10 +259,10 @@ c-----------------------------------------------------------------------
       do 230 i = 1,n
  230    y(i) = yh(i,1)
       call f (neq, tn, y, savf)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nfe = nfe + 1
       if (tn.gt.64.7) then
-         iero=0
+         ierror=0
       endif
       if (ipup .le. 0) go to 250
 c-----------------------------------------------------------------------
@@ -275,7 +275,7 @@ c-----------------------------------------------------------------------
       nslp = nst
       crate = 0.70d+0
       call pjac (neq, y, yh, nyh, ewt, acor, savf, wm, iwm, f, jac)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       if (ierpj .ne. 0) go to 430
  250  do 260 i = 1,n
  260    acor(i) = 0.0d+0
@@ -337,7 +337,7 @@ c-----------------------------------------------------------------------
       if (m .ge. 2 .and. del .gt. 2.0d+0*delp) go to 410
       delp = del
       call f (neq, tn, y, savf)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nfe = nfe + 1
       go to 270
 c-----------------------------------------------------------------------
@@ -611,7 +611,7 @@ c-----------------------------------------------------------------------
       do 645 i = 1,n
  645    y(i) = yh(i,1)
       call f (neq, tn, y, savf)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nfe = nfe + 1
       do 650 i = 1,n
  650    yh(i,2) = h*savf(i)
index 41ccd8b..b795170 100644 (file)
@@ -2,6 +2,9 @@ C/MEMBR ADD NAME=STODE,SSI=0
       subroutine stode (neq, y, yh, nyh, yh1, ewt, savf, acor,
      1   wm, iwm, f, jac, pjac, slvs)
 clll. optimize
+      
+      include 'stack.h'
+      
       external f, jac, pjac, slvs
       integer neq, nyh, iwm
       integer iownd, ialth, ipup, lmax, meo, nqnyh, nslp,
@@ -16,8 +19,6 @@ clll. optimize
      1   r, rh, rhdn, rhsm, rhup, told, vnorm
       dimension neq(*), y(*), yh(nyh,*), yh1(*), ewt(*), savf(*),
      1   acor(*), wm(*), iwm(*)
-      integer         iero
-      common /ierode/ iero
       common /ls0001/ rownd, conit, crate, el(13), elco(13,12),
      1   hold, rmax, tesco(3,12),
      2   ccmax, el0, h, hmin, hmxi, hu, rc, tn, uround, iownd(14),
@@ -236,7 +237,7 @@ c-----------------------------------------------------------------------
       do 230 i = 1,n
  230    y(i) = yh(i,1)
       call f (neq, tn, y, savf)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nfe = nfe + 1
       if (ipup .le. 0) go to 250
 c-----------------------------------------------------------------------
@@ -249,7 +250,7 @@ c-----------------------------------------------------------------------
       nslp = nst
       crate = 0.70d+0
       call pjac (neq, y, yh, nyh, ewt, acor, savf, wm, iwm, f, jac)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       if (ierpj .ne. 0) go to 430
  250  do 260 i = 1,n
  260    acor(i) = 0.0d+0
@@ -292,7 +293,7 @@ c-----------------------------------------------------------------------
       if (m .ge. 2 .and. del .gt. 2.0d+0*delp) go to 410
       delp = del
       call f (neq, tn, y, savf)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nfe = nfe + 1
       go to 270
 c-----------------------------------------------------------------------
@@ -450,7 +451,7 @@ c-----------------------------------------------------------------------
       do 645 i = 1,n
  645    y(i) = yh(i,1)
       call f (neq, tn, y, savf)
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nfe = nfe + 1
       do 650 i = 1,n
  650    yh(i,2) = h*savf(i)
index 11d551a..a661202 100644 (file)
@@ -23,8 +23,6 @@ clll. optimize
      3   ialth, ipup, lmax, meo, nqnyh, nslp,
      4   icf, ierpj, iersl, jcur, jstart, kflag, l, meth, miter,
      5   maxord, maxcor, msbp, mxncf, n, nq, nst, nre, nje, nqu
-      integer         iero
-      common /ierode/ iero
 c-----------------------------------------------------------------------
 c%purpose
 c stodi performs one step of the integration of an initial value
@@ -255,14 +253,14 @@ c-----------------------------------------------------------------------
       crate = 0.70d+0
       call pjac (neq, y, yh, nyh, ewt, acor, savr, savf, wm, iwm,
      1   res, jac, adda )
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       if (ierpj .eq. 0) go to 250
       ires = ierpj
       go to (430, 435, 430), ires
 c get residual at predicted values, if not already done in pjac. -------
  240  ires = 1
       call res ( neq, tn, y, savf, savr, ires )
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nre = nre + 1
       kgo = abs(ires)
       go to ( 250, 435, 430 ) , kgo
@@ -295,7 +293,7 @@ c-----------------------------------------------------------------------
       delp = del
       ires = 1
       call res ( neq, tn, y, savf, savr, ires )
-      if(iero.gt.0) return
+      if(ierror.gt.0) return
       nre = nre + 1
       kgo = abs(ires)
       go to ( 270, 435, 410 ) , kgo
index 2e24c35..9f8f03a 100644 (file)
@@ -59,8 +59,6 @@ c-----------------------------------------------------------------------
       include 'stack.h'
       integer num, imess, imode
       common /eh0001/ mesflg, lunit
-      integer         iero
-      common /ierode/ iero
       character*80 str
 c-----------------------------------------------------------------------
       if (mesflg .eq. 0) go to 100
@@ -111,5 +109,5 @@ cstd         write (lun, 50) r1,r2
       endif
 c abort the run if iert = 2. -------------------------------------------
  100  if (iert .ne. 2) return
-      iero = 1
+      ierror = 1
       end
index 0e4967a..d540f3d 100644 (file)
@@ -47,7 +47,6 @@ C
       integer mlhs,mrhs
       logical allowptr
 C
-      common /ierode/ iero
       common /scsptr/ ptr
 C
       if (ddt .eq. 4) then
@@ -59,7 +58,7 @@ c    &       buf(5:8)      )
 C
       mlhs = 5
       mrhs = 8
-      iero = 0
+      ierror = 0
       call itosci(flag,1,1)
       if (err .gt. 0) goto 9999
       call itosci(nevprt,1,1)
@@ -140,8 +139,8 @@ C+
       return
 C     
  9999 continue
-      iero = -1
-      flag=iero
+      ierror = -1
+      flag=ierror
       niv = niv - 1
       return
       end