diff libcruft/arpack/src/ssconv.f @ 12274:9f5d2ef078e8 release-3-4-x

import ARPACK sources to libcruft from Debian package libarpack2 2.1+parpack96.dfsg-3+b1
author John W. Eaton <jwe@octave.org>
date Fri, 28 Jan 2011 14:04:33 -0500
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/libcruft/arpack/src/ssconv.f	Fri Jan 28 14:04:33 2011 -0500
@@ -0,0 +1,138 @@
+c-----------------------------------------------------------------------
+c\BeginDoc
+c
+c\Name: ssconv
+c
+c\Description: 
+c  Convergence testing for the symmetric Arnoldi eigenvalue routine.
+c
+c\Usage:
+c  call ssconv
+c     ( N, RITZ, BOUNDS, TOL, NCONV )
+c
+c\Arguments
+c  N       Integer.  (INPUT)
+c          Number of Ritz values to check for convergence.
+c
+c  RITZ    Real array of length N.  (INPUT)
+c          The Ritz values to be checked for convergence.
+c
+c  BOUNDS  Real array of length N.  (INPUT)
+c          Ritz estimates associated with the Ritz values in RITZ.
+c
+c  TOL     Real scalar.  (INPUT)
+c          Desired relative accuracy for a Ritz value to be considered
+c          "converged".
+c
+c  NCONV   Integer scalar.  (OUTPUT)
+c          Number of "converged" Ritz values.
+c
+c\EndDoc
+c
+c-----------------------------------------------------------------------
+c
+c\BeginLib
+c
+c\Routines called:
+c     arscnd  ARPACK utility routine for timing.
+c     slamch  LAPACK routine that determines machine constants. 
+c
+c\Author
+c     Danny Sorensen               Phuong Vu
+c     Richard Lehoucq              CRPC / Rice University 
+c     Dept. of Computational &     Houston, Texas 
+c     Applied Mathematics
+c     Rice University           
+c     Houston, Texas            
+c
+c\SCCS Information: @(#) 
+c FILE: sconv.F   SID: 2.4   DATE OF SID: 4/19/96   RELEASE: 2
+c
+c\Remarks
+c     1. Starting with version 2.4, this routine no longer uses the
+c        Parlett strategy using the gap conditions. 
+c
+c\EndLib
+c
+c-----------------------------------------------------------------------
+c
+      subroutine ssconv (n, ritz, bounds, tol, nconv)
+c
+c     %----------------------------------------------------%
+c     | Include files for debugging and timing information |
+c     %----------------------------------------------------%
+c
+      include   'debug.h'
+      include   'stat.h'
+c
+c     %------------------%
+c     | Scalar Arguments |
+c     %------------------%
+c
+      integer    n, nconv
+      Real
+     &           tol
+c
+c     %-----------------%
+c     | Array Arguments |
+c     %-----------------%
+c
+      Real
+     &           ritz(n), bounds(n)
+c
+c     %---------------%
+c     | Local Scalars |
+c     %---------------%
+c
+      integer    i
+      Real
+     &           temp, eps23
+c
+c     %-------------------%
+c     | External routines |
+c     %-------------------%
+c
+      Real
+     &           slamch
+      external   slamch
+
+c     %---------------------%
+c     | Intrinsic Functions |
+c     %---------------------%
+c
+      intrinsic    abs
+c
+c     %-----------------------%
+c     | Executable Statements |
+c     %-----------------------%
+c
+      call arscnd (t0)
+c
+      eps23 = slamch('Epsilon-Machine') 
+      eps23 = eps23**(2.0E+0 / 3.0E+0)
+c
+      nconv  = 0
+      do 10 i = 1, n
+c
+c        %-----------------------------------------------------%
+c        | The i-th Ritz value is considered "converged"       |
+c        | when: bounds(i) .le. TOL*max(eps23, abs(ritz(i)))   |
+c        %-----------------------------------------------------%
+c
+         temp = max( eps23, abs(ritz(i)) )
+         if ( bounds(i) .le. tol*temp ) then
+            nconv = nconv + 1
+         end if
+c
+   10 continue
+c 
+      call arscnd (t1)
+      tsconv = tsconv + (t1 - t0)
+c 
+      return
+c
+c     %---------------%
+c     | End of ssconv |
+c     %---------------%
+c
+      end