changeset 12197:9ed4018d538c

avoid memory overrun in ARPACK
author David Bateman <dbateman@free.fr>
date Fri, 28 Jan 2011 14:05:34 -0500
parents 0564f4a755a0
children 30ca5a0b0e2f
files libcruft/ChangeLog libcruft/arpack/src/cneupd.f libcruft/arpack/src/dneupd.f libcruft/arpack/src/sneupd.f libcruft/arpack/src/zneupd.f
diffstat 5 files changed, 33 insertions(+), 8 deletions(-) [+]
line wrap: on
line diff
--- a/libcruft/ChangeLog
+++ b/libcruft/ChangeLog
@@ -1,3 +1,11 @@
+2011-01-28  David Bateman  <dbateman@free.fr>
+
+	* arpack/src/cneupd.f (cneupd): Restore value of nconv if ctrsen
+	returns a smaller value.
+	* arpack/src/dneupd.f (dneupd): Likewise, for dtrsen.
+	* arpack/src/sneupd.f (sneupd): Likewise, for strsen.
+	* arpack/src/zneupd.f (zneupd): Likewise, for ztrsen.
+
 2011-01-28  John W. Eaton  <jwe@octave.org>
 
 	* arpack/util/second.f (ARSCND): Declare ETIME INTRINSIC, not EXTERNAL.
--- a/libcruft/arpack/src/cneupd.f
+++ b/libcruft/arpack/src/cneupd.f
@@ -301,7 +301,7 @@
      &           invsub, iuptri, iwev  , j    , ldh   , ldq   ,
      &           mode  , msglvl, ritz  , wr   , k     , irz   ,
      &           ibd   , outncv, iq    , np   , numcnv, jj    ,
-     &           ishift
+     &           ishift, nconv2
       Complex 
      &           rnorm, temp, vl(1)
       Real 
@@ -592,9 +592,13 @@
             call ctrsen('None'       , 'V'          , select      ,
      &                   ncv          , workl(iuptri), ldh         ,
      &                   workl(invsub), ldq          , workl(iheig),
-     &                   nconv        , conds        , sep         , 
+     &                   nconv2       , conds        , sep         , 
      &                   workev       , ncv          , ierr)
 c
+            if (nconv2 .lt. nconv) then
+               nconv = nconv2
+            end if
+
             if (ierr .eq. 1) then
                info = 1
                go to 9000
--- a/libcruft/arpack/src/dneupd.f
+++ b/libcruft/arpack/src/dneupd.f
@@ -353,7 +353,7 @@
      &           mode  , msglvl, outncv, ritzr   ,
      &           ritzi , wri   , wrr   , irr     ,
      &           iri   , ibd   , ishift, numcnv  ,
-     &           np    , jj 
+     &           np    , jj    , nconv2
       logical    reord
       Double precision 
      &           conds  , rnorm, sep  , temp,
@@ -661,16 +661,21 @@
      &                   workl(iuptri), ldh          , 
      &                   workl(invsub), ldq          , 
      &                   workl(iheigr), workl(iheigi), 
-     &                   nconv        , conds        ,
+     &                   nconv2       , conds        ,
      &                   sep          , workl(ihbds) , 
      &                   ncv          , iwork        ,
      &                   1            , ierr)
 c
+            if (nconv2 .lt. nconv) then
+               nconv = nconv2
+            end if
+
             if (ierr .eq. 1) then
                info = 1
                go to 9000
             end if
 c
+
             if (msglvl .gt. 2) then
                 call dvout (logfil, ncv, workl(iheigr), ndigit,
      &           '_neupd: Real part of the eigenvalues of H--reordered')
--- a/libcruft/arpack/src/sneupd.f
+++ b/libcruft/arpack/src/sneupd.f
@@ -353,7 +353,7 @@
      &           mode  , msglvl, outncv, ritzr   ,
      &           ritzi , wri   , wrr   , irr     ,
      &           iri   , ibd   , ishift, numcnv  ,
-     &           np    , jj 
+     &           np    , jj    , nconv2
       logical    reord
       Real 
      &           conds  , rnorm, sep  , temp,
@@ -661,11 +661,15 @@
      &                   workl(iuptri), ldh          , 
      &                   workl(invsub), ldq          , 
      &                   workl(iheigr), workl(iheigi), 
-     &                   nconv        , conds        ,
+     &                   nconv2       , conds        ,
      &                   sep          , workl(ihbds) , 
      &                   ncv          , iwork        ,
      &                   1            , ierr)
 c
+            if (nconv2 .lt. nconv) then
+               nconv = nconv2
+            end if
+
             if (ierr .eq. 1) then
                info = 1
                go to 9000
--- a/libcruft/arpack/src/zneupd.f
+++ b/libcruft/arpack/src/zneupd.f
@@ -301,7 +301,7 @@
      &           invsub, iuptri, iwev  , j    , ldh   , ldq   ,
      &           mode  , msglvl, ritz  , wr   , k     , irz   ,
      &           ibd   , outncv, iq    , np   , numcnv, jj    ,
-     &           ishift
+     &           ishift, nconv2
       Complex*16 
      &           rnorm, temp, vl(1)
       Double precision 
@@ -592,9 +592,13 @@
             call ztrsen ('None'       , 'V'          , select      ,
      &                   ncv          , workl(iuptri), ldh         ,
      &                   workl(invsub), ldq          , workl(iheig),
-     &                   nconv        , conds        , sep         , 
+     &                   nconv2       , conds        , sep         , 
      &                   workev       , ncv          , ierr)
 c
+            if (nconv2 .lt. nconv) then
+               nconv = nconv2
+            end if
+
             if (ierr .eq. 1) then
                info = 1
                go to 9000