Skip to content

Instantly share code, notes, and snippets.

@mgadda

mgadda/arpack_patch

Created November 21, 2010 03:38
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save mgadda/708424 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save mgadda/708424 to your computer and use it in GitHub Desktop.
Download ZIP
ARPACK Patch in the form of a diff
Raw
arpack_patch
diff --git a/EXAMPLES/BAND/cnband.f b/EXAMPLES/BAND/cnband.f
index ccecda5..7112fef 100644
--- a/EXAMPLES/BAND/cnband.f
+++ b/EXAMPLES/BAND/cnband.f
@@ -42,7 +42,7 @@ c
c \Usage
c call cnband
c ( RVEC, HOWMNY, SELECT, D , Z, LDZ, SIGMA, WORKEV, N, AB,
-c MB, LDA, FAC, KL, LU, WHICH, BMAT, NEV, TOL, RESID, NCV,
+c MB, LDA, FAC, KL, KU, WHICH, BMAT, NEV, TOL, RESID, NCV,
c V, LDV, IPARAM, WORKD, WORKL, LWORKL, RWORK, IWORK, INFO )
c
c \Arguments
@@ -71,11 +71,11 @@ c Ritz value D(j), SELECT(j) must be set to .TRUE..
c If HOWMNY = 'A' or 'P', SELECT need not be initialized
c but it is used as internal workspace.
c
-c D Complex array of dimension NEV+1. (OUTPUT)
+c D Complex array of dimension NEV+1. (OUTPUT)
c On exit, D contains the Ritz approximations
c to the eigenvalues lambda for A*z = lambda*B*z.
c
-c Z Complex N by NEV array (OUTPUT)
+c Z Complex N by NEV array (OUTPUT)
c On exit, if RVEC = .TRUE. and HOWMNY = 'A', then the columns of
c Z represents approximate eigenvectors (Ritz vectors) corresponding
c to the NCONV=IPARAM(5) Ritz values for eigensystem
@@ -92,23 +92,23 @@ c The leading dimension of the array Z. If Ritz vectors are
c desired, then LDZ .ge. max( 1, N ) is required.
c In any case, LDZ .ge. 1 is required.
c
-c SIGMA Complex (INPUT)
+c SIGMA Complex (INPUT)
c If IPARAM(7) = 3 then SIGMA represents the shift.
c Not referenced if IPARAM(7) = 1 or 2.
c
-c WORKEV Complex work array of dimension NCV. (WORKSPACE)
+c WORKEV Complex work array of dimension NCV. (WORKSPACE)
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
-c AB Complex array of dimension LDA by N. (INPUT)
+c AB Complex array of dimension LDA by N. (INPUT)
c The matrix A in band storage, in rows KL+1 to
c 2*KL+KU+1; rows 1 to KL of the array need not be set.
c The j-th column of A is stored in the j-th column of the
c array AB as follows:
c AB(kl+ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
c
-c MB Complex array of dimension LDA by N. (INPUT)
+c MB Complex array of dimension LDA by N. (INPUT)
c The matrix M in band storage, in rows KL+1 to
c 2*KL+KU+1; rows 1 to KL of the array need not be set.
c The j-th column of M is stored in the j-th column of the
@@ -119,7 +119,7 @@ c
c LDA Integer. (INPUT)
c Leading dimension of AB, MB, FAC.
c
-c FAC Complex array of LDA by N. (WORKSPACE/OUTPUT)
+c FAC Complex array of LDA by N. (WORKSPACE/OUTPUT)
c FAC is used to store the LU factors of MB when mode 2
c is invoked. It is used to store the LU factors of
c (A-sigma*M) when mode 3 is invoked.
@@ -153,14 +153,14 @@ c BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*M*x
c NEV Integer. (INPUT)
c Number of eigenvalues of to be computed.
c
-c TOL Real scalar. (INPUT)
+c TOL Real scalar. (INPUT)
c Stopping criteria: the relative accuracy of the Ritz value
c is considered acceptable if BOUNDS(I) .LE. TOL*ABS(RITZ(I))
c where ABS(RITZ(I)) is the magnitude when RITZ(I) is complex.
c DEFAULT = slamch('EPS') (machine precision as computed
c by the LAPACK auxilliary subroutine slamch).
c
-c RESID Complex array of length N. (INPUT/OUTPUT)
+c RESID Complex array of length N. (INPUT/OUTPUT)
c On INPUT:
c If INFO .EQ. 0, a random initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
@@ -178,7 +178,7 @@ c approximately NCV-NEV Arnoldi vectors at each subsequent update
c iteration. Most of the cost in generating each Arnoldi vector is
c in the matrix-vector operation OP*x.
c
-c V Complex array N by NCV. (OUTPUT)
+c V Complex array N by NCV. (OUTPUT)
c Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns
c contain approximate Schur vectors that span the
c desired invariant subspace.
@@ -190,7 +190,7 @@ c of the eigensystem A*z = lambda*B*z.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
-c program.
+c program. LDV must be great than or equal to N.
c
c IPARAM Integer array of length 11. (INPUT/OUTPUT)
c IPARAM(1) = ISHIFT:
@@ -226,14 +226,14 @@ c On INPUT determines what type of eigenproblem is being solved.
c Must be 1,2 or 3; See under \Description of cnband for the
c three modes available.
c
-c WORKD Complex work array of length at least 3*n. (WORKSPACE)
+c WORKD Complex work array of length at least 3*n. (WORKSPACE)
c
-c WORKL Complex work array of length LWORKL. (WORKSPACE)
+c WORKL Complex work array of length LWORKL. (WORKSPACE)
c
c LWORKL Integer. (INPUT)
c LWORKL must be at least 3*NCV**2 + 5*NCV.
c
-c RWORK Real array of length N (WORKSPACE)
+c RWORK Real array of length N (WORKSPACE)
c Workspace used in cnaupd.
c
c IWORK Integer array of dimension at least N. (WORKSPACE)
@@ -293,7 +293,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: nband.F SID: 2.1 DATE OF SID: 11/21/95 RELEASE: 2
+c FILE: nband.F SID: 2.3 DATE OF SID: 10/17/00 RELEASE: 2
c
c\EndLib
c
@@ -312,9 +312,9 @@ c
Logical rvec
Integer n, lda, kl, ku, nev, ncv, ldv,
& ldz, lworkl, info
- Complex
+ Complex
& sigma
- Real
+ Real
& tol
c
c %-----------------%
@@ -323,11 +323,11 @@ c %-----------------%
c
Integer iparam(*), iwork(*)
Logical select(*)
- Complex
+ Complex
& d(*), resid(*), v(ldv,*), z(ldz,*),
& ab(lda,*), mb(lda,*), fac(lda,*),
& workd(*), workl(*), workev(*)
- Real
+ Real
& rwork(*)
c
c %--------------%
@@ -346,16 +346,16 @@ c %------------%
c | Parameters |
c %------------%
c
- Complex
+ Complex
& one, zero
- parameter (one = (1.0, 0.0), zero = (0.0, 0.0))
-c
+ parameter (one = (1.0E+0, 0.0E+0) ,
+ & zero = (0.0E+0, 0.0E+0) )
c
c %-----------------------------%
c | LAPACK & BLAS routines used |
c %-----------------------------%
c
- Real
+ Real
& scnrm2
external ccopy, cgbmv, cgbtrf, cgbtrs, scnrm2, clacpy
c
diff --git a/EXAMPLES/BAND/cnbdr1.f b/EXAMPLES/BAND/cnbdr1.f
index b9222b2..b0c593d 100644
--- a/EXAMPLES/BAND/cnbdr1.f
+++ b/EXAMPLES/BAND/cnbdr1.f
@@ -32,8 +32,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: nbdr1.F SID: 2.3 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
@@ -64,12 +64,12 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Complex
+ Complex
& a(lda,maxn), m(lda,maxn), fac(lda,maxn),
& workl(3*maxncv*maxncv+5*maxncv), workd(3*maxn),
& workev(2*maxncv), v(ldv, maxncv),
& resid(maxn), d(maxncv), ax(maxn)
- Real
+ Real
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
@@ -81,28 +81,28 @@ c
& n, nx, lo, isub, isup, idiag, maxitr, mode,
& nconv
logical rvec
- Real
+ Real
& tol
- Complex
+ Complex
& rho, h, h2, sigma
c
c %------------%
c | Parameters |
c %------------%
c
- Complex
+ Complex
& one, zero, two
- parameter ( one = (1.0E+0, 0.0E+0),
- & zero = (0.0E+0, 0.0E+0),
- & two = (2.0E+0, 0.0E+0) )
+ parameter ( one = (1.0E+0, 0.0E+0) ,
+ & zero = (0.0E+0, 0.0E+0) ,
+ & two = (2.0E+0, 0.0E+0) )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Real
+ Real
& scnrm2, slapy2
- external scnrm2, cgbmv, caxpy, slapy2
+ external scnrm2, cgbmv, caxpy, slapy2, claset
c
c %-----------------------%
c | Executable Statements |
@@ -176,6 +176,14 @@ c | Construct the matrix A in LAPACK-style |
c | banded form. |
c %----------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call claset('A', lda, n, zero, zero, a, lda)
+ call claset('A', lda, n, zero, zero, m, lda)
+ call claset('A', lda, n, zero, zero, fac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -184,9 +192,6 @@ c %-------------------------------------%
c
kl = nx
ku = nx
- call claset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call claset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call claset('A', 2*kl+ku+1, n, zero, zero, fac, lda)
c
c %---------------%
c | Main diagonal |
@@ -197,14 +202,14 @@ c
c
idiag = kl+ku+1
do 30 j = 1, n
- a(idiag,j) = (4.0E+0, 0.0E+0) / h2
+ a(idiag,j) = (4.0E+0, 0.0E+0) / h2
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
- rho = (1.0E+2, 0.0E+0)
+ rho = (1.0E+2, 0.0E+0)
isup = kl+ku
isub = kl+ku+2
do 50 i = 1, nx
@@ -285,7 +290,7 @@ c
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
call caxpy(n, -d(j), v(1,j), 1, ax, 1)
- rd(j,1) = real(d(j))
+ rd(j,1) = real (d(j))
rd(j,2) = aimag(d(j))
rd(j,3) = scnrm2(n, ax, 1)
rd(j,3) = rd(j,3) / slapy2(rd(j,1),rd(j,2))
diff --git a/EXAMPLES/BAND/cnbdr2.f b/EXAMPLES/BAND/cnbdr2.f
index 027025a..a1a478f 100644
--- a/EXAMPLES/BAND/cnbdr2.f
+++ b/EXAMPLES/BAND/cnbdr2.f
@@ -32,8 +32,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: nbdr2.F SID: 2.4 DATE OF SID: 10/20/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -64,12 +64,12 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Complex
+ Complex
& a(lda,maxn), m(lda,maxn), fac(lda,maxn),
& workl(3*maxncv*maxncv+5*maxncv), workd(3*maxn),
& workev(2*maxncv), v(ldv, maxncv),
& resid(maxn), d(maxncv), ax(maxn)
- Real
+ Real
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
@@ -81,27 +81,28 @@ c
& n, nxi, lo, isub, isup, idiag, maxitr, mode,
& nconv
logical rvec
- Real
+ Real
& tol
- Complex
+ Complex
& rho, h, h2, sigma
c
c %------------%
c | Parameters |
c %------------%
c
- Complex
+ Complex
& one, zero, two
- parameter (one = (1.0E+0, 0.0E+0), zero = (0.0E+0, 0.0E+0),
- & two = (2.0E+0, 0.0E+0))
+ parameter (one = (1.0E+0, 0.0E+0) ,
+ & zero = (0.0E+0, 0.0E+0) ,
+ & two = (2.0E+0, 0.0E+0) )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Real
+ Real
& scnrm2, slapy2
- external scnrm2, cgbmv, caxpy, slapy2
+ external scnrm2, cgbmv, caxpy, slapy2, claset
c
c %-----------------------%
c | Executable Statements |
@@ -178,6 +179,14 @@ c | Construct the matrix A in LAPACK-style |
c | banded form. |
c %----------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call claset('A', lda, n, zero, zero, a, lda)
+ call claset('A', lda, n, zero, zero, m, lda)
+ call claset('A', lda, n, zero, zero, fac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -186,9 +195,6 @@ c %-------------------------------------%
c
kl = nxi
ku = nxi
- call claset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call claset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call claset('A', 2*kl+ku+1, n, zero, zero, fac, lda)
c
c %---------------%
c | Main diagonal |
@@ -199,14 +205,14 @@ c
c
idiag = kl+ku+1
do 30 j = 1, n
- a(idiag,j) = (4.0E+0, 0.0E+0) / h2
+ a(idiag,j) = (4.0E+0, 0.0E+0) / h2
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
- rho = (1.0E+2, 0.0E+0)
+ rho = (1.0E+2, 0.0E+0)
isup = kl+ku
isub = kl+ku+2
do 50 i = 1, nxi
@@ -287,7 +293,7 @@ c
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
call caxpy(n, -d(j), v(1,j), 1, ax, 1)
- rd(j,1) = real(d(j))
+ rd(j,1) = real (d(j))
rd(j,2) = aimag(d(j))
rd(j,3) = scnrm2(n, ax, 1)
rd(j,3) = rd(j,3) / slapy2(rd(j,1),rd(j,2))
diff --git a/EXAMPLES/BAND/cnbdr3.f b/EXAMPLES/BAND/cnbdr3.f
index 82c58f0..f5d687b 100644
--- a/EXAMPLES/BAND/cnbdr3.f
+++ b/EXAMPLES/BAND/cnbdr3.f
@@ -34,8 +34,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: nbdr3.F SID: 2.4 DATE OF SID: 10/20/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -66,12 +66,12 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Complex
+ Complex
& a(lda,maxn), m(lda,maxn), fac(lda,maxn),
& workl(3*maxncv*maxncv+5*maxncv), workd(3*maxn),
& workev(2*maxncv), v(ldv, maxncv),
& resid(maxn), d(maxncv), ax(maxn), mx(maxn)
- Real
+ Real
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
@@ -83,27 +83,28 @@ c
& n, idiag, isup, isub, maxitr,
& mode, nconv
logical rvec
- Real
+ Real
& tol
- Complex
+ Complex
& rho, h, sigma
c
c %------------%
c | Parameters |
c %------------%
c
- Complex
+ Complex
& one, zero, two
- parameter (one = (1.0E+0, 0.0E+0), zero = (0.0E+0, 0.0E+0),
- & two = (2.0E+0, 0.0E+0))
+ parameter (one = (1.0E+0, 0.0E+0) ,
+ & zero = (0.0E+0, 0.0E+0) ,
+ & two = (2.0E+0, 0.0E+0) )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Real
+ Real
& scnrm2, slapy2
- external scnrm2, cgbmv, caxpy, slapy2
+ external scnrm2, cgbmv, caxpy, slapy2, claset
c
c %-----------------------%
c | Executable Statements |
@@ -177,6 +178,14 @@ c | Construct matrices A and M in LAPACK-style |
c | banded form. |
c %--------------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call claset('A', lda, n, zero, zero, a, lda)
+ call claset('A', lda, n, zero, zero, m, lda)
+ call claset('A', lda, n, zero, zero, fac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -185,9 +194,6 @@ c %-------------------------------------%
c
kl = 1
ku = 1
- call claset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call claset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call claset('A', 2*kl+ku+1, n, zero, zero, fac, lda)
c
c %---------------%
c | Main diagonal |
@@ -197,8 +203,8 @@ c
c
idiag = kl+ku+1
do 30 j = 1, n
- a(idiag,j) = (2.0E+0, 0.0E+0) / h
- m(idiag,j) = (4.0E+0, 0.0E+0) * h
+ a(idiag,j) = (2.0E+0, 0.0E+0) / h
+ m(idiag,j) = (4.0E+0, 0.0E+0) * h
30 continue
c
c %-------------------------------------%
@@ -207,7 +213,7 @@ c %-------------------------------------%
c
isup = kl+ku
isub = kl+ku+2
- rho = (1.0E+1, 0.0E+0)
+ rho = (1.0E+1, 0.0E+0)
do 40 j = 1, n-1
a(isup,j+1) = -one/h + rho/two
a(isub,j) = -one/h - rho/two
@@ -268,7 +274,7 @@ c
& m(kl+1,1), lda, v(1,j), 1, zero,
& mx, 1)
call caxpy(n, -d(j), mx, 1, ax, 1)
- rd(j,1) = real(d(j))
+ rd(j,1) = real (d(j))
rd(j,2) = aimag(d(j))
rd(j,3) = scnrm2(n, ax, 1)
rd(j,3) = rd(j,3) / slapy2(rd(j,1), rd(j,2))
diff --git a/EXAMPLES/BAND/cnbdr4.f b/EXAMPLES/BAND/cnbdr4.f
index 93e829e..99f6423 100644
--- a/EXAMPLES/BAND/cnbdr4.f
+++ b/EXAMPLES/BAND/cnbdr4.f
@@ -32,8 +32,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: nbdr4.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -64,12 +64,12 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Complex
+ Complex
& a(lda,maxn), m(lda,maxn), fac(lda,maxn),
& workl(3*maxncv*maxncv+5*maxncv), workd(3*maxn),
& workev(2*maxncv), v(ldv, maxncv),
& resid(maxn), d(maxncv), ax(maxn), mx(maxn)
- Real
+ Real
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
@@ -81,27 +81,30 @@ c
& n, idiag, isup, isub, maxitr, mode,
& nconv
logical rvec
- Real
+ Real
& tol
- Complex
+ Complex
& rho, h, sigma
c
c %------------%
c | Parameters |
c %------------%
c
- Complex
- & one, zero, two
- parameter (one = (1.0E+0, 0.0E+0), zero = (0.0E+0, 0.0E+0),
- & two = (2.0E+0, 0.0E+0))
+ Complex
+ & one, zero, two, four, six
+ parameter (one = (1.0E+0, 0.0E+0) ,
+ & zero = (0.0E+0, 0.0E+0) ,
+ & two = (2.0E+0, 0.0E+0) ,
+ & four = (4.0E+0, 0.0E+0) ,
+ & six = (6.0E+0, 0.0E+0) )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Real
+ Real
& scnrm2, slapy2
- external scnrm2, cgbmv, caxpy, slapy2
+ external scnrm2, cgbmv, caxpy, slapy2, claset
c
c %-----------------------%
c | Executable Statements |
@@ -142,7 +145,7 @@ c
end if
bmat = 'G'
which = 'LM'
- sigma = (1.0E+1, 0.0E+0)
+ sigma = (1.0E+1, 0.0E+0)
c
c %----------------------------------------------------%
c | The work array WORKL is used in CNAUPD as |
@@ -177,6 +180,14 @@ c | Construct matrices A and M in LAPACK-style |
c | banded form. |
c %--------------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call claset('A', lda, n, zero, zero, a, lda)
+ call claset('A', lda, n, zero, zero, m, lda)
+ call claset('A', lda, n, zero, zero, fac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -185,9 +196,6 @@ c %-------------------------------------%
c
kl = 1
ku = 1
- call claset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call claset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call claset('A', 2*kl+ku+1, n, zero, zero, fac, lda)
c
c %---------------%
c | Main diagonal |
@@ -196,8 +204,8 @@ c
h = one / cmplx(n+1)
idiag = kl+ku+1
do 30 j = 1, n
- a(idiag,j) = (2.0E+0, 0.0E+0) / h
- m(idiag,j) = (4.0E+0, 0.0E+0) * h
+ a(idiag,j) = two / h
+ m(idiag,j) = four * h / six
30 continue
c
c %-------------------------------------%
@@ -206,12 +214,12 @@ c %-------------------------------------%
c
isup = kl+ku
isub = kl+ku+2
- rho = (1.0E+1, 0.0E+0)
+ rho = (1.0E+1, 0.0E+0)
do 40 j = 1, n-1
a(isup,j+1) = -one/h + rho/two
a(isub,j) = -one/h - rho/two
- m(isup,j+1) = one*h
- m(isub,j) = one*h
+ m(isup,j+1) = one*h / six
+ m(isub,j) = one*h / six
40 continue
c
c %-----------------------------------------------%
@@ -267,7 +275,7 @@ c
& m(kl+1,1), lda, v(1,j), 1, zero,
& mx, 1)
call caxpy(n, -d(j), mx, 1, ax, 1)
- rd(j,1) = real(d(j))
+ rd(j,1) = real (d(j))
rd(j,2) = aimag(d(j))
rd(j,3) = scnrm2(n, ax, 1)
rd(j,3) = rd(j,3) / slapy2(rd(j,1), rd(j,2))
diff --git a/EXAMPLES/BAND/dnband.f b/EXAMPLES/BAND/dnband.f
index 443298e..700fc55 100644
--- a/EXAMPLES/BAND/dnband.f
+++ b/EXAMPLES/BAND/dnband.f
@@ -381,7 +381,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: nband.F SID: 2.2 DATE OF SID: 11/21/95 RELEASE: 2
+c FILE: nband.F SID: 2.3 DATE OF SID: 10/17/00 RELEASE: 2
c
c\EndLib
c
@@ -436,7 +436,7 @@ c %------------%
c
Double precision
& one, zero
- parameter (one = 1.0, zero = 0.0)
+ parameter (one = 1.0D+0, zero = 0.0D+0)
c
c
c %-----------------------------%
@@ -1077,8 +1077,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/BAND/dnbdr1.f b/EXAMPLES/BAND/dnbdr1.f
index 7fa5d98..6f33452 100644
--- a/EXAMPLES/BAND/dnbdr1.f
+++ b/EXAMPLES/BAND/dnbdr1.f
@@ -1,4 +1,4 @@
- program dnbdr1
+ program dnbdr1
c
c ... Construct the matrix A in LAPACK-style band form.
c The matrix A is derived from the discretization of
@@ -9,19 +9,19 @@ c
c on the unit square with zero Dirichlet boundary condition
c using standard central difference.
c
-c ... Call DNBAND to find eigenvalues LAMBDA such that
+c ... Call DNBAND to find eigenvalues LAMBDA such that
c A*x = LAMBDA*x.
c
-c ... Use mode 1 of DNAUPD.
+c ... Use mode 1 of DNAUPD .
c
c\BeginLib
c
-c dnband ARPACK banded eigenproblem solver.
-c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c dlaset LAPACK routine to initialize a matrix to zero.
-c daxpy Level 1 BLAS that computes y <- alpha*x+y.
-c dnrm2 Level 1 BLAS that computes the norm of a vector.
-c dgbmv Level 2 BLAS that computes the band matrix vector product
+c dnband ARPACK banded eigenproblem solver.
+c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
+c dlaset LAPACK routine to initialize a matrix to zero.
+c daxpy Level 1 BLAS that computes y <- alpha*x+y.
+c dnrm2 Level 1 BLAS that computes the norm of a vector.
+c dgbmv Level 2 BLAS that computes the band matrix vector product
c
c\Author
c Richard Lehoucq
@@ -32,8 +32,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: nbdr1.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
@@ -64,12 +64,12 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Double precision
+ Double precision
& a(lda,maxn), m(lda,maxn), rfac(lda,maxn),
& workl(3*maxncv*maxncv+6*maxncv), workd(3*maxn),
& workev(3*maxncv), v(ldv, maxncv),
& resid(maxn), d(maxncv, 3), ax(maxn)
- Complex*16
+ Complex*16
& cfac(lda, maxn), workc(maxn)
c
c %---------------%
@@ -81,25 +81,25 @@ c
& n, nx, lo, isub, isup, idiag, mode, maxitr,
& nconv
logical rvec, first
- Double precision
+ Double precision
& tol, rho, h, h2, sigmar, sigmai
c
c %------------%
c | Parameters |
c %------------%
c
- Double precision
+ Double precision
& one, zero, two
- parameter (one = 1.0D+0, zero = 0.0D+0,
- & two = 2.0D+0)
+ parameter (one = 1.0D+0 , zero = 0.0D+0 ,
+ & two = 2.0D+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Double precision
- & dlapy2, dnrm2
- external dlapy2, dnrm2, dgbmv, daxpy
+ Double precision
+ & dlapy2 , dnrm2
+ external dlapy2 , dnrm2 , dgbmv , daxpy
c
c %--------------------%
c | Intrinsic function |
@@ -147,14 +147,14 @@ c
which = 'SM'
c
c %-----------------------------------------------------%
-c | The work array WORKL is used in DNAUPD as |
+c | The work array WORKL is used in DNAUPD as |
c | workspace. Its dimension LWORKL is set as |
c | illustrated below. The parameter TOL determines |
c | the stopping criterion. If TOL<=0, machine |
c | precision is used. The variable IDO is used for |
c | reverse communication, and is initially set to 0. |
c | Setting INFO=0 indicates that a random vector is |
-c | generated in DNAUPD to start the Arnoldi iteration. |
+c | generated in DNAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
@@ -164,10 +164,10 @@ c
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
-c | iterations allowed. Mode 1 of DNAUPD is used |
+c | iterations allowed. Mode 1 of DNAUPD is used |
c | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details, see the documentation |
-c | in DNBAND. |
+c | in DNBAND . |
c %---------------------------------------------------%
c
maxitr = 300
@@ -181,6 +181,14 @@ c | Construct the matrix A in LAPACK-style |
c | banded form. |
c %----------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call dlaset ('A', lda, n, zero, zero, a, lda)
+ call dlaset ('A', lda, n, zero, zero, m, lda)
+ call dlaset ('A', lda, n, zero, zero, rfac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -189,27 +197,24 @@ c %-------------------------------------%
c
kl = nx
ku = nx
- call dlaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call dlaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call dlaset('A', 2*kl+ku+1, n, zero, zero, rfac, lda)
c
c %---------------%
c | Main diagonal |
c %---------------%
c
- h = one / dble(nx+1)
+ h = one / dble (nx+1)
h2 = h*h
c
idiag = kl+ku+1
do 30 j = 1, n
- a(idiag,j) = 4.0D+0 / h2
+ a(idiag,j) = 4.0D+0 / h2
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
- rho = 1.0D+2
+ rho = 1.0D+2
isup = kl+ku
isub = kl+ku+2
do 50 i = 1, nx
@@ -245,7 +250,7 @@ c | in the first NCONV (=IPARAM(5)) columns of V. |
c %------------------------------------------------%
c
rvec = .true.
- call dnband(rvec, 'A', select, d, d(1,2), v, ldv, sigmar, sigmai,
+ call dnband (rvec, 'A', select, d, d(1,2), v, ldv, sigmar, sigmai,
& workev, n, a, m, lda, rfac, cfac, kl, ku, which,
& bmat, nev, tol, resid, ncv, v, ldv, iparam, workd,
& workl, lworkl, workc, iwork, info)
@@ -289,11 +294,11 @@ c %--------------------%
c | Ritz value is real |
c %--------------------%
c
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
- call daxpy(n, -d(j,1), v(1,j), 1, ax, 1)
- d(j,3) = dnrm2(n, ax, 1)
+ call daxpy (n, -d(j,1), v(1,j), 1, ax, 1)
+ d(j,3) = dnrm2 (n, ax, 1)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if ( first ) then
@@ -305,19 +310,19 @@ c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
- call daxpy(n, -d(j,1), v(1,j), 1, ax, 1)
- call daxpy(n, d(j,2), v(1,j+1), 1, ax, 1)
- d(j,3) = dnrm2(n, ax, 1)
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call daxpy (n, -d(j,1), v(1,j), 1, ax, 1)
+ call daxpy (n, d(j,2), v(1,j+1), 1, ax, 1)
+ d(j,3) = dnrm2 (n, ax, 1)
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j+1), 1, zero,
& ax, 1)
- call daxpy(n, -d(j,2), v(1,j), 1, ax, 1)
- call daxpy(n, -d(j,1), v(1,j+1), 1, ax, 1)
- d(j,3) = dlapy2( d(j,3), dnrm2(n, ax, 1) )
- d(j,3) = d(j,3) / dlapy2(d(j,1),d(j,2))
+ call daxpy (n, -d(j,2), v(1,j), 1, ax, 1)
+ call daxpy (n, -d(j,1), v(1,j+1), 1, ax, 1)
+ d(j,3) = dlapy2 ( d(j,3), dnrm2 (n, ax, 1) )
+ d(j,3) = d(j,3) / dlapy2 (d(j,1),d(j,2))
d(j+1,3) = d(j,3)
first = .false.
else
@@ -326,14 +331,14 @@ c
c
90 continue
- call dmout(6, nconv, 3, d, maxncv, -6,
+ call dmout (6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and relative residuals')
else
c
c %-------------------------------------%
c | Either convergence failed, or there |
c | is error. Check the documentation |
-c | for DNBAND. |
+c | for DNBAND . |
c %-------------------------------------%
c
print *, ' '
diff --git a/EXAMPLES/BAND/dnbdr2.f b/EXAMPLES/BAND/dnbdr2.f
index 5a758af..a29ce31 100644
--- a/EXAMPLES/BAND/dnbdr2.f
+++ b/EXAMPLES/BAND/dnbdr2.f
@@ -1,4 +1,4 @@
- program dnbdr2
+ program dnbdr2
c
c ... Construct matrices A in LAPACK-style band form.
c The matrix A is derived from the discretization of
@@ -11,21 +11,21 @@ c using standard central difference.
c
c ... Define the shift SIGMA = (SIGMAR, SIGMAI).
c
-c ... Call DNBAND to find eigenvalues LAMBDA closest to SIGMA
+c ... Call DNBAND to find eigenvalues LAMBDA closest to SIGMA
c such that
c A*x = LAMBDA*x.
c
-c ... Use mode 3 of DNAUPD.
+c ... Use mode 3 of DNAUPD .
c
c\BeginLib
c
c\Routines called:
-c dnband ARPACK banded eigenproblem solver.
-c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c dlaset LAPACK routine to initialize a matrix to zero.
-c daxpy Level 1 BLAS that computes y <- alpha*x+y.
-c dnrm2 Level 1 BLAS that computes the norm of a vector.
-c dgbmv Level 2 BLAS that computes the band matrix vector product
+c dnband ARPACK banded eigenproblem solver.
+c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
+c dlaset LAPACK routine to initialize a matrix to zero.
+c daxpy Level 1 BLAS that computes y <- alpha*x+y.
+c dnrm2 Level 1 BLAS that computes the norm of a vector.
+c dgbmv Level 2 BLAS that computes the band matrix vector product
c
c\Author
c Richard Lehoucq
@@ -36,8 +36,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: nbdr2.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
@@ -68,12 +68,12 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Double precision
+ Double precision
& a(lda,maxn), m(lda,maxn), rfac(lda,maxn),
& workl(3*maxncv*maxncv+6*maxncv), workd(3*maxn),
& workev(3*maxncv), v(ldv, maxncv),
& resid(maxn), d(maxncv, 3), ax(maxn)
- Complex*16
+ Complex*16
& cfac(lda, maxn), workc(maxn)
c
c %---------------%
@@ -85,25 +85,25 @@ c
& n, nx, lo, idiag, isub, isup, mode, maxitr,
& nconv
logical rvec, first
- Double precision
+ Double precision
& tol, rho, h2, h, sigmar, sigmai
c
c %------------%
c | Parameters |
c %------------%
c
- Double precision
+ Double precision
& one, zero, two
- parameter (one = 1.0D+0, zero = 0.0D+0,
- & two = 2.0D+0)
+ parameter (one = 1.0D+0 , zero = 0.0D+0 ,
+ & two = 2.0D+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Double precision
- & dlapy2, dnrm2
- external dlapy2, dnrm2, daxpy, dgbmv
+ Double precision
+ & dlapy2 , dnrm2
+ external dlapy2 , dnrm2 , daxpy , dgbmv
c
c %--------------------%
c | Intrinsic function |
@@ -151,18 +151,18 @@ c
end if
bmat = 'I'
which = 'LM'
- sigmar = 1.0D+4
- sigmai = 0.0D+0
+ sigmar = 1.0D+4
+ sigmai = 0.0D+0
c
c %-----------------------------------------------------%
-c | The work array WORKL is used in DNAUPD as |
+c | The work array WORKL is used in DNAUPD as |
c | workspace. Its dimension LWORKL is set as |
c | illustrated below. The parameter TOL determines |
c | the stopping criterion. If TOL<=0, machine |
c | precision is used. The variable IDO is used for |
c | reverse communication, and is initially set to 0. |
c | Setting INFO=0 indicates that a random vector is |
-c | generated in DNAUPD to start the Arnoldi iteration. |
+c | generated in DNAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
@@ -172,10 +172,10 @@ c
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
-c | iterations allowed. Mode 3 of DNAUPD is used |
+c | iterations allowed. Mode 3 of DNAUPD is used |
c | (IPARAM(7) = 3). All these options can be changed |
c | by the user. For details, see the documentation |
-c | in DNBAND. |
+c | in DNBAND . |
c %---------------------------------------------------%
c
maxitr = 300
@@ -189,6 +189,14 @@ c | Construct the matrix A in LAPACK-style |
c | banded form. |
c %----------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call dlaset ('A', lda, n, zero, zero, a, lda)
+ call dlaset ('A', lda, n, zero, zero, m, lda)
+ call dlaset ('A', lda, n, zero, zero, rfac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -197,20 +205,17 @@ c %-------------------------------------%
c
kl = nx
ku = nx
- call dlaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call dlaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call dlaset('A', 2*kl+ku+1, n, zero, zero, rfac, lda)
c
c %---------------%
c | Main diagonal |
c %---------------%
c
- h = one / dble(nx+1)
+ h = one / dble (nx+1)
h2 = h*h
c
idiag = kl+ku+1
do 30 j = 1, n
- a(idiag,j) = 4.0D+0 / h2
+ a(idiag,j) = 4.0D+0 / h2
30 continue
c
c %-------------------------------------%
@@ -219,7 +224,7 @@ c %-------------------------------------%
c
isup = kl+ku
isub = kl+ku+2
- rho = 1.0D+1
+ rho = 1.0D+1
do 50 i = 1, nx
lo = (i-1)*nx
do 40 j = lo+1, lo+nx-1
@@ -253,7 +258,7 @@ c | in the first NCONV (=IPARAM(5)) columns of V. |
c %------------------------------------------------%
c
rvec = .true.
- call dnband(rvec, 'A', select, d, d(1,2), v, ldv, sigmar,
+ call dnband (rvec, 'A', select, d, d(1,2), v, ldv, sigmar,
& sigmai, workev, n, a, m, lda, rfac, cfac, kl, ku,
& which, bmat, nev, tol, resid, ncv, v, ldv, iparam,
& workd, workl, lworkl, workc, iwork, info)
@@ -297,11 +302,11 @@ c %--------------------%
c | Ritz value is real |
c %--------------------%
c
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
- call daxpy(n, -d(j,1), v(1,j), 1, ax, 1)
- d(j,3) = dnrm2(n, ax, 1)
+ call daxpy (n, -d(j,1), v(1,j), 1, ax, 1)
+ d(j,3) = dnrm2 (n, ax, 1)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if ( first ) then
@@ -313,19 +318,19 @@ c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
- call daxpy(n, -d(j,1), v(1,j), 1, ax, 1)
- call daxpy(n, d(j,2), v(1,j+1), 1, ax, 1)
- d(j,3) = dnrm2(n, ax, 1)
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call daxpy (n, -d(j,1), v(1,j), 1, ax, 1)
+ call daxpy (n, d(j,2), v(1,j+1), 1, ax, 1)
+ d(j,3) = dnrm2 (n, ax, 1)
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j+1), 1, zero,
& ax, 1)
- call daxpy(n, -d(j,1), v(1,j+1), 1, ax, 1)
- call daxpy(n, -d(j,2), v(1,j), 1, ax, 1)
- d(j,3) = dlapy2( d(j,3), dnrm2(n, ax, 1) )
- d(j,3) = d(j,3) / dlapy2(d(j,1),d(j,2))
+ call daxpy (n, -d(j,1), v(1,j+1), 1, ax, 1)
+ call daxpy (n, -d(j,2), v(1,j), 1, ax, 1)
+ d(j,3) = dlapy2 ( d(j,3), dnrm2 (n, ax, 1) )
+ d(j,3) = d(j,3) / dlapy2 (d(j,1),d(j,2))
d(j+1,3) = d(j,3)
first = .false.
else
@@ -334,14 +339,14 @@ c
c
90 continue
- call dmout(6, nconv, 3, d, maxncv, -6,
+ call dmout (6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and relative residuals')
else
c
c %-------------------------------------%
c | Either convergence failed, or there |
c | is error. Check the documentation |
-c | for DNBAND. |
+c | for DNBAND . |
c %-------------------------------------%
c
print *, ' '
diff --git a/EXAMPLES/BAND/dnbdr3.f b/EXAMPLES/BAND/dnbdr3.f
index 42195f3..75c3302 100644
--- a/EXAMPLES/BAND/dnbdr3.f
+++ b/EXAMPLES/BAND/dnbdr3.f
@@ -1,4 +1,4 @@
- program dnbdr3
+ program dnbdr3
c
c ... Construct matrices A and M in LAPACK-style band form.
c The matrix A and M are derived from the finite element
@@ -6,22 +6,22 @@ c discretization of the 1-dimensional convection-diffusion operator
c (d^2u/dx^2) + rho*(du/dx)
c on the interval [0,1] with zero boundary condition,
-c ... Call DNBAND to find eigenvalues LAMBDA such that
+c ... Call DNBAND to find eigenvalues LAMBDA such that
c A*x = LAMBDA*M*x.
c
c ... Eigenvalues with largest real parts are sought.
c
-c ... Use mode 2 of DNAUPD.
+c ... Use mode 2 of DNAUPD .
c
c\BeginLib
c
c\Routines called:
-c dnband ARPACK banded eigenproblem solver.
-c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c dlaset LAPACK routine to initialize a matrix to zero.
-c daxpy Level 1 BLAS that computes y <- alpha*x+y.
-c dnrm2 Level 1 BLAS that computes the norm of a vector.
-c dgbmv Level 2 BLAS that computes the band matrix vector product.
+c dnband ARPACK banded eigenproblem solver.
+c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
+c dlaset LAPACK routine to initialize a matrix to zero.
+c daxpy Level 1 BLAS that computes y <- alpha*x+y.
+c dnrm2 Level 1 BLAS that computes the norm of a vector.
+c dgbmv Level 2 BLAS that computes the band matrix vector product.
c
c\Author
c Richard Lehoucq
@@ -32,8 +32,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: nbdr3.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
@@ -64,12 +64,12 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Double precision
+ Double precision
& a(lda,maxn), m(lda,maxn), rfac(lda,maxn),
& workl(3*maxncv*maxncv+6*maxncv), workd(3*maxn),
& workev(3*maxncv), v(ldv, maxncv),
& resid(maxn), d(maxncv, 3), ax(maxn), mx(maxn)
- Complex*16
+ Complex*16
& cfac(lda, maxn), workc(maxn)
c
c %---------------%
@@ -81,25 +81,25 @@ c
& n, idiag, isup, isub, mode, maxitr,
& nconv
logical rvec, first
- Double precision
+ Double precision
& tol, rho, h, sigmar, sigmai
c
c %------------%
c | Parameters |
c %------------%
c
- Double precision
+ Double precision
& one, zero, two
- parameter (one = 1.0D+0, zero = 0.0D+0,
- & two = 2.0D+0)
+ parameter (one = 1.0D+0 , zero = 0.0D+0 ,
+ & two = 2.0D+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Double precision
- & dlapy2, dnrm2
- external dlapy2, dnrm2, dgbmv, daxpy
+ Double precision
+ & dlapy2 , dnrm2
+ external dlapy2 , dnrm2 , dgbmv , daxpy
c
c %--------------------%
c | Intrinsic function |
@@ -142,7 +142,7 @@ c
which = 'LM'
c
c %----------------------------------------------------%
-c | The work array WORKL is used in DNAUPD as |
+c | The work array WORKL is used in DNAUPD as |
c | workspace. Its dimension LWORKL has to be set as |
c | illustrated below. The parameter TOL determines |
c | the stopping criterion. If TOL<=0, machine machine |
@@ -160,10 +160,10 @@ c
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
-c | iterations allowed. Mode 2 of DNAUPD is used |
+c | iterations allowed. Mode 2 of DNAUPD is used |
c | (IPARAM(7) = 2). All these options can be changed |
c | by the user. For details, see the documentation |
-c | in DNBAND. |
+c | in DNBAND . |
c %---------------------------------------------------%
c
mode = 2
@@ -177,6 +177,14 @@ c | Construct matrices A and M in LAPACK-style |
c | banded form. |
c %--------------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call dlaset ('A', lda, n, zero, zero, a, lda)
+ call dlaset ('A', lda, n, zero, zero, m, lda)
+ call dlaset ('A', lda, n, zero, zero, rfac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -185,20 +193,17 @@ c %-------------------------------------%
c
kl = 1
ku = 1
- call dlaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call dlaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call dlaset('A', 2*kl+ku+1, n, zero, zero, rfac, lda)
c
c %---------------%
c | Main diagonal |
c %---------------%
c
- h = one / dble(n+1)
+ h = one / dble (n+1)
c
idiag = kl+ku+1
do 30 j = 1, n
- a(idiag,j) = 2.0D+0 / h
- m(idiag,j) = 4.0D+0 * h
+ a(idiag,j) = 2.0D+0 / h
+ m(idiag,j) = 4.0D+0 * h
30 continue
c
c %-------------------------------------%
@@ -207,7 +212,7 @@ c %-------------------------------------%
c
isup = kl+ku
isub = kl+ku+2
- rho = 1.0D+1
+ rho = 1.0D+1
do 50 j = 1, n
a(isup,j+1) = -one/h + rho/two
a(isub,j) = -one/h - rho/two
@@ -225,7 +230,7 @@ c | in the first NCONV (=IPARAM(5)) columns of V. |
c %------------------------------------------------%
c
rvec = .true.
- call dnband( rvec, 'A', select, d, d(1,2), v, ldv, sigmar,
+ call dnband ( rvec, 'A', select, d, d(1,2), v, ldv, sigmar,
& sigmai, workev, n, A, M, lda, rfac, cfac, kl, ku,
& which, bmat, nev, tol, resid, ncv, v, ldv, iparam,
& workd, workl, lworkl, workc, iwork, info)
@@ -269,14 +274,14 @@ c %--------------------%
c | Ritz value is real |
c %--------------------%
c
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j), 1, zero,
& mx, 1)
- call daxpy(n, -d(j,1), mx, 1, ax, 1)
- d(j,3) = dnrm2(n, ax, 1)
+ call daxpy (n, -d(j,1), mx, 1, ax, 1)
+ d(j,3) = dnrm2 (n, ax, 1)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if ( first ) then
@@ -288,31 +293,31 @@ c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j), 1, zero,
& mx, 1)
- call daxpy(n, -d(j,1), mx, 1, ax, 1)
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call daxpy (n, -d(j,1), mx, 1, ax, 1)
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j+1), 1, zero,
& mx, 1)
- call daxpy(n, d(j,2), mx, 1, ax, 1)
- d(j,3) = dnrm2(n, ax, 1)
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call daxpy (n, d(j,2), mx, 1, ax, 1)
+ d(j,3) = dnrm2 (n, ax, 1)
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j+1), 1, zero,
& ax, 1)
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j+1), 1, zero,
& mx, 1)
- call daxpy(n, -d(j,1), mx, 1, ax, 1)
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call daxpy (n, -d(j,1), mx, 1, ax, 1)
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j), 1, zero,
& mx, 1)
- call daxpy(n, -d(j,2), mx, 1, ax, 1)
- d(j,3) = dlapy2( d(j,3), dnrm2(n, ax, 1) )
- d(j,3) = d(j,3) / dlapy2(d(j,1),d(j,2))
+ call daxpy (n, -d(j,2), mx, 1, ax, 1)
+ d(j,3) = dlapy2 ( d(j,3), dnrm2 (n, ax, 1) )
+ d(j,3) = d(j,3) / dlapy2 (d(j,1),d(j,2))
d(j+1,3) = d(j,3)
first = .false.
else
@@ -321,14 +326,14 @@ c
c
90 continue
- call dmout(6, nconv, 3, d, maxncv, -6,
+ call dmout (6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and relative residuals')
else
c
c %-------------------------------------%
c | Either convergence failed, or there |
c | is error. Check the documentation |
-c | for DNBAND. |
+c | for DNBAND . |
c %-------------------------------------%
c
print *, ' '
diff --git a/EXAMPLES/BAND/dnbdr4.f b/EXAMPLES/BAND/dnbdr4.f
index c0f606e..19ba50c 100644
--- a/EXAMPLES/BAND/dnbdr4.f
+++ b/EXAMPLES/BAND/dnbdr4.f
@@ -33,8 +33,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: nbdr4.F SID: 2.6 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -90,9 +90,9 @@ c | Parameters |
c %------------%
c
Double precision
- & one, zero, two
+ & one, zero, two, six
parameter (one = 1.0D+0, zero = 0.0D+0,
- & two = 2.0D+0)
+ & two = 2.0D+0, six = 6.0D+0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
@@ -179,6 +179,14 @@ c | Construct matrices A and M in LAPACK-style |
c | banded form. |
c %--------------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call dlaset('A', lda, n, zero, zero, a, lda)
+ call dlaset('A', lda, n, zero, zero, m, lda)
+ call dlaset('A', lda, n, zero, zero, rfac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -187,9 +195,6 @@ c %-------------------------------------%
c
kl = 1
ku = 1
- call dlaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call dlaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call dlaset('A', 2*kl+ku+1, n, zero, zero, rfac, lda)
c
c %---------------%
c | Main diagonal |
@@ -199,7 +204,7 @@ c
idiag = kl+ku+1
do 30 j = 1, n
a(idiag,j) = 2.0D+0 / h
- m(idiag,j) = 4.0D+0 * h
+ m(idiag,j) = 4.0D+0 * h / six
30 continue
c
c %-------------------------------------%
@@ -212,8 +217,8 @@ c
do 40 j = 1, n-1
a(isup,j+1) = -one/h + rho/two
a(isub,j) = -one/h - rho/two
- m(isup,j+1) = one*h
- m(isub,j) = one*h
+ m(isup,j+1) = one*h/six
+ m(isub,j) = one*h/six
40 continue
c
c %------------------------------------------------%
diff --git a/EXAMPLES/BAND/dnbdr5.f b/EXAMPLES/BAND/dnbdr5.f
index 4d8a910..ef5d0ef 100644
--- a/EXAMPLES/BAND/dnbdr5.f
+++ b/EXAMPLES/BAND/dnbdr5.f
@@ -1,4 +1,4 @@
- program dnbdr5
+ program dnbdr5
c
c ... Construct matrices A and M in LAPACK-style band form.
c The matrix A is a block tridiagonal matrix. Each
@@ -9,21 +9,21 @@ c of A is an identity matrices.
c
c ... Define COMPLEX shift SIGMA = (SIGMAR,SIGMAI), SIGMAI .ne. 0.
c
-c ... Call DNBAND to find eigenvalues LAMBDA closest to SIGMA
+c ... Call DNBAND to find eigenvalues LAMBDA closest to SIGMA
c such that
c A*x = LAMBDA*x.
c
-c ... Use mode 4 of DNAUPD.
+c ... Use mode 4 of DNAUPD .
c
c\BeginLib
c
c\Routines called:
-c dnband ARPACK banded eigenproblem solver.
-c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c dlaset LAPACK routine to initialize a matrix to zero.
-c daxpy Level 1 BLAS that computes y <- alpha*x+y.
-c dnrm2 Level 1 BLAS that computes the norm of a vector.
-c dgbmv Level 2 BLAS that computes the band matrix vector product.
+c dnband ARPACK banded eigenproblem solver.
+c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
+c dlaset LAPACK routine to initialize a matrix to zero.
+c daxpy Level 1 BLAS that computes y <- alpha*x+y.
+c dnrm2 Level 1 BLAS that computes the norm of a vector.
+c dgbmv Level 2 BLAS that computes the band matrix vector product.
c
c\Author
c Richard Lehoucq
@@ -34,8 +34,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: nbdr5.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
@@ -66,12 +66,12 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Double precision
+ Double precision
& a(lda,maxn), m(lda,maxn), rfac(lda,maxn),
& workl(3*maxncv*maxncv+6*maxncv), workd(3*maxn),
& workev(3*maxncv), v(ldv, maxncv),
& resid(maxn), d(maxncv, 3), ax(maxn)
- Complex*16
+ Complex*16
& cfac(lda, maxn), workc(maxn)
c
c %---------------%
@@ -83,25 +83,25 @@ c
& n, nx, lo, idiag, isup, isub, mode, maxitr,
& nconv
logical rvec, first
- Double precision
+ Double precision
& tol, rho, h, sigmar, sigmai
c
c %------------%
c | Parameters |
c %------------%
c
- Double precision
+ Double precision
& one, zero, two
- parameter (one = 1.0D+0, zero = 0.0D+0,
- & two = 2.0D+0)
+ parameter (one = 1.0D+0 , zero = 0.0D+0 ,
+ & two = 2.0D+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Double precision
- & dlapy2, dnrm2
- external dlapy2, dnrm2, dgbmv, daxpy
+ Double precision
+ & dlapy2 , dnrm2
+ external dlapy2 , dnrm2 , dgbmv , daxpy
c
c %--------------------%
c | Intrinsic function |
@@ -146,18 +146,18 @@ c
end if
bmat = 'I'
which = 'LM'
- sigmar = 4.0D-1
- sigmai = 6.0D-1
+ sigmar = 4.0D-1
+ sigmai = 6.0D-1
c
c %-----------------------------------------------------%
-c | The work array WORKL is used in DNAUPD as |
+c | The work array WORKL is used in DNAUPD as |
c | workspace. Its dimension LWORKL is set as |
c | illustrated below. The parameter TOL determines |
c | the stopping criterion. If TOL<=0, machine |
c | precision is used. The variable IDO is used for |
c | reverse communication, and is initially set to 0. |
c | Setting INFO=0 indicates that a random vector is |
-c | generated in DNAUPD to start the Arnoldi iteration. |
+c | generated in DNAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
@@ -167,10 +167,10 @@ c
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
-c | iterations allowed. Mode 4 of DNAUPD is used |
+c | iterations allowed. Mode 4 of DNAUPD is used |
c | (IPARAM(7) = 4). All these options can be changed |
c | by the user. For details, see the documentation |
-c | in DNBAND. |
+c | in DNBAND . |
c %---------------------------------------------------%
c
maxitr = 300
@@ -184,6 +184,14 @@ c | Construct matrices A and M in LAPACK-style |
c | banded form. |
c %--------------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call dlaset ('A', lda, n, zero, zero, a, lda)
+ call dlaset ('A', lda, n, zero, zero, m, lda)
+ call dlaset ('A', lda, n, zero, zero, rfac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -192,9 +200,6 @@ c %-------------------------------------%
c
kl = nx
ku = nx
- call dlaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call dlaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call dlaset('A', 2*kl+ku+1, n, zero, zero, rfac, lda)
c
c %---------------%
c | Main diagonal |
@@ -202,8 +207,8 @@ c %---------------%
c
idiag = kl+ku+1
do 30 j = 1, n
- a(idiag,j) = 4.0D+0
- m(idiag,j) = 4.0D+0
+ a(idiag,j) = 4.0D+0
+ m(idiag,j) = 4.0D+0
30 continue
c
c %-------------------------------------%
@@ -212,8 +217,8 @@ c %-------------------------------------%
c
isup = kl+ku
isub = kl+kl+2
- h = one / dble(nx+1)
- rho = 1.0D+2
+ h = one / dble (nx+1)
+ rho = 1.0D+2
do 50 i = 1, nx
lo = (i-1)*nx
do 40 j = lo+1, lo+nx-1
@@ -252,7 +257,7 @@ c | in the first NCONV (=IPARAM(5)) columns of V. |
c %------------------------------------------------%
c
rvec = .true.
- call dnband(rvec, 'A', select, d, d(1,2), v, ldv, sigmar,
+ call dnband (rvec, 'A', select, d, d(1,2), v, ldv, sigmar,
& sigmai, workev, n, a, m, lda, rfac, cfac, ku, kl,
& which, bmat, nev, tol, resid, ncv, v, ldv, iparam,
& workd, workl, lworkl, workc, iwork, info)
@@ -296,11 +301,11 @@ c %--------------------%
c | Ritz value is real |
c %--------------------%
c
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
- call daxpy(n, -d(j,1), v(1,j), 1, ax, 1)
- d(j,3) = dnrm2(n, ax, 1)
+ call daxpy (n, -d(j,1), v(1,j), 1, ax, 1)
+ d(j,3) = dnrm2 (n, ax, 1)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if ( first ) then
@@ -312,19 +317,19 @@ c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
- call daxpy(n, -d(j,1), v(1,j), 1, ax, 1)
- call daxpy(n, d(j,2), v(1,j+1), 1, ax, 1)
- d(j,3) = dnrm2(n, ax, 1)
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call daxpy (n, -d(j,1), v(1,j), 1, ax, 1)
+ call daxpy (n, d(j,2), v(1,j+1), 1, ax, 1)
+ d(j,3) = dnrm2 (n, ax, 1)
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j+1), 1, zero,
& ax, 1)
- call daxpy(n, -d(j,1), v(1,j+1), 1, ax, 1)
- call daxpy(n, -d(j,2), v(1,j), 1, ax, 1)
- d(j,3) = dlapy2( d(j,3), dnrm2(n, ax, 1) )
- d(j,3) = d(j,3) / dlapy2(d(j,1),d(j,2))
+ call daxpy (n, -d(j,1), v(1,j+1), 1, ax, 1)
+ call daxpy (n, -d(j,2), v(1,j), 1, ax, 1)
+ d(j,3) = dlapy2 ( d(j,3), dnrm2 (n, ax, 1) )
+ d(j,3) = d(j,3) / dlapy2 (d(j,1),d(j,2))
d(j+1,3) = d(j,3)
first = .false.
else
@@ -333,14 +338,14 @@ c
c
90 continue
- call dmout(6, nconv, 3, d, maxncv, -6,
+ call dmout (6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and relative residuals')
else
c
c %-------------------------------------%
c | Either convergence failed, or there |
c | is error. Check the documentation |
-c | for DNBAND. |
+c | for DNBAND . |
c %-------------------------------------%
c
print *, ' '
diff --git a/EXAMPLES/BAND/dnbdr6.f b/EXAMPLES/BAND/dnbdr6.f
index 77c65d6..1b1a19c 100644
--- a/EXAMPLES/BAND/dnbdr6.f
+++ b/EXAMPLES/BAND/dnbdr6.f
@@ -1,4 +1,4 @@
- program dnbdr6
+ program dnbdr6
c
c ... Construct matrices A and M in LAPACK-style band form.
c The matrix A is a block tridiagonal matrix. Each
@@ -11,21 +11,21 @@ c subdiagonal and superdiagonal.
c
c ... Define COMPLEX shift SIGMA=(SIGMAR,SIGMAI), SIGMAI .ne. zero.
c
-c ... Call dnband to find eigenvalues LAMBDA closest to SIGMA
+c ... Call dnband to find eigenvalues LAMBDA closest to SIGMA
c such that
c A*x = LAMBDA*M*x.
c
-c ... Use mode 4 of DNAUPD.
+c ... Use mode 4 of DNAUPD .
c
c\BeginLib
c
c\Routines called:
-c dnband ARPACK banded eigenproblem solver.
-c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c dlaset LAPACK routine to initialize a matrix to zero.
-c daxpy Level 1 BLAS that computes y <- alpha*x+y.
-c dnrm2 Level 1 BLAS that computes the norm of a vector.
-c dgbmv Level 2 BLAS that computes the band matrix vector product.
+c dnband ARPACK banded eigenproblem solver.
+c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
+c dlaset LAPACK routine to initialize a matrix to zero.
+c daxpy Level 1 BLAS that computes y <- alpha*x+y.
+c dnrm2 Level 1 BLAS that computes the norm of a vector.
+c dgbmv Level 2 BLAS that computes the band matrix vector product.
c
c\Author
c Danny Sorensen
@@ -36,8 +36,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: nbdr6.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
@@ -68,12 +68,12 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Double precision
+ Double precision
& a(lda,maxn), m(lda,maxn), rfac(lda,maxn),
& workl(3*maxncv*maxncv+6*maxncv), workd(3*maxn),
& workev(3*maxncv), v(ldv, maxncv),
& resid(maxn), d(maxncv, 3), ax(maxn), mx(maxn)
- Complex*16
+ Complex*16
& cfac(lda, maxn), workc(maxn)
c
c %---------------%
@@ -85,17 +85,17 @@ c
& n, nx, lo, idiag, isup, isub, mode, maxitr,
& nconv
logical rvec, first
- Double precision
+ Double precision
& tol, rho, h, sigmar, sigmai
c
c %------------%
c | Parameters |
c %------------%
c
- Double precision
+ Double precision
& one, zero, two
- parameter (one = 1.0D+0, zero = 0.0D+0,
- & two = 2.0D+0)
+ parameter (one = 1.0D+0 , zero = 0.0D+0 ,
+ & two = 2.0D+0 )
c
c %--------------------%
c | Intrinsic function |
@@ -107,9 +107,9 @@ c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Double precision
- & dlapy2, dnrm2
- external dlapy2, dnrm2, dgbmv, daxpy
+ Double precision
+ & dlapy2 , dnrm2
+ external dlapy2 , dnrm2 , dgbmv , daxpy
c
c %-----------------------%
c | Executable Statements |
@@ -148,18 +148,18 @@ c
end if
bmat = 'G'
which = 'LM'
- sigmar = 4.0D-1
- sigmai = 6.0D-1
+ sigmar = 4.0D-1
+ sigmai = 6.0D-1
c
c %-----------------------------------------------------%
-c | The work array WORKL is used in DNAUPD as |
+c | The work array WORKL is used in DNAUPD as |
c | workspace. Its dimension LWORKL is set as |
c | illustrated below. The parameter TOL determines |
c | the stopping criterion. If TOL<=0, machine |
c | precision is used. The variable IDO is used for |
c | reverse communication, and is initially set to 0. |
c | Setting INFO=0 indicates that a random vector is |
-c | generated in DNAUPD to start the Arnoldi iteration. |
+c | generated in DNAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
@@ -169,10 +169,10 @@ c
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
-c | iterations allowed. Mode 4 of DNAUPD is used |
+c | iterations allowed. Mode 4 of DNAUPD is used |
c | (IPARAm(7) = 4). All these options can be changed |
c | by the user. For details, see the documentation |
-c | in dnband. |
+c | in dnband . |
c %---------------------------------------------------%
c
maxitr = 300
@@ -186,6 +186,14 @@ c | Construct matrices A and M in LAPACK-style |
c | banded form. |
c %--------------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call dlaset ('A', lda, n, zero, zero, a, lda)
+ call dlaset ('A', lda, n, zero, zero, m, lda)
+ call dlaset ('A', lda, n, zero, zero, rfac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -194,9 +202,6 @@ c %-------------------------------------%
c
kl = nx
ku = nx
- call dlaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call dlaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call dlaset('A', 2*kl+ku+1, n, zero, zero, rfac, lda)
c
c %---------------%
c | Main diagonal |
@@ -204,8 +209,8 @@ c %---------------%
c
idiag = kl+ku+1
do 30 j = 1, n
- a(idiag,j) = 4.0D+0
- m(idiag,j) = 4.0D+0
+ a(idiag,j) = 4.0D+0
+ m(idiag,j) = 4.0D+0
30 continue
c
c %-------------------------------------%
@@ -214,8 +219,8 @@ c %-------------------------------------%
c
isup = kl+ku
isub = kl+ku+2
- h = one / dble(nx+1)
- rho = 1.0D+2
+ h = one / dble (nx+1)
+ rho = 1.0D+2
do 50 i = 1, nx
lo = (i-1)*nx
do 40 j = lo+1, lo+nx-1
@@ -254,7 +259,7 @@ c | in the first NCONV (=IPARAM(5)) columns of V. |
c %------------------------------------------------%
c
rvec = .true.
- call dnband(rvec, 'A', select, d, d(1,2), v, ldv, sigmar,
+ call dnband (rvec, 'A', select, d, d(1,2), v, ldv, sigmar,
& sigmai, workev, n, a, m, lda, rfac, cfac, ku, kl,
& which, bmat, nev, tol, resid, ncv, v, ldv, iparam,
& workd, workl, lworkl, workc, iwork, info)
@@ -298,14 +303,14 @@ c %--------------------%
c | Ritz value is real |
c %--------------------%
c
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j), 1, zero,
& mx, 1)
- call daxpy(n, -d(j,1), mx, 1, ax, 1)
- d(j,3) = dnrm2(n, ax, 1)
+ call daxpy (n, -d(j,1), mx, 1, ax, 1)
+ d(j,3) = dnrm2 (n, ax, 1)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if ( first ) then
@@ -317,31 +322,31 @@ c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j), 1, zero,
& mx, 1)
- call daxpy(n, -d(j,1), mx, 1, ax, 1)
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call daxpy (n, -d(j,1), mx, 1, ax, 1)
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j+1), 1, zero,
& mx, 1)
- call daxpy(n, d(j,2), mx, 1, ax, 1)
- d(j,3) = dnrm2(n, ax, 1)
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call daxpy (n, d(j,2), mx, 1, ax, 1)
+ d(j,3) = dnrm2 (n, ax, 1)
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j+1), 1, zero,
& ax, 1)
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j+1), 1, zero,
& mx, 1)
- call daxpy(n, -d(j,1), mx, 1, ax, 1)
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call daxpy (n, -d(j,1), mx, 1, ax, 1)
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j), 1, zero,
& mx, 1)
- call daxpy(n, -d(j,2), mx, 1, ax, 1)
- d(j,3) = dlapy2( d(j,3), dnrm2(n, ax, 1) )
- d(j,3) = d(j,3) / dlapy2(d(j,1),d(j,2))
+ call daxpy (n, -d(j,2), mx, 1, ax, 1)
+ d(j,3) = dlapy2 ( d(j,3), dnrm2 (n, ax, 1) )
+ d(j,3) = d(j,3) / dlapy2 (d(j,1),d(j,2))
d(j+1,3) = d(j,3)
first = .false.
else
@@ -350,14 +355,14 @@ c
c
90 continue
- call dmout(6, nconv, 3, d, maxncv, -6,
+ call dmout (6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and relative residuals')
else
c
c %-------------------------------------%
c | Either convergence failed, or there |
c | is error. Check the documentation |
-c | for dnband. |
+c | for dnband . |
c %-------------------------------------%
c
print *, ' '
diff --git a/EXAMPLES/BAND/dsband.f b/EXAMPLES/BAND/dsband.f
index 04247c3..785c98c 100644
--- a/EXAMPLES/BAND/dsband.f
+++ b/EXAMPLES/BAND/dsband.f
@@ -326,7 +326,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: sband.F SID: 2.2 DATE OF SID: 11/21/95 RELEASE: 2
+c FILE: sband.F SID: 2.3 DATE OF SID: 10/17/00 RELEASE: 2
c
c\EndLib
c
@@ -816,8 +816,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/BAND/dsbdr1.f b/EXAMPLES/BAND/dsbdr1.f
index b7ec546..8f6b5a0 100644
--- a/EXAMPLES/BAND/dsbdr1.f
+++ b/EXAMPLES/BAND/dsbdr1.f
@@ -1,4 +1,4 @@
- program dsbdr1
+ program dsbdr1
c
c ... Construct the matrix A in LAPACK-style band form.
c The matrix A is derived from the discretization of
@@ -6,20 +6,20 @@ c the 2-dimensional Laplacian on the unit square with
c zero Dirichlet boundary condition using standard
c central difference.
c
-c ... Call DSBAND to find eigenvalues LAMBDA such that
+c ... Call DSBAND to find eigenvalues LAMBDA such that
c A*x = x*LAMBDA.
c
-c ... Use mode 1 of DSAUPD.
+c ... Use mode 1 of DSAUPD .
c
c\BeginLib
c
c\Routines called:
-c dsband ARPACK banded eigenproblem solver.
-c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c dlaset LAPACK routine to initialize a matrix to zero.
-c daxpy Level 1 BLAS that computes y <- alpha*x+y.
-c dnrm2 Level 1 BLAS that computes the norm of a vector.
-c dgbmv Level 2 BLAS that computes the band matrix vector product
+c dsband ARPACK banded eigenproblem solver.
+c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
+c dlaset LAPACK routine to initialize a matrix to zero.
+c daxpy Level 1 BLAS that computes y <- alpha*x+y.
+c dnrm2 Level 1 BLAS that computes the norm of a vector.
+c dgbmv Level 2 BLAS that computes the band matrix vector product
c
c\Author
c Richard Lehoucq
@@ -30,8 +30,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: sbdr1.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
@@ -62,7 +62,7 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Double precision
+ Double precision
& a(lda,maxn), m(lda,maxn), rfac(lda,maxn),
& workl(maxncv*maxncv+8*maxncv), workd(3*maxn),
& v(ldv, maxncv), resid(maxn), d(maxncv, 2),
@@ -76,7 +76,7 @@ c
integer nev, ncv, ku, kl, info, i, j, ido,
& n, nx, lo, isub, isup, idiag, maxitr, mode,
& nconv
- Double precision
+ Double precision
& tol, sigma, h2
logical rvec
c
@@ -84,17 +84,17 @@ c %------------%
c | Parameters |
c %------------%
c
- Double precision
+ Double precision
& one, zero, two
- parameter (one = 1.0D+0, zero = 0.0D+0, two = 2.0D+0)
+ parameter (one = 1.0D+0 , zero = 0.0D+0 , two = 2.0D+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Double precision
- & dlapy2, dnrm2
- external dlapy2, dnrm2, dgbmv, daxpy
+ Double precision
+ & dlapy2 , dnrm2
+ external dlapy2 , dnrm2 , dgbmv , daxpy
c
c %--------------------%
c | Intrinsic function |
@@ -142,14 +142,14 @@ c
which = 'LM'
c
c %-----------------------------------------------------%
-c | The work array WORKL is used in DSAUPD as |
+c | The work array WORKL is used in DSAUPD as |
c | workspace. Its dimension LWORKL is set as |
c | illustrated below. The parameter TOL determines |
c | the stopping criterion. If TOL<=0, machine |
c | precision is used. The variable IDO is used for |
c | reverse communication, and is initially set to 0. |
c | Setting INFO=0 indicates that a random vector is |
-c | generated in DSAUPD to start the Arnoldi iteration. |
+c | generated in DSAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = ncv**2+8*ncv
@@ -159,10 +159,10 @@ c
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
-c | iterations allowed. Mode 1 of DSAUPD is used |
+c | iterations allowed. Mode 1 of DSAUPD is used |
c | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details see the documentation in |
-c | DSBAND. |
+c | DSBAND . |
c %---------------------------------------------------%
c
maxitr = 300
@@ -176,6 +176,14 @@ c | Construct the matrix A in LAPACK-style |
c | banded form. |
c %----------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call dlaset ('A', lda, n, zero, zero, a, lda)
+ call dlaset ('A', lda, n, zero, zero, m, lda)
+ call dlaset ('A', lda, n, zero, zero, rfac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -184,9 +192,6 @@ c %-------------------------------------%
c
kl = nx
ku = nx
- call dlaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call dlaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call dlaset('A', 2*kl+ku+1, n, zero, zero, rfac, lda)
c
c %---------------%
c | Main diagonal |
@@ -195,7 +200,7 @@ c
h2 = one / ((nx+1)*(nx+1))
idiag = kl+ku+1
do 30 j = 1, n
- a(idiag,j) = 4.0D+0 / h2
+ a(idiag,j) = 4.0D+0 / h2
30 continue
c
c %-------------------------------------%
@@ -228,7 +233,7 @@ c
80 continue
c
c %-------------------------------------%
-c | Call DSBAND to find eigenvalues and |
+c | Call DSBAND to find eigenvalues and |
c | eigenvectors. Eigenvalues are |
c | returned in the first column of D. |
c | Eigenvectors are returned in the |
@@ -237,7 +242,7 @@ c | V. |
c %-------------------------------------%
c
rvec = .true.
- call dsband( rvec, 'A', select, d, v, ldv, sigma, n, a, m, lda,
+ call dsband ( rvec, 'A', select, d, v, ldv, sigma, n, a, m, lda,
& rfac, kl, ku, which, bmat, nev, tol,
& resid, ncv, v, ldv, iparam, workd, workl, lworkl,
& iwork, info)
@@ -273,23 +278,23 @@ c | || A*x - lambda*x || |
c %----------------------------%
c
do 90 j = 1, nconv
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
- call daxpy(n, -d(j,1), v(1,j), 1, ax, 1)
- d(j,2) = dnrm2(n, ax, 1)
+ call daxpy (n, -d(j,1), v(1,j), 1, ax, 1)
+ d(j,2) = dnrm2 (n, ax, 1)
d(j,2) = d(j,2) / abs(d(j,1))
c
90 continue
- call dmout(6, nconv, 2, d, maxncv, -6,
+ call dmout (6, nconv, 2, d, maxncv, -6,
& 'Ritz values and relative residuals')
else
c
c %-------------------------------------%
c | Either convergence failed, or there |
c | is error. Check the documentation |
-c | for DSBAND. |
+c | for DSBAND . |
c %-------------------------------------%
c
print *, ' '
diff --git a/EXAMPLES/BAND/dsbdr2.f b/EXAMPLES/BAND/dsbdr2.f
index f7c076b..e5d4c56 100644
--- a/EXAMPLES/BAND/dsbdr2.f
+++ b/EXAMPLES/BAND/dsbdr2.f
@@ -31,8 +31,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: sbdr2.F SID: 2.6 DATE OF SID: 07/21/02 RELEASE: 2
c
c\Remarks
c 1. None
@@ -150,7 +150,7 @@ c | Setting INFO=0 indicates that a random vector is |
c | generated in DSAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
- lworkl = 3*ncv**2+6*ncv
+ lworkl = ncv*ncv+8*ncv
tol = zero
ido = 0
info = 0
@@ -174,6 +174,14 @@ c | Construct the matrix A in LAPACK-style |
c | banded form. |
c %----------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call dlaset('A', lda, n, zero, zero, a, lda)
+ call dlaset('A', lda, n, zero, zero, m, lda)
+ call dlaset('A', lda, n, zero, zero, rfac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -182,9 +190,6 @@ c %-------------------------------------%
c
kl = nx
ku = nx
- call dlaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call dlaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call dlaset('A', 2*kl+ku+1, n, zero, zero, rfac, lda)
c
c %---------------%
c | Main diagonal |
diff --git a/EXAMPLES/BAND/dsbdr3.f b/EXAMPLES/BAND/dsbdr3.f
index cff427a..3dd8d81 100644
--- a/EXAMPLES/BAND/dsbdr3.f
+++ b/EXAMPLES/BAND/dsbdr3.f
@@ -1,25 +1,25 @@
- program dsbdr3
+ program dsbdr3
c
c ... Construct the matrix A in LAPACK-style band form.
c The matrix A is the 1-dimensional discrete Laplacian on [0,1]
c with zero Dirichlet boundary condition, M is the mass
c formed by using piecewise linear elements on [0,1].
c
-c ... Call DSBAND with regular mode to find eigenvalues LAMBDA
+c ... Call DSBAND with regular mode to find eigenvalues LAMBDA
c such that
c A*x = LAMBDA*M*x.
c
-c ... Use mode 2 of DSAUPD.
+c ... Use mode 2 of DSAUPD .
c
c\BeginLib
c
c\Routines called:
-c dsband ARPACK banded eigenproblem solver.
-c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c dlaset LAPACK routine to initialize a matrix to zero.
-c daxpy Level 1 BLAS that computes y <- alpha*x+y.
-c dnrm2 Level 1 BLAS that computes the norm of a vector.
-c dgbmv Level 2 BLAS that computes the band matrix vector product
+c dsband ARPACK banded eigenproblem solver.
+c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
+c dlaset LAPACK routine to initialize a matrix to zero.
+c daxpy Level 1 BLAS that computes y <- alpha*x+y.
+c dnrm2 Level 1 BLAS that computes the norm of a vector.
+c dgbmv Level 2 BLAS that computes the band matrix vector product
c\Author
c Richard Lehoucq
c Danny Sorensen
@@ -29,8 +29,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: sbdr3.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
@@ -61,7 +61,7 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Double precision
+ Double precision
& a(lda,maxn), m(lda,maxn), rfac(lda,maxn),
& workl(maxncv*maxncv+8*maxncv), workd(3*maxn),
& v(ldv, maxncv), resid(maxn), d(maxncv, 2),
@@ -74,7 +74,7 @@ c
character which*2, bmat
integer nev, ncv, ku, kl, info, j, ido,
& n, isub, isup, idiag, maxitr, mode, nconv
- Double precision
+ Double precision
& tol, h, sigma, r1, r2
logical rvec
c
@@ -82,18 +82,18 @@ c %------------%
c | Parameters |
c %------------%
c
- Double precision
+ Double precision
& one, zero, two, four, six
- parameter (one = 1.0D+0, zero = 0.0D+0, two = 2.0D+0,
- & four = 4.0D+0, six = 6.0D+0)
+ parameter (one = 1.0D+0 , zero = 0.0D+0 , two = 2.0D+0 ,
+ & four = 4.0D+0 , six = 6.0D+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Double precision
- & dlapy2, dnrm2
- external dlapy2, dnrm2, daxpy, dgbmv
+ Double precision
+ & dlapy2 , dnrm2
+ external dlapy2 , dnrm2 , daxpy , dgbmv
c
c %--------------------%
c | Intrinsic function |
@@ -136,14 +136,14 @@ c
which = 'LM'
c
c %-----------------------------------------------------%
-c | The work array WORKL is used in DSAUPD as |
+c | The work array WORKL is used in DSAUPD as |
c | workspace. Its dimension LWORKL is set as |
c | illustrated below. The parameter TOL determines |
c | the stopping criterion. If TOL<=0, machine |
c | precision is used. The variable IDO is used for |
c | reverse communication, and is initially set to 0. |
c | Setting INFO=0 indicates that a random vector is |
-c | generated in DSAUPD to start the Arnoldi iteration. |
+c | generated in DSAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = ncv**2+8*ncv
@@ -153,10 +153,10 @@ c
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
-c | iterations allowed. Mode 2 of DSAUPD is used |
+c | iterations allowed. Mode 2 of DSAUPD is used |
c | (IPARAM(7) = 2). All these options can be changed |
c | by the user. For details see the documentation in |
-c | DSBAND. |
+c | DSBAND . |
c %---------------------------------------------------%
c
maxitr = 300
@@ -170,6 +170,14 @@ c | Construct the matrix A in LAPACK-style |
c | banded form. |
c %----------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call dlaset ('A', lda, n, zero, zero, a, lda)
+ call dlaset ('A', lda, n, zero, zero, m, lda)
+ call dlaset ('A', lda, n, zero, zero, rfac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -178,15 +186,12 @@ c %-------------------------------------%
c
kl = 1
ku = 1
- call dlaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call dlaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call dlaset('A', 2*kl+ku+1, n, zero, zero, rfac, lda)
c
c %---------------%
c | Main diagonal |
c %---------------%
c
- h = one / dble(n+1)
+ h = one / dble (n+1)
r1 = four / six
idiag = kl+ku+1
do 30 j = 1, n
@@ -209,7 +214,7 @@ c
60 continue
c
c %-------------------------------------%
-c | Call DSBAND to find eigenvalues and |
+c | Call DSBAND to find eigenvalues and |
c | eigenvectors. Eigenvalues are |
c | returned in the first column of D. |
c | Eigenvectors are returned in the |
@@ -218,7 +223,7 @@ c | V. |
c %-------------------------------------%
c
rvec = .true.
- call dsband( rvec, 'A', select, d, v, ldv, sigma, n, a, m, lda,
+ call dsband ( rvec, 'A', select, d, v, ldv, sigma, n, a, m, lda,
& rfac, kl, ku, which, bmat, nev, tol,
& resid, ncv, v, ldv, iparam, workd, workl, lworkl,
& iwork, info)
@@ -254,26 +259,26 @@ c | || A*x - lambda*x || |
c %----------------------------%
c
do 90 j = 1, nconv
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j), 1, zero,
& mx, 1)
- call daxpy(n, -d(j,1), mx, 1, ax, 1)
- d(j,2) = dnrm2(n, ax, 1)
+ call daxpy (n, -d(j,1), mx, 1, ax, 1)
+ d(j,2) = dnrm2 (n, ax, 1)
d(j,2) = d(j,2) / abs(d(j,1))
c
90 continue
- call dmout(6, nconv, 2, d, maxncv, -6,
+ call dmout (6, nconv, 2, d, maxncv, -6,
& 'Ritz values and relative residuals')
else
c
c %-------------------------------------%
c | Either convergence failed, or there |
c | is error. Check the documentation |
-c | for DSBAND. |
+c | for DSBAND . |
c %-------------------------------------%
c
print *, ' '
diff --git a/EXAMPLES/BAND/dsbdr4.f b/EXAMPLES/BAND/dsbdr4.f
index 4911010..93b71a9 100644
--- a/EXAMPLES/BAND/dsbdr4.f
+++ b/EXAMPLES/BAND/dsbdr4.f
@@ -1,25 +1,25 @@
- program dsbdr4
+ program dsbdr4
c
c ... Construct the matrix A in LAPACK-style band form.
c The matrix A is the 1-dimensional discrete Laplacian on [0,1]
c with zero Dirichlet boundary condition, M is the mass
c formed by using piecewise linear elements on [0,1].
c
-c ... Call DSBAND with shift-invert mode to find eigenvalues LAMBDA
+c ... Call DSBAND with shift-invert mode to find eigenvalues LAMBDA
c closest to SIGMA such that
c A*x = LAMBDA*M*x.
c
-c ... Use mode 3 of DSAUPD.
+c ... Use mode 3 of DSAUPD .
c
c\BeginLib
c
c\Routines called:
-c dsband ARPACK banded eigenproblem solver.
-c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c dlaset LAPACK routine to initialize a matrix to zero.
-c daxpy Level 1 BLAS that computes y <- alpha*x+y.
-c dnrm2 Level 1 BLAS that computes the norm of a vector.
-c dgbmv Level 2 BLAS that computes the band matrix vector product
+c dsband ARPACK banded eigenproblem solver.
+c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
+c dlaset LAPACK routine to initialize a matrix to zero.
+c daxpy Level 1 BLAS that computes y <- alpha*x+y.
+c dnrm2 Level 1 BLAS that computes the norm of a vector.
+c dgbmv Level 2 BLAS that computes the band matrix vector product
c
c\Author
c Richard Lehoucq
@@ -30,8 +30,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: sbdr4.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
@@ -62,7 +62,7 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Double precision
+ Double precision
& a(lda,maxn), m(lda,maxn), rfac(lda,maxn),
& workl(maxncv*maxncv+8*maxncv), workd(3*maxn),
& v(ldv, maxncv), resid(maxn), d(maxncv, 2),
@@ -75,7 +75,7 @@ c
character which*2, bmat
integer nev, ncv, ku, kl, info, j, ido,
& n, isub, isup, idiag, maxitr, mode, nconv
- Double precision
+ Double precision
& tol, h, sigma, r1, r2
logical rvec
c
@@ -83,18 +83,18 @@ c %------------%
c | Parameters |
c %------------%
c
- Double precision
+ Double precision
& one, zero, two, four, six
- parameter (one = 1.0D+0, zero = 0.0D+0, two = 2.0D+0,
- & four = 4.0D+0, six = 6.0D+0)
+ parameter (one = 1.0D+0 , zero = 0.0D+0 , two = 2.0D+0 ,
+ & four = 4.0D+0 , six = 6.0D+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Double precision
- & dlapy2, dnrm2
- external dlapy2, dnrm2, daxpy, dgbmv
+ Double precision
+ & dlapy2 , dnrm2
+ external dlapy2 , dnrm2 , daxpy , dgbmv
c
c %-----------------------%
c | Executable Statements |
@@ -134,14 +134,14 @@ c
sigma = zero
c
c %-----------------------------------------------------%
-c | The work array WORKL is used in DSAUPD as |
+c | The work array WORKL is used in DSAUPD as |
c | workspace. Its dimension LWORKL is set as |
c | illustrated below. The parameter TOL determines |
c | the stopping criterion. If TOL<=0, machine |
c | precision is used. The variable IDO is used for |
c | reverse communication, and is initially set to 0. |
c | Setting INFO=0 indicates that a random vector is |
-c | generated in DSAUPD to start the Arnoldi iteration. |
+c | generated in DSAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = ncv**2+8*ncv
@@ -151,10 +151,10 @@ c
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
-c | iterations allowed. Mode 3 of DSAUPD is used |
+c | iterations allowed. Mode 3 of DSAUPD is used |
c | (IPARAM(7) = 3). All these options can be changed |
c | by the user. For details, see the documentation |
-c | in DSBAND. |
+c | in DSBAND . |
c %---------------------------------------------------%
c
maxitr = 300
@@ -168,6 +168,14 @@ c | Construct the matrix A in LAPACK-style |
c | banded form. |
c %----------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call dlaset ('A', lda, n, zero, zero, a, lda)
+ call dlaset ('A', lda, n, zero, zero, m, lda)
+ call dlaset ('A', lda, n, zero, zero, rfac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -176,15 +184,12 @@ c %-------------------------------------%
c
kl = 1
ku = 1
- call dlaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call dlaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call dlaset('A', 2*kl+ku+1, n, zero, zero, rfac, lda)
c
c %---------------%
c | Main diagonal |
c %---------------%
c
- h = one / dble(n+1)
+ h = one / dble (n+1)
r1 = four / six
idiag = kl+ku+1
do 30 j = 1, n
@@ -207,7 +212,7 @@ c
60 continue
c
c %-------------------------------------%
-c | Call DSBAND to find eigenvalues and |
+c | Call DSBAND to find eigenvalues and |
c | eigenvectors. Eigenvalues are |
c | returned in the first column of D. |
c | Eigenvectors are returned in the |
@@ -216,7 +221,7 @@ c | V. |
c %-------------------------------------%
c
rvec = .true.
- call dsband( rvec, 'A', select, d, v, ldv, sigma, n, a, m,
+ call dsband ( rvec, 'A', select, d, v, ldv, sigma, n, a, m,
& lda, rfac, kl, ku, which, bmat, nev, tol,
& resid, ncv, v, ldv, iparam, workd, workl, lworkl,
& iwork, info)
@@ -252,26 +257,26 @@ c | || A*x - lambda*x || |
c %----------------------------%
c
do 90 j = 1, nconv
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j), 1, zero,
& mx, 1)
- call daxpy(n, -d(j,1), mx, 1, ax, 1)
- d(j,2) = dnrm2(n, ax, 1)
+ call daxpy (n, -d(j,1), mx, 1, ax, 1)
+ d(j,2) = dnrm2 (n, ax, 1)
d(j,2) = d(j,2) / abs(d(j,1))
c
90 continue
- call dmout(6, nconv, 2, d, maxncv, -6,
+ call dmout (6, nconv, 2, d, maxncv, -6,
& 'Ritz values and relative residuals')
else
c
c %-------------------------------------%
c | Either convergence failed, or there |
c | is error. Check the documentation |
-c | for DSBAND. |
+c | for DSBAND . |
c %-------------------------------------%
c
print *, ' '
diff --git a/EXAMPLES/BAND/dsbdr5.f b/EXAMPLES/BAND/dsbdr5.f
index 8212f5c..a7b72ac 100644
--- a/EXAMPLES/BAND/dsbdr5.f
+++ b/EXAMPLES/BAND/dsbdr5.f
@@ -1,25 +1,25 @@
- program dsbdr5
+ program dsbdr5
c
c ... Construct the matrix A in LAPACK-style band form.
c The matrix A is the 1-dimensional discrete Laplacian on [0,1]
c with zero Dirichlet boundary condition, KG is the mass
c formed by using piecewise linear elements on [0,1].
c
-c ... Call DSBAND with Buckling mode to find eigenvalues LAMBDA
+c ... Call DSBAND with Buckling mode to find eigenvalues LAMBDA
c such that
c A*x = M*x*LAMBDA.
c
-c ... Use mode 4 of DSAUPD.
+c ... Use mode 4 of DSAUPD .
c
c\BeginLib
c
c\Routines called:
-c dsband ARPACK banded eigenproblem solver.
-c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c dlaset LAPACK routine to initialize a matrix to zero.
-c daxpy Level 1 BLAS that computes y <- alpha*x+y.
-c dnrm2 Level 1 BLAS that computes the norm of a vector.
-c dgbmv Level 2 BLAS that computes the band matrix vector product
+c dsband ARPACK banded eigenproblem solver.
+c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
+c dlaset LAPACK routine to initialize a matrix to zero.
+c daxpy Level 1 BLAS that computes y <- alpha*x+y.
+c dnrm2 Level 1 BLAS that computes the norm of a vector.
+c dgbmv Level 2 BLAS that computes the band matrix vector product
c
c\Author
c Richard Lehoucq
@@ -30,8 +30,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: sbdr5.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
@@ -62,7 +62,7 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Double precision
+ Double precision
& a(lda,maxn), m(lda,maxn), rfac(lda,maxn),
& workl(maxncv*maxncv+8*maxncv), workd(3*maxn),
& v(ldv, maxncv), resid(maxn), d(maxncv, 2),
@@ -75,7 +75,7 @@ c
character which*2, bmat
integer nev, ncv, kl, ku, info, j, ido,
& n, isub, isup, idiag, maxitr, mode, nconv
- Double precision
+ Double precision
& tol, h, sigma, r1, r2
logical rvec
c
@@ -83,18 +83,18 @@ c %------------%
c | Parameters |
c %------------%
c
- Double precision
+ Double precision
& one, zero, two, four, six
- parameter (one = 1.0D+0, zero = 0.0D+0, two = 2.0D+0,
- & four = 4.0D+0, six = 6.0D+0)
+ parameter (one = 1.0D+0 , zero = 0.0D+0 , two = 2.0D+0 ,
+ & four = 4.0D+0 , six = 6.0D+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Double precision
- & dlapy2, dnrm2
- external dlapy2, dnrm2, dgbmv, daxpy
+ Double precision
+ & dlapy2 , dnrm2
+ external dlapy2 , dnrm2 , dgbmv , daxpy
c
c %--------------------%
c | Intrinsic function |
@@ -139,14 +139,14 @@ c
sigma = 1.0
c
c %-----------------------------------------------------%
-c | The work array WORKL is used in DSAUPD as |
+c | The work array WORKL is used in DSAUPD as |
c | workspace. Its dimension LWORKL is set as |
c | illustrated below. The parameter TOL determines |
c | the stopping criterion. If TOL<=0, machine |
c | precision is used. The variable IDO is used for |
c | reverse communication, and is initially set to 0. |
c | Setting INFO=0 indicates that a random vector is |
-c | generated in DSAUPD to start the Arnoldi iteration. |
+c | generated in DSAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = ncv**2+8*ncv
@@ -156,10 +156,10 @@ c
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
-c | iterations allowed. Mode 4 of DSAUPD is used |
+c | iterations allowed. Mode 4 of DSAUPD is used |
c | (IPARAM(7) = 4). All these options can be changed |
c | by the user. For details see the documentation in |
-c | DSBAND. |
+c | DSBAND . |
c %---------------------------------------------------%
c
maxitr = 300
@@ -173,6 +173,14 @@ c | Construct the matrix A in LAPACK-style |
c | banded form. |
c %----------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call dlaset ('A', lda, n, zero, zero, a, lda)
+ call dlaset ('A', lda, n, zero, zero, m, lda)
+ call dlaset ('A', lda, n, zero, zero, rfac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -181,15 +189,12 @@ c %-------------------------------------%
c
kl = 1
ku = 1
- call dlaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call dlaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call dlaset('A', 2*kl+ku+1, n, zero, zero, rfac, lda)
c
c %---------------%
c | Main diagonal |
c %---------------%
c
- h = one / dble(n+1)
+ h = one / dble (n+1)
r1 = four / six
idiag = kl+ku+1
do 30 j = 1, n
@@ -212,7 +217,7 @@ c
60 continue
c
c %-------------------------------------%
-c | Call DSBAND to find eigenvalues and |
+c | Call DSBAND to find eigenvalues and |
c | eigenvectors. Eigenvalues are |
c | returned in the first column of D. |
c | Eigenvectors are returned in the |
@@ -221,7 +226,7 @@ c | V. |
c %-------------------------------------%
c
rvec = .true.
- call dsband( rvec, 'A', select, d, v, ldv, sigma, n, a, m, lda,
+ call dsband ( rvec, 'A', select, d, v, ldv, sigma, n, a, m, lda,
& rfac, kl, ku, which, bmat, nev, tol,
& resid, ncv, v, ldv, iparam, workd, workl, lworkl,
& iwork, info)
@@ -257,26 +262,26 @@ c | || A*x - lambda*x || |
c %----------------------------%
c
do 90 j = 1, nconv
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j), 1, zero,
& mx, 1)
- call daxpy(n, -d(j,1), mx, 1, ax, 1)
- d(j,2) = dnrm2(n, ax, 1)
+ call daxpy (n, -d(j,1), mx, 1, ax, 1)
+ d(j,2) = dnrm2 (n, ax, 1)
d(j,2) = d(j,2) / abs(d(j,1))
c
90 continue
- call dmout(6, nconv, 2, d, maxncv, -6,
+ call dmout (6, nconv, 2, d, maxncv, -6,
& 'Ritz values and relative residuals')
else
c
c %-------------------------------------%
c | Either convergence failed, or there |
c | is error. Check the documentation |
-c | for DSBAND. |
+c | for DSBAND . |
c %-------------------------------------%
c
print *, ' '
diff --git a/EXAMPLES/BAND/dsbdr6.f b/EXAMPLES/BAND/dsbdr6.f
index 05f94e9..38cb0b0 100644
--- a/EXAMPLES/BAND/dsbdr6.f
+++ b/EXAMPLES/BAND/dsbdr6.f
@@ -1,24 +1,24 @@
- program dsbdr6
+ program dsbdr6
c
c ... Construct the matrix A in LAPACK-style band form.
c The matrix A is the 1-dimensional discrete Laplacian on [0,1]
c with zero Dirichlet boundary condition, M is the mass
c formed by using piecewise linear elements on [0,1].
c
-c ... Call DSBAND with Cayley mode to find eigenvalues LAMBDA such that
+c ... Call DSBAND with Cayley mode to find eigenvalues LAMBDA such that
c A*x = LAMBDA*M*x.
c
-c ... Use mode 5 of DSAUPD.
+c ... Use mode 5 of DSAUPD .
c
c\BeginLib
c
c\Routines called:
-c dsband ARPACK banded eigenproblem solver.
-c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c dlaset LAPACK routine to initialize a matrix to zero.
-c daxpy Level 1 BLAS that computes y <- alpha*x+y.
-c dnrm2 Level 1 BLAS that computes the norm of a vector.
-c dgbmv Level 2 BLAS that computes the band matrix vector product
+c dsband ARPACK banded eigenproblem solver.
+c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
+c dlaset LAPACK routine to initialize a matrix to zero.
+c daxpy Level 1 BLAS that computes y <- alpha*x+y.
+c dnrm2 Level 1 BLAS that computes the norm of a vector.
+c dgbmv Level 2 BLAS that computes the band matrix vector product
c
c\Author
c Richard Lehoucq
@@ -29,8 +29,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: sbdr6.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
@@ -61,7 +61,7 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Double precision
+ Double precision
& a(lda,maxn), m(lda,maxn), rfac(lda,maxn),
& workl(maxncv*maxncv+8*maxncv), workd(3*maxn),
& v(ldv, maxncv), resid(maxn), d(maxncv, 2),
@@ -74,7 +74,7 @@ c
character which*2, bmat
integer nev, ncv, ku, kl, info, j, ido,
& n, isub, isup, idiag, maxitr, mode, nconv
- Double precision
+ Double precision
& tol, h, sigma, r1, r2
logical rvec
c
@@ -82,18 +82,18 @@ c %------------%
c | Parameters |
c %------------%
c
- Double precision
+ Double precision
& one, zero, two, four, six
- parameter (one = 1.0D+0, zero = 0.0D+0, two = 2.0D+0,
- & four = 4.0D+0, six = 6.0D+0)
+ parameter (one = 1.0D+0 , zero = 0.0D+0 , two = 2.0D+0 ,
+ & four = 4.0D+0 , six = 6.0D+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Double precision
- & dlapy2, dnrm2
- external dlapy2, dnrm2, daxpy, dgbmv
+ Double precision
+ & dlapy2 , dnrm2
+ external dlapy2 , dnrm2 , daxpy , dgbmv
c
c %--------------------%
c | Intrinsic function |
@@ -138,14 +138,14 @@ c
sigma = 150.0
c
c %-----------------------------------------------------%
-c | The work array WORKL is used in DSAUPD as |
+c | The work array WORKL is used in DSAUPD as |
c | workspace. Its dimension LWORKL is set as |
c | illustrated below. The parameter TOL determines |
c | the stopping criterion. If TOL<=0, machine |
c | precision is used. The variable IDO is used for |
c | reverse communication, and is initially set to 0. |
c | Setting INFO=0 indicates that a random vector is |
-c | generated in DSAUPD to start the Arnoldi iteration. |
+c | generated in DSAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = ncv**2+8*ncv
@@ -155,7 +155,7 @@ c
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
-c | iterations allowed. Mode 5 of DSAUPD is used |
+c | iterations allowed. Mode 5 of DSAUPD is used |
c | (IPARAM(7) = 5). All these options can be changed |
c | by the user. For details, see the documentation |
c | in SBAND. |
@@ -172,6 +172,14 @@ c | Construct the matrix A in LAPACK-style |
c | banded form. |
c %----------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call dlaset ('A', lda, n, zero, zero, a, lda)
+ call dlaset ('A', lda, n, zero, zero, m, lda)
+ call dlaset ('A', lda, n, zero, zero, rfac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -180,15 +188,12 @@ c %-------------------------------------%
c
kl = 1
ku = 1
- call dlaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call dlaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call dlaset('A', 2*kl+ku+1, n, zero, zero, rfac, lda)
c
c %---------------%
c | Main diagonal |
c %---------------%
c
- h = one / dble(n+1)
+ h = one / dble (n+1)
r1 = four / six
idiag = kl+ku+1
do 30 j = 1, n
@@ -211,7 +216,7 @@ c
60 continue
c
c %-------------------------------------%
-c | Call DSBAND to find eigenvalues and |
+c | Call DSBAND to find eigenvalues and |
c | eigenvectors. Eigenvalues are |
c | returned in the first column of D. |
c | Eigenvectors are returned in the |
@@ -220,7 +225,7 @@ c | V. |
c %-------------------------------------%
c
rvec = .true.
- call dsband( rvec, 'A', select, d, v, ldv, sigma, n, a, m, lda,
+ call dsband ( rvec, 'A', select, d, v, ldv, sigma, n, a, m, lda,
& rfac, kl, ku, which, bmat, nev, tol,
& resid, ncv, v, ldv, iparam, workd, workl, lworkl,
& iwork, info)
@@ -256,26 +261,26 @@ c | || A*x - lambda*x || |
c %----------------------------%
c
do 90 j = 1, nconv
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
- call dgbmv('Notranspose', n, n, kl, ku, one,
+ call dgbmv ('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j), 1, zero,
& mx, 1)
- call daxpy(n, -d(j,1), mx, 1, ax, 1)
- d(j,2) = dnrm2(n, ax, 1)
+ call daxpy (n, -d(j,1), mx, 1, ax, 1)
+ d(j,2) = dnrm2 (n, ax, 1)
d(j,2) = d(j,2) / abs(d(j,1))
c
90 continue
- call dmout(6, nconv, 2, d, maxncv, -6,
+ call dmout (6, nconv, 2, d, maxncv, -6,
& 'Ritz values and relative residuals')
else
c
c %-------------------------------------%
c | Either convergence failed, or there |
c | is error. Check the documentation |
-c | for DSBAND. |
+c | for DSBAND . |
c %-------------------------------------%
c
print *, ' '
diff --git a/EXAMPLES/BAND/snband.f b/EXAMPLES/BAND/snband.f
index 3e8837c..446a9e1 100644
--- a/EXAMPLES/BAND/snband.f
+++ b/EXAMPLES/BAND/snband.f
@@ -381,7 +381,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: nband.F SID: 2.2 DATE OF SID: 11/21/95 RELEASE: 2
+c FILE: nband.F SID: 2.3 DATE OF SID: 10/17/00 RELEASE: 2
c
c\EndLib
c
@@ -436,7 +436,7 @@ c %------------%
c
Real
& one, zero
- parameter (one = 1.0, zero = 0.0)
+ parameter (one = 1.0E+0, zero = 0.0E+0)
c
c
c %-----------------------------%
@@ -1077,8 +1077,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/BAND/snbdr1.f b/EXAMPLES/BAND/snbdr1.f
index a488707..f39f9e7 100644
--- a/EXAMPLES/BAND/snbdr1.f
+++ b/EXAMPLES/BAND/snbdr1.f
@@ -32,8 +32,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: nbdr1.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
@@ -64,12 +64,12 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Real
+ Real
& a(lda,maxn), m(lda,maxn), rfac(lda,maxn),
& workl(3*maxncv*maxncv+6*maxncv), workd(3*maxn),
& workev(3*maxncv), v(ldv, maxncv),
& resid(maxn), d(maxncv, 3), ax(maxn)
- Complex
+ Complex
& cfac(lda, maxn), workc(maxn)
c
c %---------------%
@@ -81,23 +81,23 @@ c
& n, nx, lo, isub, isup, idiag, mode, maxitr,
& nconv
logical rvec, first
- Real
+ Real
& tol, rho, h, h2, sigmar, sigmai
c
c %------------%
c | Parameters |
c %------------%
c
- Real
+ Real
& one, zero, two
- parameter (one = 1.0E+0, zero = 0.0E+0,
- & two = 2.0E+0)
+ parameter (one = 1.0E+0 , zero = 0.0E+0 ,
+ & two = 2.0E+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Real
+ Real
& slapy2, snrm2
external slapy2, snrm2, sgbmv, saxpy
c
@@ -181,6 +181,14 @@ c | Construct the matrix A in LAPACK-style |
c | banded form. |
c %----------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call slaset('A', lda, n, zero, zero, a, lda)
+ call slaset('A', lda, n, zero, zero, m, lda)
+ call slaset('A', lda, n, zero, zero, rfac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -189,27 +197,24 @@ c %-------------------------------------%
c
kl = nx
ku = nx
- call slaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call slaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call slaset('A', 2*kl+ku+1, n, zero, zero, rfac, lda)
c
c %---------------%
c | Main diagonal |
c %---------------%
c
- h = one / real(nx+1)
+ h = one / real (nx+1)
h2 = h*h
c
idiag = kl+ku+1
do 30 j = 1, n
- a(idiag,j) = 4.0E+0 / h2
+ a(idiag,j) = 4.0E+0 / h2
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
- rho = 1.0E+2
+ rho = 1.0E+2
isup = kl+ku
isub = kl+ku+2
do 50 i = 1, nx
diff --git a/EXAMPLES/BAND/snbdr2.f b/EXAMPLES/BAND/snbdr2.f
index a2b0f70..adb45f5 100644
--- a/EXAMPLES/BAND/snbdr2.f
+++ b/EXAMPLES/BAND/snbdr2.f
@@ -36,8 +36,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: nbdr2.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
@@ -68,12 +68,12 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Real
+ Real
& a(lda,maxn), m(lda,maxn), rfac(lda,maxn),
& workl(3*maxncv*maxncv+6*maxncv), workd(3*maxn),
& workev(3*maxncv), v(ldv, maxncv),
& resid(maxn), d(maxncv, 3), ax(maxn)
- Complex
+ Complex
& cfac(lda, maxn), workc(maxn)
c
c %---------------%
@@ -85,23 +85,23 @@ c
& n, nx, lo, idiag, isub, isup, mode, maxitr,
& nconv
logical rvec, first
- Real
+ Real
& tol, rho, h2, h, sigmar, sigmai
c
c %------------%
c | Parameters |
c %------------%
c
- Real
+ Real
& one, zero, two
- parameter (one = 1.0E+0, zero = 0.0E+0,
- & two = 2.0E+0)
+ parameter (one = 1.0E+0 , zero = 0.0E+0 ,
+ & two = 2.0E+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Real
+ Real
& slapy2, snrm2
external slapy2, snrm2, saxpy, sgbmv
c
@@ -151,8 +151,8 @@ c
end if
bmat = 'I'
which = 'LM'
- sigmar = 1.0E+4
- sigmai = 0.0E+0
+ sigmar = 1.0E+4
+ sigmai = 0.0E+0
c
c %-----------------------------------------------------%
c | The work array WORKL is used in SNAUPD as |
@@ -189,6 +189,14 @@ c | Construct the matrix A in LAPACK-style |
c | banded form. |
c %----------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call slaset('A', lda, n, zero, zero, a, lda)
+ call slaset('A', lda, n, zero, zero, m, lda)
+ call slaset('A', lda, n, zero, zero, rfac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -197,20 +205,17 @@ c %-------------------------------------%
c
kl = nx
ku = nx
- call slaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call slaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call slaset('A', 2*kl+ku+1, n, zero, zero, rfac, lda)
c
c %---------------%
c | Main diagonal |
c %---------------%
c
- h = one / real(nx+1)
+ h = one / real (nx+1)
h2 = h*h
c
idiag = kl+ku+1
do 30 j = 1, n
- a(idiag,j) = 4.0E+0 / h2
+ a(idiag,j) = 4.0E+0 / h2
30 continue
c
c %-------------------------------------%
@@ -219,7 +224,7 @@ c %-------------------------------------%
c
isup = kl+ku
isub = kl+ku+2
- rho = 1.0E+1
+ rho = 1.0E+1
do 50 i = 1, nx
lo = (i-1)*nx
do 40 j = lo+1, lo+nx-1
diff --git a/EXAMPLES/BAND/snbdr3.f b/EXAMPLES/BAND/snbdr3.f
index cbdf5c8..7c7f049 100644
--- a/EXAMPLES/BAND/snbdr3.f
+++ b/EXAMPLES/BAND/snbdr3.f
@@ -32,8 +32,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: nbdr3.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
@@ -64,12 +64,12 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Real
+ Real
& a(lda,maxn), m(lda,maxn), rfac(lda,maxn),
& workl(3*maxncv*maxncv+6*maxncv), workd(3*maxn),
& workev(3*maxncv), v(ldv, maxncv),
& resid(maxn), d(maxncv, 3), ax(maxn), mx(maxn)
- Complex
+ Complex
& cfac(lda, maxn), workc(maxn)
c
c %---------------%
@@ -81,23 +81,23 @@ c
& n, idiag, isup, isub, mode, maxitr,
& nconv
logical rvec, first
- Real
+ Real
& tol, rho, h, sigmar, sigmai
c
c %------------%
c | Parameters |
c %------------%
c
- Real
+ Real
& one, zero, two
- parameter (one = 1.0E+0, zero = 0.0E+0,
- & two = 2.0E+0)
+ parameter (one = 1.0E+0 , zero = 0.0E+0 ,
+ & two = 2.0E+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Real
+ Real
& slapy2, snrm2
external slapy2, snrm2, sgbmv, saxpy
c
@@ -177,6 +177,14 @@ c | Construct matrices A and M in LAPACK-style |
c | banded form. |
c %--------------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call slaset('A', lda, n, zero, zero, a, lda)
+ call slaset('A', lda, n, zero, zero, m, lda)
+ call slaset('A', lda, n, zero, zero, rfac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -185,20 +193,17 @@ c %-------------------------------------%
c
kl = 1
ku = 1
- call slaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call slaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call slaset('A', 2*kl+ku+1, n, zero, zero, rfac, lda)
c
c %---------------%
c | Main diagonal |
c %---------------%
c
- h = one / real(n+1)
+ h = one / real (n+1)
c
idiag = kl+ku+1
do 30 j = 1, n
- a(idiag,j) = 2.0E+0 / h
- m(idiag,j) = 4.0E+0 * h
+ a(idiag,j) = 2.0E+0 / h
+ m(idiag,j) = 4.0E+0 * h
30 continue
c
c %-------------------------------------%
@@ -207,7 +212,7 @@ c %-------------------------------------%
c
isup = kl+ku
isub = kl+ku+2
- rho = 1.0E+1
+ rho = 1.0E+1
do 50 j = 1, n
a(isup,j+1) = -one/h + rho/two
a(isub,j) = -one/h - rho/two
diff --git a/EXAMPLES/BAND/snbdr4.f b/EXAMPLES/BAND/snbdr4.f
index b8d7c24..e701658 100644
--- a/EXAMPLES/BAND/snbdr4.f
+++ b/EXAMPLES/BAND/snbdr4.f
@@ -33,8 +33,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: nbdr4.F SID: 2.6 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -90,9 +90,9 @@ c | Parameters |
c %------------%
c
Real
- & one, zero, two
+ & one, zero, two, six
parameter (one = 1.0E+0, zero = 0.0E+0,
- & two = 2.0E+0)
+ & two = 2.0E+0, six = 6.0E+0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
@@ -179,6 +179,14 @@ c | Construct matrices A and M in LAPACK-style |
c | banded form. |
c %--------------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call slaset('A', lda, n, zero, zero, a, lda)
+ call slaset('A', lda, n, zero, zero, m, lda)
+ call slaset('A', lda, n, zero, zero, rfac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -187,9 +195,6 @@ c %-------------------------------------%
c
kl = 1
ku = 1
- call slaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call slaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call slaset('A', 2*kl+ku+1, n, zero, zero, rfac, lda)
c
c %---------------%
c | Main diagonal |
@@ -199,7 +204,7 @@ c
idiag = kl+ku+1
do 30 j = 1, n
a(idiag,j) = 2.0E+0 / h
- m(idiag,j) = 4.0E+0 * h
+ m(idiag,j) = 4.0E+0 * h / six
30 continue
c
c %-------------------------------------%
@@ -212,8 +217,8 @@ c
do 40 j = 1, n-1
a(isup,j+1) = -one/h + rho/two
a(isub,j) = -one/h - rho/two
- m(isup,j+1) = one*h
- m(isub,j) = one*h
+ m(isup,j+1) = one*h/six
+ m(isub,j) = one*h/six
40 continue
c
c %------------------------------------------------%
diff --git a/EXAMPLES/BAND/snbdr5.f b/EXAMPLES/BAND/snbdr5.f
index 982efd9..3d2b15c 100644
--- a/EXAMPLES/BAND/snbdr5.f
+++ b/EXAMPLES/BAND/snbdr5.f
@@ -34,8 +34,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: nbdr5.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
@@ -66,12 +66,12 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Real
+ Real
& a(lda,maxn), m(lda,maxn), rfac(lda,maxn),
& workl(3*maxncv*maxncv+6*maxncv), workd(3*maxn),
& workev(3*maxncv), v(ldv, maxncv),
& resid(maxn), d(maxncv, 3), ax(maxn)
- Complex
+ Complex
& cfac(lda, maxn), workc(maxn)
c
c %---------------%
@@ -83,23 +83,23 @@ c
& n, nx, lo, idiag, isup, isub, mode, maxitr,
& nconv
logical rvec, first
- Real
+ Real
& tol, rho, h, sigmar, sigmai
c
c %------------%
c | Parameters |
c %------------%
c
- Real
+ Real
& one, zero, two
- parameter (one = 1.0E+0, zero = 0.0E+0,
- & two = 2.0E+0)
+ parameter (one = 1.0E+0 , zero = 0.0E+0 ,
+ & two = 2.0E+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Real
+ Real
& slapy2, snrm2
external slapy2, snrm2, sgbmv, saxpy
c
@@ -146,8 +146,8 @@ c
end if
bmat = 'I'
which = 'LM'
- sigmar = 4.0E-1
- sigmai = 6.0E-1
+ sigmar = 4.0E-1
+ sigmai = 6.0E-1
c
c %-----------------------------------------------------%
c | The work array WORKL is used in SNAUPD as |
@@ -184,6 +184,14 @@ c | Construct matrices A and M in LAPACK-style |
c | banded form. |
c %--------------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call slaset('A', lda, n, zero, zero, a, lda)
+ call slaset('A', lda, n, zero, zero, m, lda)
+ call slaset('A', lda, n, zero, zero, rfac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -192,9 +200,6 @@ c %-------------------------------------%
c
kl = nx
ku = nx
- call slaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call slaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call slaset('A', 2*kl+ku+1, n, zero, zero, rfac, lda)
c
c %---------------%
c | Main diagonal |
@@ -202,8 +207,8 @@ c %---------------%
c
idiag = kl+ku+1
do 30 j = 1, n
- a(idiag,j) = 4.0E+0
- m(idiag,j) = 4.0E+0
+ a(idiag,j) = 4.0E+0
+ m(idiag,j) = 4.0E+0
30 continue
c
c %-------------------------------------%
@@ -212,8 +217,8 @@ c %-------------------------------------%
c
isup = kl+ku
isub = kl+kl+2
- h = one / real(nx+1)
- rho = 1.0E+2
+ h = one / real (nx+1)
+ rho = 1.0E+2
do 50 i = 1, nx
lo = (i-1)*nx
do 40 j = lo+1, lo+nx-1
diff --git a/EXAMPLES/BAND/snbdr6.f b/EXAMPLES/BAND/snbdr6.f
index 941cdf3..e3814dc 100644
--- a/EXAMPLES/BAND/snbdr6.f
+++ b/EXAMPLES/BAND/snbdr6.f
@@ -36,8 +36,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: nbdr6.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
@@ -68,12 +68,12 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Real
+ Real
& a(lda,maxn), m(lda,maxn), rfac(lda,maxn),
& workl(3*maxncv*maxncv+6*maxncv), workd(3*maxn),
& workev(3*maxncv), v(ldv, maxncv),
& resid(maxn), d(maxncv, 3), ax(maxn), mx(maxn)
- Complex
+ Complex
& cfac(lda, maxn), workc(maxn)
c
c %---------------%
@@ -85,17 +85,17 @@ c
& n, nx, lo, idiag, isup, isub, mode, maxitr,
& nconv
logical rvec, first
- Real
+ Real
& tol, rho, h, sigmar, sigmai
c
c %------------%
c | Parameters |
c %------------%
c
- Real
+ Real
& one, zero, two
- parameter (one = 1.0E+0, zero = 0.0E+0,
- & two = 2.0E+0)
+ parameter (one = 1.0E+0 , zero = 0.0E+0 ,
+ & two = 2.0E+0 )
c
c %--------------------%
c | Intrinsic function |
@@ -107,7 +107,7 @@ c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Real
+ Real
& slapy2, snrm2
external slapy2, snrm2, sgbmv, saxpy
c
@@ -148,8 +148,8 @@ c
end if
bmat = 'G'
which = 'LM'
- sigmar = 4.0E-1
- sigmai = 6.0E-1
+ sigmar = 4.0E-1
+ sigmai = 6.0E-1
c
c %-----------------------------------------------------%
c | The work array WORKL is used in SNAUPD as |
@@ -186,6 +186,14 @@ c | Construct matrices A and M in LAPACK-style |
c | banded form. |
c %--------------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call slaset('A', lda, n, zero, zero, a, lda)
+ call slaset('A', lda, n, zero, zero, m, lda)
+ call slaset('A', lda, n, zero, zero, rfac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -194,9 +202,6 @@ c %-------------------------------------%
c
kl = nx
ku = nx
- call slaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call slaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call slaset('A', 2*kl+ku+1, n, zero, zero, rfac, lda)
c
c %---------------%
c | Main diagonal |
@@ -204,8 +209,8 @@ c %---------------%
c
idiag = kl+ku+1
do 30 j = 1, n
- a(idiag,j) = 4.0E+0
- m(idiag,j) = 4.0E+0
+ a(idiag,j) = 4.0E+0
+ m(idiag,j) = 4.0E+0
30 continue
c
c %-------------------------------------%
@@ -214,8 +219,8 @@ c %-------------------------------------%
c
isup = kl+ku
isub = kl+ku+2
- h = one / real(nx+1)
- rho = 1.0E+2
+ h = one / real (nx+1)
+ rho = 1.0E+2
do 50 i = 1, nx
lo = (i-1)*nx
do 40 j = lo+1, lo+nx-1
diff --git a/EXAMPLES/BAND/ssband.f b/EXAMPLES/BAND/ssband.f
index 139fc53..8437562 100644
--- a/EXAMPLES/BAND/ssband.f
+++ b/EXAMPLES/BAND/ssband.f
@@ -326,7 +326,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: sband.F SID: 2.2 DATE OF SID: 11/21/95 RELEASE: 2
+c FILE: sband.F SID: 2.3 DATE OF SID: 10/17/00 RELEASE: 2
c
c\EndLib
c
@@ -816,8 +816,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/BAND/ssbdr1.f b/EXAMPLES/BAND/ssbdr1.f
index 050a8a2..a438aa8 100644
--- a/EXAMPLES/BAND/ssbdr1.f
+++ b/EXAMPLES/BAND/ssbdr1.f
@@ -30,8 +30,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: sbdr1.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
@@ -62,7 +62,7 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Real
+ Real
& a(lda,maxn), m(lda,maxn), rfac(lda,maxn),
& workl(maxncv*maxncv+8*maxncv), workd(3*maxn),
& v(ldv, maxncv), resid(maxn), d(maxncv, 2),
@@ -76,7 +76,7 @@ c
integer nev, ncv, ku, kl, info, i, j, ido,
& n, nx, lo, isub, isup, idiag, maxitr, mode,
& nconv
- Real
+ Real
& tol, sigma, h2
logical rvec
c
@@ -84,15 +84,15 @@ c %------------%
c | Parameters |
c %------------%
c
- Real
+ Real
& one, zero, two
- parameter (one = 1.0E+0, zero = 0.0E+0, two = 2.0E+0)
+ parameter (one = 1.0E+0 , zero = 0.0E+0 , two = 2.0E+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Real
+ Real
& slapy2, snrm2
external slapy2, snrm2, sgbmv, saxpy
c
@@ -176,6 +176,14 @@ c | Construct the matrix A in LAPACK-style |
c | banded form. |
c %----------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call slaset('A', lda, n, zero, zero, a, lda)
+ call slaset('A', lda, n, zero, zero, m, lda)
+ call slaset('A', lda, n, zero, zero, rfac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -184,9 +192,6 @@ c %-------------------------------------%
c
kl = nx
ku = nx
- call slaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call slaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call slaset('A', 2*kl+ku+1, n, zero, zero, rfac, lda)
c
c %---------------%
c | Main diagonal |
@@ -195,7 +200,7 @@ c
h2 = one / ((nx+1)*(nx+1))
idiag = kl+ku+1
do 30 j = 1, n
- a(idiag,j) = 4.0E+0 / h2
+ a(idiag,j) = 4.0E+0 / h2
30 continue
c
c %-------------------------------------%
diff --git a/EXAMPLES/BAND/ssbdr2.f b/EXAMPLES/BAND/ssbdr2.f
index c972c34..bde9a06 100644
--- a/EXAMPLES/BAND/ssbdr2.f
+++ b/EXAMPLES/BAND/ssbdr2.f
@@ -31,8 +31,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: sbdr2.F SID: 2.6 DATE OF SID: 07/21/02 RELEASE: 2
c
c\Remarks
c 1. None
@@ -150,7 +150,7 @@ c | Setting INFO=0 indicates that a random vector is |
c | generated in SSAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
- lworkl = 3*ncv**2+6*ncv
+ lworkl = ncv*ncv+8*ncv
tol = zero
ido = 0
info = 0
@@ -174,6 +174,14 @@ c | Construct the matrix A in LAPACK-style |
c | banded form. |
c %----------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call slaset('A', lda, n, zero, zero, a, lda)
+ call slaset('A', lda, n, zero, zero, m, lda)
+ call slaset('A', lda, n, zero, zero, rfac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -182,9 +190,6 @@ c %-------------------------------------%
c
kl = nx
ku = nx
- call slaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call slaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call slaset('A', 2*kl+ku+1, n, zero, zero, rfac, lda)
c
c %---------------%
c | Main diagonal |
diff --git a/EXAMPLES/BAND/ssbdr3.f b/EXAMPLES/BAND/ssbdr3.f
index 95a41d2..572fc26 100644
--- a/EXAMPLES/BAND/ssbdr3.f
+++ b/EXAMPLES/BAND/ssbdr3.f
@@ -29,8 +29,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: sbdr3.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
@@ -61,7 +61,7 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Real
+ Real
& a(lda,maxn), m(lda,maxn), rfac(lda,maxn),
& workl(maxncv*maxncv+8*maxncv), workd(3*maxn),
& v(ldv, maxncv), resid(maxn), d(maxncv, 2),
@@ -74,7 +74,7 @@ c
character which*2, bmat
integer nev, ncv, ku, kl, info, j, ido,
& n, isub, isup, idiag, maxitr, mode, nconv
- Real
+ Real
& tol, h, sigma, r1, r2
logical rvec
c
@@ -82,16 +82,16 @@ c %------------%
c | Parameters |
c %------------%
c
- Real
+ Real
& one, zero, two, four, six
- parameter (one = 1.0E+0, zero = 0.0E+0, two = 2.0E+0,
- & four = 4.0E+0, six = 6.0E+0)
+ parameter (one = 1.0E+0 , zero = 0.0E+0 , two = 2.0E+0 ,
+ & four = 4.0E+0 , six = 6.0E+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Real
+ Real
& slapy2, snrm2
external slapy2, snrm2, saxpy, sgbmv
c
@@ -170,6 +170,14 @@ c | Construct the matrix A in LAPACK-style |
c | banded form. |
c %----------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call slaset('A', lda, n, zero, zero, a, lda)
+ call slaset('A', lda, n, zero, zero, m, lda)
+ call slaset('A', lda, n, zero, zero, rfac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -178,15 +186,12 @@ c %-------------------------------------%
c
kl = 1
ku = 1
- call slaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call slaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call slaset('A', 2*kl+ku+1, n, zero, zero, rfac, lda)
c
c %---------------%
c | Main diagonal |
c %---------------%
c
- h = one / real(n+1)
+ h = one / real (n+1)
r1 = four / six
idiag = kl+ku+1
do 30 j = 1, n
diff --git a/EXAMPLES/BAND/ssbdr4.f b/EXAMPLES/BAND/ssbdr4.f
index 1620713..ebc5b65 100644
--- a/EXAMPLES/BAND/ssbdr4.f
+++ b/EXAMPLES/BAND/ssbdr4.f
@@ -30,8 +30,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: sbdr4.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
@@ -62,7 +62,7 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Real
+ Real
& a(lda,maxn), m(lda,maxn), rfac(lda,maxn),
& workl(maxncv*maxncv+8*maxncv), workd(3*maxn),
& v(ldv, maxncv), resid(maxn), d(maxncv, 2),
@@ -75,7 +75,7 @@ c
character which*2, bmat
integer nev, ncv, ku, kl, info, j, ido,
& n, isub, isup, idiag, maxitr, mode, nconv
- Real
+ Real
& tol, h, sigma, r1, r2
logical rvec
c
@@ -83,16 +83,16 @@ c %------------%
c | Parameters |
c %------------%
c
- Real
+ Real
& one, zero, two, four, six
- parameter (one = 1.0E+0, zero = 0.0E+0, two = 2.0E+0,
- & four = 4.0E+0, six = 6.0E+0)
+ parameter (one = 1.0E+0 , zero = 0.0E+0 , two = 2.0E+0 ,
+ & four = 4.0E+0 , six = 6.0E+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Real
+ Real
& slapy2, snrm2
external slapy2, snrm2, saxpy, sgbmv
c
@@ -168,6 +168,14 @@ c | Construct the matrix A in LAPACK-style |
c | banded form. |
c %----------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call slaset('A', lda, n, zero, zero, a, lda)
+ call slaset('A', lda, n, zero, zero, m, lda)
+ call slaset('A', lda, n, zero, zero, rfac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -176,15 +184,12 @@ c %-------------------------------------%
c
kl = 1
ku = 1
- call slaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call slaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call slaset('A', 2*kl+ku+1, n, zero, zero, rfac, lda)
c
c %---------------%
c | Main diagonal |
c %---------------%
c
- h = one / real(n+1)
+ h = one / real (n+1)
r1 = four / six
idiag = kl+ku+1
do 30 j = 1, n
diff --git a/EXAMPLES/BAND/ssbdr5.f b/EXAMPLES/BAND/ssbdr5.f
index eff0b40..3392a98 100644
--- a/EXAMPLES/BAND/ssbdr5.f
+++ b/EXAMPLES/BAND/ssbdr5.f
@@ -30,8 +30,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: sbdr5.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
@@ -62,7 +62,7 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Real
+ Real
& a(lda,maxn), m(lda,maxn), rfac(lda,maxn),
& workl(maxncv*maxncv+8*maxncv), workd(3*maxn),
& v(ldv, maxncv), resid(maxn), d(maxncv, 2),
@@ -75,7 +75,7 @@ c
character which*2, bmat
integer nev, ncv, kl, ku, info, j, ido,
& n, isub, isup, idiag, maxitr, mode, nconv
- Real
+ Real
& tol, h, sigma, r1, r2
logical rvec
c
@@ -83,16 +83,16 @@ c %------------%
c | Parameters |
c %------------%
c
- Real
+ Real
& one, zero, two, four, six
- parameter (one = 1.0E+0, zero = 0.0E+0, two = 2.0E+0,
- & four = 4.0E+0, six = 6.0E+0)
+ parameter (one = 1.0E+0 , zero = 0.0E+0 , two = 2.0E+0 ,
+ & four = 4.0E+0 , six = 6.0E+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Real
+ Real
& slapy2, snrm2
external slapy2, snrm2, sgbmv, saxpy
c
@@ -173,6 +173,14 @@ c | Construct the matrix A in LAPACK-style |
c | banded form. |
c %----------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call slaset('A', lda, n, zero, zero, a, lda)
+ call slaset('A', lda, n, zero, zero, m, lda)
+ call slaset('A', lda, n, zero, zero, rfac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -181,15 +189,12 @@ c %-------------------------------------%
c
kl = 1
ku = 1
- call slaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call slaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call slaset('A', 2*kl+ku+1, n, zero, zero, rfac, lda)
c
c %---------------%
c | Main diagonal |
c %---------------%
c
- h = one / real(n+1)
+ h = one / real (n+1)
r1 = four / six
idiag = kl+ku+1
do 30 j = 1, n
diff --git a/EXAMPLES/BAND/ssbdr6.f b/EXAMPLES/BAND/ssbdr6.f
index fd000cb..9f8c510 100644
--- a/EXAMPLES/BAND/ssbdr6.f
+++ b/EXAMPLES/BAND/ssbdr6.f
@@ -29,8 +29,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: sbdr6.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
@@ -61,7 +61,7 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Real
+ Real
& a(lda,maxn), m(lda,maxn), rfac(lda,maxn),
& workl(maxncv*maxncv+8*maxncv), workd(3*maxn),
& v(ldv, maxncv), resid(maxn), d(maxncv, 2),
@@ -74,7 +74,7 @@ c
character which*2, bmat
integer nev, ncv, ku, kl, info, j, ido,
& n, isub, isup, idiag, maxitr, mode, nconv
- Real
+ Real
& tol, h, sigma, r1, r2
logical rvec
c
@@ -82,16 +82,16 @@ c %------------%
c | Parameters |
c %------------%
c
- Real
+ Real
& one, zero, two, four, six
- parameter (one = 1.0E+0, zero = 0.0E+0, two = 2.0E+0,
- & four = 4.0E+0, six = 6.0E+0)
+ parameter (one = 1.0E+0 , zero = 0.0E+0 , two = 2.0E+0 ,
+ & four = 4.0E+0 , six = 6.0E+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Real
+ Real
& slapy2, snrm2
external slapy2, snrm2, saxpy, sgbmv
c
@@ -172,6 +172,14 @@ c | Construct the matrix A in LAPACK-style |
c | banded form. |
c %----------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call slaset('A', lda, n, zero, zero, a, lda)
+ call slaset('A', lda, n, zero, zero, m, lda)
+ call slaset('A', lda, n, zero, zero, rfac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -180,15 +188,12 @@ c %-------------------------------------%
c
kl = 1
ku = 1
- call slaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call slaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call slaset('A', 2*kl+ku+1, n, zero, zero, rfac, lda)
c
c %---------------%
c | Main diagonal |
c %---------------%
c
- h = one / real(n+1)
+ h = one / real (n+1)
r1 = four / six
idiag = kl+ku+1
do 30 j = 1, n
diff --git a/EXAMPLES/BAND/znband.f b/EXAMPLES/BAND/znband.f
index dc5711c..3ae900b 100644
--- a/EXAMPLES/BAND/znband.f
+++ b/EXAMPLES/BAND/znband.f
@@ -1,6 +1,6 @@
c \BeginDoc
c
-c \Name: znband
+c \Name: znband
c
c \Description:
c This subroutine returns the converged approximations to eigenvalues
@@ -25,7 +25,7 @@ c referred to as such in the comments that follow. The computed orthonormal
c basis for the invariant subspace corresponding to these Ritz values is
c referred to as a Schur basis.
c
-c znband can be called with one of the following modes:
+c znband can be called with one of the following modes:
c
c Mode 1: A*z = lambda*z.
c ===> OP = A and B = I.
@@ -40,9 +40,9 @@ c
c Choice of different modes can be specified in IPARAM(7) defined below.
c
c \Usage
-c call znband
+c call znband
c ( RVEC, HOWMNY, SELECT, D , Z, LDZ, SIGMA, WORKEV, N, AB,
-c MB, LDA, FAC, KL, LU, WHICH, BMAT, NEV, TOL, RESID, NCV,
+c MB, LDA, FAC, KL, KU, WHICH, BMAT, NEV, TOL, RESID, NCV,
c V, LDV, IPARAM, WORKD, WORKL, LWORKL, RWORK, IWORK, INFO )
c
c \Arguments
@@ -71,11 +71,11 @@ c Ritz value D(j), SELECT(j) must be set to .TRUE..
c If HOWMNY = 'A' or 'P', SELECT need not be initialized
c but it is used as internal workspace.
c
-c D Complex*16 array of dimension NEV+1. (OUTPUT)
+c D Complex*16 array of dimension NEV+1. (OUTPUT)
c On exit, D contains the Ritz approximations
c to the eigenvalues lambda for A*z = lambda*B*z.
c
-c Z Complex*16 N by NEV array (OUTPUT)
+c Z Complex*16 N by NEV array (OUTPUT)
c On exit, if RVEC = .TRUE. and HOWMNY = 'A', then the columns of
c Z represents approximate eigenvectors (Ritz vectors) corresponding
c to the NCONV=IPARAM(5) Ritz values for eigensystem
@@ -92,23 +92,23 @@ c The leading dimension of the array Z. If Ritz vectors are
c desired, then LDZ .ge. max( 1, N ) is required.
c In any case, LDZ .ge. 1 is required.
c
-c SIGMA Complex*16 (INPUT)
+c SIGMA Complex*16 (INPUT)
c If IPARAM(7) = 3 then SIGMA represents the shift.
c Not referenced if IPARAM(7) = 1 or 2.
c
-c WORKEV Complex*16 work array of dimension NCV. (WORKSPACE)
+c WORKEV Complex*16 work array of dimension NCV. (WORKSPACE)
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
-c AB Complex*16 array of dimension LDA by N. (INPUT)
+c AB Complex*16 array of dimension LDA by N. (INPUT)
c The matrix A in band storage, in rows KL+1 to
c 2*KL+KU+1; rows 1 to KL of the array need not be set.
c The j-th column of A is stored in the j-th column of the
c array AB as follows:
c AB(kl+ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
c
-c MB Complex*16 array of dimension LDA by N. (INPUT)
+c MB Complex*16 array of dimension LDA by N. (INPUT)
c The matrix M in band storage, in rows KL+1 to
c 2*KL+KU+1; rows 1 to KL of the array need not be set.
c The j-th column of M is stored in the j-th column of the
@@ -119,7 +119,7 @@ c
c LDA Integer. (INPUT)
c Leading dimension of AB, MB, FAC.
c
-c FAC Complex*16 array of LDA by N. (WORKSPACE/OUTPUT)
+c FAC Complex*16 array of LDA by N. (WORKSPACE/OUTPUT)
c FAC is used to store the LU factors of MB when mode 2
c is invoked. It is used to store the LU factors of
c (A-sigma*M) when mode 3 is invoked.
@@ -153,14 +153,14 @@ c BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*M*x
c NEV Integer. (INPUT)
c Number of eigenvalues of to be computed.
c
-c TOL Double precision scalar. (INPUT)
+c TOL Double precision scalar. (INPUT)
c Stopping criteria: the relative accuracy of the Ritz value
c is considered acceptable if BOUNDS(I) .LE. TOL*ABS(RITZ(I))
c where ABS(RITZ(I)) is the magnitude when RITZ(I) is complex.
-c DEFAULT = dlamch('EPS') (machine precision as computed
-c by the LAPACK auxilliary subroutine dlamch).
+c DEFAULT = dlamch ('EPS') (machine precision as computed
+c by the LAPACK auxilliary subroutine dlamch ).
c
-c RESID Complex*16 array of length N. (INPUT/OUTPUT)
+c RESID Complex*16 array of length N. (INPUT/OUTPUT)
c On INPUT:
c If INFO .EQ. 0, a random initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
@@ -178,7 +178,7 @@ c approximately NCV-NEV Arnoldi vectors at each subsequent update
c iteration. Most of the cost in generating each Arnoldi vector is
c in the matrix-vector operation OP*x.
c
-c V Complex*16 array N by NCV. (OUTPUT)
+c V Complex*16 array N by NCV. (OUTPUT)
c Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns
c contain approximate Schur vectors that span the
c desired invariant subspace.
@@ -190,7 +190,7 @@ c of the eigensystem A*z = lambda*B*z.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
-c program.
+c program. LDV must be great than or equal to N.
c
c IPARAM Integer array of length 11. (INPUT/OUTPUT)
c IPARAM(1) = ISHIFT:
@@ -223,18 +223,18 @@ c Not referenced. Implicit restarting is ALWAYS used.
c
c IPARAM(7) = MODE
c On INPUT determines what type of eigenproblem is being solved.
-c Must be 1,2 or 3; See under \Description of znband for the
+c Must be 1,2 or 3; See under \Description of znband for the
c three modes available.
c
-c WORKD Complex*16 work array of length at least 3*n. (WORKSPACE)
+c WORKD Complex*16 work array of length at least 3*n. (WORKSPACE)
c
-c WORKL Complex*16 work array of length LWORKL. (WORKSPACE)
+c WORKL Complex*16 work array of length LWORKL. (WORKSPACE)
c
c LWORKL Integer. (INPUT)
c LWORKL must be at least 3*NCV**2 + 5*NCV.
c
-c RWORK Double precision array of length N (WORKSPACE)
-c Workspace used in znaupd.
+c RWORK Double precision array of length N (WORKSPACE)
+c Workspace used in znaupd .
c
c IWORK Integer array of dimension at least N. (WORKSPACE)
c Used to mode 2,3. Store the pivot information in the
@@ -255,7 +255,7 @@ c = -10: IPARAM(7) must be 1,2,3.
c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatible.
c = -12: HOWMNY = 'S' not yet implemented
c = -13: HOWMNY must be one of 'A' or 'P' if RVEC = .true.
-c = -14: ZNAUPD did not find any eigenvalues to sufficient
+c = -14: ZNAUPD did not find any eigenvalues to sufficient
c accuracy.
c
c \EndDoc
@@ -265,15 +265,15 @@ c
c\BeginLib
c
c\Routines called
-c znaupd ARPACK reverse communication interface routine.
-c zneupd ARPACK routine that returns Ritz values and (optionally)
+c znaupd ARPACK reverse communication interface routine.
+c zneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
-c zgbtrf LAPACK band matrix factorization routine.
-c zgbtrs LAPACK band linear system solve routine.
-c zlacpy LAPACK matrix copy routine.
-c zcopy Level 1 BLAS that copies one vector to another.
-c dznrm2 Level 1 BLAS that computes the norm of a vector.
-c zgbmv Level 2 BLAS that computes the band matrix vector product.
+c zgbtrf LAPACK band matrix factorization routine.
+c zgbtrs LAPACK band linear system solve routine.
+c zlacpy LAPACK matrix copy routine.
+c zcopy Level 1 BLAS that copies one vector to another.
+c dznrm2 Level 1 BLAS that computes the norm of a vector.
+c zgbmv Level 2 BLAS that computes the band matrix vector product.
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
@@ -293,13 +293,13 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: nband.F SID: 2.1 DATE OF SID: 11/21/95 RELEASE: 2
+c FILE: nband.F SID: 2.3 DATE OF SID: 10/17/00 RELEASE: 2
c
c\EndLib
c
c-----------------------------------------------------------------------
c
- subroutine znband(rvec, howmny, select, d , z, ldz, sigma,
+ subroutine znband (rvec, howmny, select, d , z, ldz, sigma,
& workev, n, ab, mb, lda, fac, kl, ku, which,
& bmat, nev, tol, resid, ncv, v, ldv, iparam,
& workd, workl, lworkl, rwork, iwork, info )
@@ -312,9 +312,9 @@ c
Logical rvec
Integer n, lda, kl, ku, nev, ncv, ldv,
& ldz, lworkl, info
- Complex*16
+ Complex*16
& sigma
- Double precision
+ Double precision
& tol
c
c %-----------------%
@@ -323,11 +323,11 @@ c %-----------------%
c
Integer iparam(*), iwork(*)
Logical select(*)
- Complex*16
+ Complex*16
& d(*), resid(*), v(ldv,*), z(ldz,*),
& ab(lda,*), mb(lda,*), fac(lda,*),
& workd(*), workl(*), workev(*)
- Double precision
+ Double precision
& rwork(*)
c
c %--------------%
@@ -346,18 +346,18 @@ c %------------%
c | Parameters |
c %------------%
c
- Complex*16
+ Complex*16
& one, zero
- parameter (one = (1.0, 0.0), zero = (0.0, 0.0))
-c
+ parameter (one = (1.0D+0, 0.0D+0) ,
+ & zero = (0.0D+0, 0.0D+0) )
c
c %-----------------------------%
c | LAPACK & BLAS routines used |
c %-----------------------------%
c
- Double precision
- & dznrm2
- external zcopy, zgbmv, zgbtrf, zgbtrs, dznrm2, zlacpy
+ Double precision
+ & dznrm2
+ external zcopy , zgbmv , zgbtrf , zgbtrs , dznrm2 , zlacpy
c
c %-----------------------%
c | Executable Statements |
@@ -393,12 +393,12 @@ c
if ( mode .eq. 2 ) then
c
c %-----------------------------------------------%
-c | Copy M to fac and Call LAPACK routine zgbtrf |
+c | Copy M to fac and Call LAPACK routine zgbtrf |
c | to factor M. |
c %-----------------------------------------------%
c
- call zlacpy ('A', ibot, n, mb, lda, fac, lda )
- call zgbtrf(n, n, kl, ku, fac, lda, iwork, ierr)
+ call zlacpy ('A', ibot, n, mb, lda, fac, lda )
+ call zgbtrf (n, n, kl, ku, fac, lda, iwork, ierr)
if (ierr .ne. 0) then
print*, ' '
print*,'_band: error in _gbtrf'
@@ -414,7 +414,7 @@ c %-------------------------%
c | Construct (A - sigma*I) |
c %-------------------------%
c
- call zlacpy ('A', ibot, n, ab, lda, fac, lda )
+ call zlacpy ('A', ibot, n, ab, lda, fac, lda )
do 10 j = 1,n
fac(imid,j) = ab(imid,j) - sigma
10 continue
@@ -437,7 +437,7 @@ c %------------------------%
c | Factor (A - sigma*M) |
c %------------------------%
c
- call zgbtrf(n, n, kl, ku, fac, lda, iwork, ierr)
+ call zgbtrf (n, n, kl, ku, fac, lda, iwork, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, '_band: error in _gbtrf.'
@@ -453,7 +453,7 @@ c %--------------------------------------------%
c
40 continue
c
- call znaupd ( ido, bmat, n, which, nev, tol, resid, ncv,
+ call znaupd ( ido, bmat, n, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& rwork,info )
@@ -466,7 +466,7 @@ c %----------------------------%
c | Perform y <--- OP*x = A*x |
c %----------------------------%
c
- call zgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
+ call zgbmv ('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
@@ -476,11 +476,11 @@ c %-----------------------------------%
c | Perform y <--- OP*x = inv[M]*A*x |
c %-----------------------------------%
c
- call zgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
+ call zgbmv ('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
- call zgbtrs ('Notranspose', n, kl, ku, 1, fac, lda,
+ call zgbtrs ('Notranspose', n, kl, ku, 1, fac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
@@ -498,11 +498,11 @@ c | to force the starting vector into the |
c | range of OP. |
c %-----------------------------------------%
c
- call zgbmv('Notranspose', n, n, kl, ku, one, mb(itop,1),
+ call zgbmv ('Notranspose', n, n, kl, ku, one, mb(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
- call zgbtrs ('Notranspose', n, kl, ku, 1, fac, lda,
+ call zgbtrs ('Notranspose', n, kl, ku, 1, fac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
@@ -521,7 +521,7 @@ c %----------------------------%
c | Perform y <--- OP*x = A*x |
c %----------------------------%
c
- call zgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
+ call zgbmv ('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
@@ -531,11 +531,11 @@ c %-----------------------------------%
c | Perform y <--- OP*x = inv[M]*A*x |
c %-----------------------------------%
c
- call zgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
+ call zgbmv ('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
- call zgbtrs ('Notranspose', n, kl, ku, 1, fac, lda,
+ call zgbtrs ('Notranspose', n, kl, ku, 1, fac, lda,
& iwork, workd(ipntr(2)), ldv, ierr)
if (ierr .ne. 0) then
print*, ' '
@@ -552,8 +552,8 @@ c %----------------------------------%
c | Perform y <-- inv(A-sigma*I)*x. |
c %----------------------------------%
c
- call zcopy(n, workd(ipntr(1)), 1, workd(ipntr(2)), 1)
- call zgbtrs ('Notranspose', n, kl, ku, 1, fac, lda,
+ call zcopy (n, workd(ipntr(1)), 1, workd(ipntr(2)), 1)
+ call zgbtrs ('Notranspose', n, kl, ku, 1, fac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
@@ -570,8 +570,8 @@ c | (M*x) has been computed and stored |
c | in workd(ipntr(3)). |
c %--------------------------------------%
c
- call zcopy(n, workd(ipntr(3)), 1, workd(ipntr(2)), 1)
- call zgbtrs ('Notranspose', n, kl, ku, 1, fac, lda,
+ call zcopy (n, workd(ipntr(3)), 1, workd(ipntr(2)), 1)
+ call zgbtrs ('Notranspose', n, kl, ku, 1, fac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
@@ -590,7 +590,7 @@ c %--------------------%
c | Perform y <-- M*x |
c %--------------------%
c
- call zgbmv('Notranspose', n, n, kl, ku, one, mb(itop,1),
+ call zgbmv ('Notranspose', n, n, kl, ku, one, mb(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
@@ -615,7 +615,7 @@ c
c
else
c
- call zneupd (rvec, howmny , select, d, z, ldz, sigma,
+ call zneupd (rvec, howmny , select, d, z, ldz, sigma,
& workev, bmat, n, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, rwork, info)
@@ -623,7 +623,7 @@ c
if ( info .ne. 0) then
c
c %------------------------------------%
-c | Check the documentation of zneupd. |
+c | Check the documentation of zneupd . |
c %------------------------------------%
c
print *, ' '
@@ -640,7 +640,7 @@ c
end if
c
c %----------------------------------------%
-c | L O O P B A C K to call znaupd again. |
+c | L O O P B A C K to call znaupd again. |
c %----------------------------------------%
c
go to 40
diff --git a/EXAMPLES/BAND/znbdr1.f b/EXAMPLES/BAND/znbdr1.f
index 841e707..53cda86 100644
--- a/EXAMPLES/BAND/znbdr1.f
+++ b/EXAMPLES/BAND/znbdr1.f
@@ -1,4 +1,4 @@
- program znbdr1
+ program znbdr1
c
c ... Construct the matrix A in LAPACK-style band form.
c The matrix A is derived from the discretization of
@@ -9,19 +9,19 @@ c
c on the unit square with zero Dirichlet boundary condition
c using standard central difference.
c
-c ... Call ZNBAND to find eigenvalues LAMBDA such that
+c ... Call ZNBAND to find eigenvalues LAMBDA such that
c A*x = x*LAMBDA.
c
-c ... Use mode 1 of ZNAUPD.
+c ... Use mode 1 of ZNAUPD .
c
c\BeginLib
c
-c znband ARPACK banded eigenproblem solver.
-c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c zlaset LAPACK routine to initialize a matrix to zero.
-c zaxpy Level 1 BLAS that computes y <- alpha*x+y.
-c dznrm2 Level 1 BLAS that computes the norm of a vector.
-c zgbmv Level 2 BLAS that computes the band matrix vector product
+c znband ARPACK banded eigenproblem solver.
+c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
+c zlaset LAPACK routine to initialize a matrix to zero.
+c zaxpy Level 1 BLAS that computes y <- alpha*x+y.
+c dznrm2 Level 1 BLAS that computes the norm of a vector.
+c zgbmv Level 2 BLAS that computes the band matrix vector product
c
c\Author
c Richard Lehoucq
@@ -32,8 +32,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: nbdr1.F SID: 2.3 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
@@ -64,12 +64,12 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Complex*16
+ Complex*16
& a(lda,maxn), m(lda,maxn), fac(lda,maxn),
& workl(3*maxncv*maxncv+5*maxncv), workd(3*maxn),
& workev(2*maxncv), v(ldv, maxncv),
& resid(maxn), d(maxncv), ax(maxn)
- Double precision
+ Double precision
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
@@ -81,28 +81,28 @@ c
& n, nx, lo, isub, isup, idiag, maxitr, mode,
& nconv
logical rvec
- Double precision
+ Double precision
& tol
- Complex*16
+ Complex*16
& rho, h, h2, sigma
c
c %------------%
c | Parameters |
c %------------%
c
- Complex*16
+ Complex*16
& one, zero, two
- parameter ( one = (1.0D+0, 0.0D+0),
- & zero = (0.0D+0, 0.0D+0),
- & two = (2.0D+0, 0.0D+0) )
+ parameter ( one = (1.0D+0, 0.0D+0) ,
+ & zero = (0.0D+0, 0.0D+0) ,
+ & two = (2.0D+0, 0.0D+0) )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Double precision
- & dznrm2, dlapy2
- external dznrm2, zgbmv, zaxpy, dlapy2
+ Double precision
+ & dznrm2 , dlapy2
+ external dznrm2 , zgbmv , zaxpy , dlapy2 , zlaset
c
c %-----------------------%
c | Executable Statements |
@@ -144,12 +144,12 @@ c
which = 'LM'
c
c %-----------------------------------------------------%
-c | The work array WORKL is used in ZNAUPD as |
+c | The work array WORKL is used in ZNAUPD as |
c | workspace. Its dimension LWORKL is set as |
c | illustrated below. The parameter TOL determines |
c | the stopping criterion. If TOL<=0, machine |
c | precision is used. Setting INFO=0 indicates that a |
-c | random vector is generated in ZNAUPD to start the |
+c | random vector is generated in ZNAUPD to start the |
c | Arnoldi iteration. |
c %-----------------------------------------------------%
c
@@ -159,10 +159,10 @@ c
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
-c | iterations allowed. Mode 1 of ZNAUPD is used |
+c | iterations allowed. Mode 1 of ZNAUPD is used |
c | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details, see the documentation |
-c | in znband. |
+c | in znband . |
c %---------------------------------------------------%
c
maxitr = 300
@@ -176,6 +176,14 @@ c | Construct the matrix A in LAPACK-style |
c | banded form. |
c %----------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call zlaset ('A', lda, n, zero, zero, a, lda)
+ call zlaset ('A', lda, n, zero, zero, m, lda)
+ call zlaset ('A', lda, n, zero, zero, fac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -184,27 +192,24 @@ c %-------------------------------------%
c
kl = nx
ku = nx
- call zlaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call zlaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call zlaset('A', 2*kl+ku+1, n, zero, zero, fac, lda)
c
c %---------------%
c | Main diagonal |
c %---------------%
c
- h = one / dcmplx(nx+1)
+ h = one / dcmplx (nx+1)
h2 = h*h
c
idiag = kl+ku+1
do 30 j = 1, n
- a(idiag,j) = (4.0D+0, 0.0D+0) / h2
+ a(idiag,j) = (4.0D+0, 0.0D+0) / h2
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
- rho = (1.0D+2, 0.0D+0)
+ rho = (1.0D+2, 0.0D+0)
isup = kl+ku
isub = kl+ku+2
do 50 i = 1, nx
@@ -239,7 +244,7 @@ c | columns of V. |
c %-----------------------------------------------%
c
rvec = .true.
- call znband(rvec, 'A', select, d, v, ldv, sigma,
+ call znband (rvec, 'A', select, d, v, ldv, sigma,
& workev, n, a, m, lda, fac, kl, ku, which,
& bmat, nev, tol, resid, ncv, v, ldv, iparam,
& workd, workl, lworkl, rwork, iwork, info)
@@ -281,24 +286,24 @@ c | Compute the residual norm |
c | || A*x - lambda*x || |
c %---------------------------%
c
- call zgbmv('Notranspose', n, n, kl, ku, one,
+ call zgbmv ('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
- call zaxpy(n, -d(j), v(1,j), 1, ax, 1)
- rd(j,1) = dble(d(j))
- rd(j,2) = dimag(d(j))
- rd(j,3) = dznrm2(n, ax, 1)
- rd(j,3) = rd(j,3) / dlapy2(rd(j,1),rd(j,2))
+ call zaxpy (n, -d(j), v(1,j), 1, ax, 1)
+ rd(j,1) = dble (d(j))
+ rd(j,2) = dimag (d(j))
+ rd(j,3) = dznrm2 (n, ax, 1)
+ rd(j,3) = rd(j,3) / dlapy2 (rd(j,1),rd(j,2))
90 continue
- call dmout(6, nconv, 3, rd, maxncv, -6,
+ call dmout (6, nconv, 3, rd, maxncv, -6,
& 'Ritz values (Real,Imag) and relative residuals')
else
c
c %-------------------------------------%
c | Either convergence failed, or there |
c | is error. Check the documentation |
-c | for znband. |
+c | for znband . |
c %-------------------------------------%
c
print *, ' '
diff --git a/EXAMPLES/BAND/znbdr2.f b/EXAMPLES/BAND/znbdr2.f
index 44cefa2..3cbbba7 100644
--- a/EXAMPLES/BAND/znbdr2.f
+++ b/EXAMPLES/BAND/znbdr2.f
@@ -1,4 +1,4 @@
- program znbdr2
+ program znbdr2
c
c ... Construct the matrix A in LAPACK-style band form.
c The matrix A is derived from the discretization of
@@ -9,19 +9,19 @@ c
c on the unit square with zero Dirichlet boundary condition
c using standard central difference.
c
-c ... Call ZNBAND to find eigenvalues LAMBDA such that
+c ... Call ZNBAND to find eigenvalues LAMBDA such that
c A*x = x*LAMBDA.
c
-c ... Use mode 3 of ZNAUPD.
+c ... Use mode 3 of ZNAUPD .
c
c\BeginLib
c
-c znband ARPACK banded eigenproblem solver.
-c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c zlaset LAPACK routine to initialize a matrix to zero.
-c zaxpy Level 1 BLAS that computes y <- alpha*x+y.
-c dznrm2 Level 1 BLAS that computes the norm of a vector.
-c zgbmv Level 2 BLAS that computes the band matrix vector product
+c znband ARPACK banded eigenproblem solver.
+c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
+c zlaset LAPACK routine to initialize a matrix to zero.
+c zaxpy Level 1 BLAS that computes y <- alpha*x+y.
+c dznrm2 Level 1 BLAS that computes the norm of a vector.
+c zgbmv Level 2 BLAS that computes the band matrix vector product
c
c\Author
c Richard Lehoucq
@@ -32,8 +32,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: nbdr2.F SID: 2.4 DATE OF SID: 10/20/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -64,12 +64,12 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Complex*16
+ Complex*16
& a(lda,maxn), m(lda,maxn), fac(lda,maxn),
& workl(3*maxncv*maxncv+5*maxncv), workd(3*maxn),
& workev(2*maxncv), v(ldv, maxncv),
& resid(maxn), d(maxncv), ax(maxn)
- Double precision
+ Double precision
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
@@ -81,27 +81,28 @@ c
& n, nxi, lo, isub, isup, idiag, maxitr, mode,
& nconv
logical rvec
- Double precision
+ Double precision
& tol
- Complex*16
+ Complex*16
& rho, h, h2, sigma
c
c %------------%
c | Parameters |
c %------------%
c
- Complex*16
+ Complex*16
& one, zero, two
- parameter (one = (1.0D+0, 0.0D+0), zero = (0.0D+0, 0.0D+0),
- & two = (2.0D+0, 0.0D+0))
+ parameter (one = (1.0D+0, 0.0D+0) ,
+ & zero = (0.0D+0, 0.0D+0) ,
+ & two = (2.0D+0, 0.0D+0) )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Double precision
- & dznrm2, dlapy2
- external dznrm2, zgbmv, zaxpy, dlapy2
+ Double precision
+ & dznrm2 , dlapy2
+ external dznrm2 , zgbmv , zaxpy , dlapy2 , zlaset
c
c %-----------------------%
c | Executable Statements |
@@ -146,12 +147,12 @@ c
sigma = zero
c
c %-----------------------------------------------------%
-c | The work array WORKL is used in ZNAUPD as |
+c | The work array WORKL is used in ZNAUPD as |
c | workspace. Its dimension LWORKL is set as |
c | illustrated below. The parameter TOL determines |
c | the stopping criterion. If TOL<=0, machine |
c | precision is used. Setting INFO=0 indicates that a |
-c | random vector is generated in ZNAUPD to start the |
+c | random vector is generated in ZNAUPD to start the |
c | Arnoldi iteration. |
c %-----------------------------------------------------%
c
@@ -161,10 +162,10 @@ c
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
-c | iterations allowed. Mode 3 of ZNAUPD is used |
+c | iterations allowed. Mode 3 of ZNAUPD is used |
c | (IPARAM(7) = 3). All these options can be changed |
c | by the user. For details, see the documentation |
-c | in znband. |
+c | in znband . |
c %---------------------------------------------------%
c
maxitr = 300
@@ -178,6 +179,14 @@ c | Construct the matrix A in LAPACK-style |
c | banded form. |
c %----------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call zlaset ('A', lda, n, zero, zero, a, lda)
+ call zlaset ('A', lda, n, zero, zero, m, lda)
+ call zlaset ('A', lda, n, zero, zero, fac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -186,27 +195,24 @@ c %-------------------------------------%
c
kl = nxi
ku = nxi
- call zlaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call zlaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call zlaset('A', 2*kl+ku+1, n, zero, zero, fac, lda)
c
c %---------------%
c | Main diagonal |
c %---------------%
c
- h = one / dcmplx(nxi+1)
+ h = one / dcmplx (nxi+1)
h2 = h*h
c
idiag = kl+ku+1
do 30 j = 1, n
- a(idiag,j) = (4.0D+0, 0.0D+0) / h2
+ a(idiag,j) = (4.0D+0, 0.0D+0) / h2
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
- rho = (1.0D+2, 0.0D+0)
+ rho = (1.0D+2, 0.0D+0)
isup = kl+ku
isub = kl+ku+2
do 50 i = 1, nxi
@@ -241,7 +247,7 @@ c | columns of V. |
c %-----------------------------------------------%
c
rvec = .true.
- call znband(rvec, 'A', select, d, v, ldv, sigma,
+ call znband (rvec, 'A', select, d, v, ldv, sigma,
& workev, n, a, m, lda, fac, kl, ku, which,
& bmat, nev, tol, resid, ncv, v, ldv, iparam,
& workd, workl, lworkl, rwork, iwork, info)
@@ -283,24 +289,24 @@ c | Compute the residual norm |
c | || A*x - lambda*x || |
c %---------------------------%
c
- call zgbmv('Notranspose', n, n, kl, ku, one,
+ call zgbmv ('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
- call zaxpy(n, -d(j), v(1,j), 1, ax, 1)
- rd(j,1) = dble(d(j))
- rd(j,2) = dimag(d(j))
- rd(j,3) = dznrm2(n, ax, 1)
- rd(j,3) = rd(j,3) / dlapy2(rd(j,1),rd(j,2))
+ call zaxpy (n, -d(j), v(1,j), 1, ax, 1)
+ rd(j,1) = dble (d(j))
+ rd(j,2) = dimag (d(j))
+ rd(j,3) = dznrm2 (n, ax, 1)
+ rd(j,3) = rd(j,3) / dlapy2 (rd(j,1),rd(j,2))
90 continue
- call dmout(6, nconv, 3, rd, maxncv, -6,
+ call dmout (6, nconv, 3, rd, maxncv, -6,
& 'Ritz values (Real,Imag) and relative residuals')
else
c
c %-------------------------------------%
c | Either convergence failed, or there |
c | is error. Check the documentation |
-c | for znband. |
+c | for znband . |
c %-------------------------------------%
c
print *, ' '
diff --git a/EXAMPLES/BAND/znbdr3.f b/EXAMPLES/BAND/znbdr3.f
index 8f92ec9..8bb9cb4 100644
--- a/EXAMPLES/BAND/znbdr3.f
+++ b/EXAMPLES/BAND/znbdr3.f
@@ -1,4 +1,4 @@
- program znbdr3
+ program znbdr3
c
c ... Construct matrices A and M in LAPACK-style band form.
c Matrices A and M are derived from the finite
@@ -8,22 +8,22 @@ c (d^2u/dx^2) + rho*(du/dx)
c on the interval [0,1] with zero boundary condition using
c piecewise linear elements.
c
-c ... Call ZNBAND to find eigenvalues LAMBDA such that
+c ... Call ZNBAND to find eigenvalues LAMBDA such that
c A*x = M*x*LAMBDA.
c
c ... Eigenvalues with largest real parts are sought.
c
-c ... Use mode 2 of ZNAUPD.
+c ... Use mode 2 of ZNAUPD .
c
c\BeginLib
c
c\Routines called:
-c znband ARPACK banded eigenproblem solver.
-c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c zlaset LAPACK routine to initialize a matrix to zero.
-c zaxpy Level 1 BLAS that computes y <- alpha*x+y.
-c dznrm2 Level 1 BLAS that computes the norm of a vector.
-c zgbmv Level 2 BLAS that computes the band matrix vector product.
+c znband ARPACK banded eigenproblem solver.
+c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
+c zlaset LAPACK routine to initialize a matrix to zero.
+c zaxpy Level 1 BLAS that computes y <- alpha*x+y.
+c dznrm2 Level 1 BLAS that computes the norm of a vector.
+c zgbmv Level 2 BLAS that computes the band matrix vector product.
c
c\Author
c Richard Lehoucq
@@ -34,8 +34,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: nbdr3.F SID: 2.4 DATE OF SID: 10/20/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -66,12 +66,12 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Complex*16
+ Complex*16
& a(lda,maxn), m(lda,maxn), fac(lda,maxn),
& workl(3*maxncv*maxncv+5*maxncv), workd(3*maxn),
& workev(2*maxncv), v(ldv, maxncv),
& resid(maxn), d(maxncv), ax(maxn), mx(maxn)
- Double precision
+ Double precision
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
@@ -83,27 +83,28 @@ c
& n, idiag, isup, isub, maxitr,
& mode, nconv
logical rvec
- Double precision
+ Double precision
& tol
- Complex*16
+ Complex*16
& rho, h, sigma
c
c %------------%
c | Parameters |
c %------------%
c
- Complex*16
+ Complex*16
& one, zero, two
- parameter (one = (1.0D+0, 0.0D+0), zero = (0.0D+0, 0.0D+0),
- & two = (2.0D+0, 0.0D+0))
+ parameter (one = (1.0D+0, 0.0D+0) ,
+ & zero = (0.0D+0, 0.0D+0) ,
+ & two = (2.0D+0, 0.0D+0) )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Double precision
- & dznrm2, dlapy2
- external dznrm2, zgbmv, zaxpy, dlapy2
+ Double precision
+ & dznrm2 , dlapy2
+ external dznrm2 , zgbmv , zaxpy , dlapy2 , zlaset
c
c %-----------------------%
c | Executable Statements |
@@ -145,7 +146,7 @@ c
sigma = zero
c
c %----------------------------------------------------%
-c | The work array WORKL is used in ZNAUPD as |
+c | The work array WORKL is used in ZNAUPD as |
c | workspace. Its dimension LWORKL has to be set as |
c | illustrated below. The parameter TOL determines |
c | the stopping criterion. If TOL<=0, machine machine |
@@ -160,10 +161,10 @@ c
c
c %---------------------------------------------------%
c | IPARAm(3) specifies the maximum number of Arnoldi |
-c | iterations allowed. Mode 2 of ZNAUPD is used |
+c | iterations allowed. Mode 2 of ZNAUPD is used |
c | (IPARAm(7) = 2). All these options can be changed |
c | by the user. For details, see the documentation |
-c | in znband. |
+c | in znband . |
c %---------------------------------------------------%
c
maxitr = 300
@@ -177,6 +178,14 @@ c | Construct matrices A and M in LAPACK-style |
c | banded form. |
c %--------------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call zlaset ('A', lda, n, zero, zero, a, lda)
+ call zlaset ('A', lda, n, zero, zero, m, lda)
+ call zlaset ('A', lda, n, zero, zero, fac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -185,20 +194,17 @@ c %-------------------------------------%
c
kl = 1
ku = 1
- call zlaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call zlaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call zlaset('A', 2*kl+ku+1, n, zero, zero, fac, lda)
c
c %---------------%
c | Main diagonal |
c %---------------%
c
- h = one / dcmplx(n+1)
+ h = one / dcmplx (n+1)
c
idiag = kl+ku+1
do 30 j = 1, n
- a(idiag,j) = (2.0D+0, 0.0D+0) / h
- m(idiag,j) = (4.0D+0, 0.0D+0) * h
+ a(idiag,j) = (2.0D+0, 0.0D+0) / h
+ m(idiag,j) = (4.0D+0, 0.0D+0) * h
30 continue
c
c %-------------------------------------%
@@ -207,7 +213,7 @@ c %-------------------------------------%
c
isup = kl+ku
isub = kl+ku+2
- rho = (1.0D+1, 0.0D+0)
+ rho = (1.0D+1, 0.0D+0)
do 40 j = 1, n-1
a(isup,j+1) = -one/h + rho/two
a(isub,j) = -one/h - rho/two
@@ -224,7 +230,7 @@ c | columns of V. |
c %-----------------------------------------------%
c
rvec = .true.
- call znband(rvec, 'A', select, d, v, ldv, sigma,
+ call znband (rvec, 'A', select, d, v, ldv, sigma,
& workev, n, a, m, lda, fac, kl, ku, which,
& bmat, nev, tol, resid, ncv, v, ldv, iparam,
& workd, workl, lworkl, rwork, iwork, info)
@@ -261,27 +267,27 @@ c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
- call zgbmv('Notranspose', n, n, kl, ku, one,
+ call zgbmv ('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
- call zgbmv('Notranspose', n, n, kl, ku, one,
+ call zgbmv ('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j), 1, zero,
& mx, 1)
- call zaxpy(n, -d(j), mx, 1, ax, 1)
- rd(j,1) = dble(d(j))
- rd(j,2) = dimag(d(j))
- rd(j,3) = dznrm2(n, ax, 1)
- rd(j,3) = rd(j,3) / dlapy2(rd(j,1), rd(j,2))
+ call zaxpy (n, -d(j), mx, 1, ax, 1)
+ rd(j,1) = dble (d(j))
+ rd(j,2) = dimag (d(j))
+ rd(j,3) = dznrm2 (n, ax, 1)
+ rd(j,3) = rd(j,3) / dlapy2 (rd(j,1), rd(j,2))
50 continue
- call dmout(6, nconv, 3, rd, maxncv, -6,
+ call dmout (6, nconv, 3, rd, maxncv, -6,
& 'Ritz values (Real,Imag) and relative residuals')
else
c
c %-------------------------------------%
c | Either convergence failed, or there |
c | is error. Check the documentation |
-c | for znband. |
+c | for znband . |
c %-------------------------------------%
c
print *, ' '
diff --git a/EXAMPLES/BAND/znbdr4.f b/EXAMPLES/BAND/znbdr4.f
index 2fb0d3f..a0247b2 100644
--- a/EXAMPLES/BAND/znbdr4.f
+++ b/EXAMPLES/BAND/znbdr4.f
@@ -1,4 +1,4 @@
- program zndrv4
+ program zndrv4
c
c ... Construct matrices A and M in LAPACK-style band form.
c Matries A and M are derived from the finite
@@ -8,20 +8,20 @@ c (d^2u/dx^2) + rho*(du/dx)
c on the interval [0,1] with zero boundary condition using
c piecewise linear elements.
c
-c ... Call ZNBAND to find eigenvalues LAMBDA such that
+c ... Call ZNBAND to find eigenvalues LAMBDA such that
c A*x = M*x*LAMBDA.
c
-c ... Use mode 3 of ZNAUPD.
+c ... Use mode 3 of ZNAUPD .
c
c\BeginLib
c
c\Routines called:
-c znband ARPACK banded eigenproblem solver.
-c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c zlaset LAPACK routine to initialize a matrix to zero.
-c zaxpy Level 1 BLAS that computes y <- alpha*x+y.
-c dznrm2 Level 1 BLAS that computes the norm of a vector.
-c zgbmv Level 2 BLAS that computes the band matrix vector product.
+c znband ARPACK banded eigenproblem solver.
+c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
+c zlaset LAPACK routine to initialize a matrix to zero.
+c zaxpy Level 1 BLAS that computes y <- alpha*x+y.
+c dznrm2 Level 1 BLAS that computes the norm of a vector.
+c zgbmv Level 2 BLAS that computes the band matrix vector product.
c
c\Author
c Richard Lehoucq
@@ -32,8 +32,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: nbdr4.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -64,12 +64,12 @@ c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
- Complex*16
+ Complex*16
& a(lda,maxn), m(lda,maxn), fac(lda,maxn),
& workl(3*maxncv*maxncv+5*maxncv), workd(3*maxn),
& workev(2*maxncv), v(ldv, maxncv),
& resid(maxn), d(maxncv), ax(maxn), mx(maxn)
- Double precision
+ Double precision
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
@@ -81,27 +81,30 @@ c
& n, idiag, isup, isub, maxitr, mode,
& nconv
logical rvec
- Double precision
+ Double precision
& tol
- Complex*16
+ Complex*16
& rho, h, sigma
c
c %------------%
c | Parameters |
c %------------%
c
- Complex*16
- & one, zero, two
- parameter (one = (1.0D+0, 0.0D+0), zero = (0.0D+0, 0.0D+0),
- & two = (2.0D+0, 0.0D+0))
+ Complex*16
+ & one, zero, two, four, six
+ parameter (one = (1.0D+0, 0.0D+0) ,
+ & zero = (0.0D+0, 0.0D+0) ,
+ & two = (2.0D+0, 0.0D+0) ,
+ & four = (4.0D+0, 0.0D+0) ,
+ & six = (6.0D+0, 0.0D+0) )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Double precision
- & dznrm2, dlapy2
- external dznrm2, zgbmv, zaxpy, dlapy2
+ Double precision
+ & dznrm2 , dlapy2
+ external dznrm2 , zgbmv , zaxpy , dlapy2 , zlaset
c
c %-----------------------%
c | Executable Statements |
@@ -142,10 +145,10 @@ c
end if
bmat = 'G'
which = 'LM'
- sigma = (1.0D+1, 0.0D+0)
+ sigma = (1.0D+1, 0.0D+0)
c
c %----------------------------------------------------%
-c | The work array WORKL is used in ZNAUPD as |
+c | The work array WORKL is used in ZNAUPD as |
c | workspace. Its dimension LWORKL has to be set as |
c | illustrated below. The parameter TOL determines |
c | the stopping criterion. If TOL<=0, machine machine |
@@ -160,10 +163,10 @@ c
c
c %---------------------------------------------------%
c | IPARAm(3) specifies the maximum number of Arnoldi |
-c | iterations allowed. Mode 3 of ZNAUPD is used |
+c | iterations allowed. Mode 3 of ZNAUPD is used |
c | (IPARAm(7) = 3). All these options can be changed |
c | by the user. For details, see the documentation |
-c | in znband. |
+c | in znband . |
c %---------------------------------------------------%
c
maxitr = 300
@@ -177,6 +180,14 @@ c | Construct matrices A and M in LAPACK-style |
c | banded form. |
c %--------------------------------------------%
c
+c %---------------------------------------------%
+c | Zero out the workspace for banded matrices. |
+c %---------------------------------------------%
+c
+ call zlaset ('A', lda, n, zero, zero, a, lda)
+ call zlaset ('A', lda, n, zero, zero, m, lda)
+ call zlaset ('A', lda, n, zero, zero, fac, lda)
+c
c %-------------------------------------%
c | KU, KL are number of superdiagonals |
c | and subdiagonals within the band of |
@@ -185,19 +196,16 @@ c %-------------------------------------%
c
kl = 1
ku = 1
- call zlaset('A', 2*kl+ku+1, n, zero, zero, a, lda)
- call zlaset('A', 2*kl+ku+1, n, zero, zero, m, lda)
- call zlaset('A', 2*kl+ku+1, n, zero, zero, fac, lda)
c
c %---------------%
c | Main diagonal |
c %---------------%
c
- h = one / dcmplx(n+1)
+ h = one / dcmplx (n+1)
idiag = kl+ku+1
do 30 j = 1, n
- a(idiag,j) = (2.0D+0, 0.0D+0) / h
- m(idiag,j) = (4.0D+0, 0.0D+0) * h
+ a(idiag,j) = two / h
+ m(idiag,j) = four * h / six
30 continue
c
c %-------------------------------------%
@@ -206,12 +214,12 @@ c %-------------------------------------%
c
isup = kl+ku
isub = kl+ku+2
- rho = (1.0D+1, 0.0D+0)
+ rho = (1.0D+1, 0.0D+0)
do 40 j = 1, n-1
a(isup,j+1) = -one/h + rho/two
a(isub,j) = -one/h - rho/two
- m(isup,j+1) = one*h
- m(isub,j) = one*h
+ m(isup,j+1) = one*h / six
+ m(isub,j) = one*h / six
40 continue
c
c %-----------------------------------------------%
@@ -223,7 +231,7 @@ c | columns of V. |
c %-----------------------------------------------%
c
rvec = .true.
- call znband(rvec, 'A', select, d, v, ldv, sigma,
+ call znband (rvec, 'A', select, d, v, ldv, sigma,
& workev, n, a, m, lda, fac, kl, ku, which,
& bmat, nev, tol, resid, ncv, v, ldv, iparam,
& workd, workl, lworkl, rwork, iwork, info)
@@ -260,27 +268,27 @@ c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
- call zgbmv('Notranspose', n, n, kl, ku, one,
+ call zgbmv ('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
- call zgbmv('Notranspose', n, n, kl, ku, one,
+ call zgbmv ('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j), 1, zero,
& mx, 1)
- call zaxpy(n, -d(j), mx, 1, ax, 1)
- rd(j,1) = dble(d(j))
- rd(j,2) = dimag(d(j))
- rd(j,3) = dznrm2(n, ax, 1)
- rd(j,3) = rd(j,3) / dlapy2(rd(j,1), rd(j,2))
+ call zaxpy (n, -d(j), mx, 1, ax, 1)
+ rd(j,1) = dble (d(j))
+ rd(j,2) = dimag (d(j))
+ rd(j,3) = dznrm2 (n, ax, 1)
+ rd(j,3) = rd(j,3) / dlapy2 (rd(j,1), rd(j,2))
90 continue
- call dmout(6, nconv, 3, rd, maxncv, -6,
+ call dmout (6, nconv, 3, rd, maxncv, -6,
& 'Ritz values (Real,Imag) and relative residuals')
else
c
c %-------------------------------------%
c | Either convergence failed, or there |
c | is error. Check the documentation |
-c | for znband. |
+c | for znband . |
c %-------------------------------------%
c
print *, ' '
diff --git a/EXAMPLES/COMPLEX/cndrv1.f b/EXAMPLES/COMPLEX/cndrv1.f
index 07124df..8493d38 100644
--- a/EXAMPLES/COMPLEX/cndrv1.f
+++ b/EXAMPLES/COMPLEX/cndrv1.f
@@ -43,7 +43,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: ndrv1.F SID: 2.2 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: ndrv1.F SID: 2.4 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -69,12 +69,12 @@ c %--------------%
c
integer iparam(11), ipntr(14)
logical select(maxncv)
- Complex
+ Complex
& ax(maxn), d(maxncv),
& v(ldv,maxncv), workd(3*maxn),
& workev(3*maxncv), resid(maxn),
& workl(3*maxncv*maxncv+5*maxncv)
- Real
+ Real
& rwork(maxncv), rd(maxncv,3)
c
c %---------------%
@@ -84,9 +84,9 @@ c
character bmat*1, which*2
integer ido, n, nx, nev, ncv, lworkl, info, j,
& ierr, nconv, maxitr, ishfts, mode
- Complex
+ Complex
& sigma
- Real
+ Real
& tol
logical rvec
c
@@ -94,7 +94,7 @@ c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Real
+ Real
& scnrm2, slapy2
external scnrm2, caxpy, slapy2
c
@@ -289,7 +289,7 @@ c %---------------------------%
c
call av(nx, v(1,j), ax)
call caxpy(n, -d(j), v(1,j), 1, ax, 1)
- rd(j,1) = real(d(j))
+ rd(j,1) = real (d(j))
rd(j,2) = aimag(d(j))
rd(j,3) = scnrm2(n, ax, 1)
rd(j,3) = rd(j,3) / slapy2(rd(j,1),rd(j,2))
@@ -313,8 +313,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
@@ -354,9 +354,9 @@ c discretized using centered difference.
c
subroutine av (nx, v, w)
integer nx, j, lo
- Complex
+ Complex
& v(nx*nx), w(nx*nx), one, h2
- parameter (one = (1.0E+0, 0.0E+0))
+ parameter (one = (1.0E+0, 0.0E+0) )
external caxpy, tv
c
c Computes w <--- OP*v, where OP is the nx*nx by nx*nx block
@@ -397,12 +397,13 @@ c=========================================================================
subroutine tv (nx, x, y)
c
integer nx, j
- Complex
+ Complex
& x(nx), y(nx), h, h2, dd, dl, du
c
- Complex
+ Complex
& one, rho
- parameter (one = (1.0E+0, 0.0E+0), rho = (1.0E+2, 0.0E+0))
+ parameter (one = (1.0E+0, 0.0E+0) ,
+ & rho = (1.0E+2, 0.0E+0) )
c
c Compute the matrix vector multiplication y<---T*x
c where T is a nx by nx tridiagonal matrix with DD on the
@@ -410,9 +411,9 @@ c diagonal, DL on the subdiagonal, and DU on the superdiagonal
c
h = one / cmplx(nx+1)
h2 = h*h
- dd = (4.0E+0, 0.0E+0) / h2
- dl = -one/h2 - (5.0E-1, 0.0E+0)*rho/h
- du = -one/h2 + (5.0E-1, 0.0E+0)*rho/h
+ dd = (4.0E+0, 0.0E+0) / h2
+ dl = -one/h2 - (5.0E-1, 0.0E+0) *rho/h
+ du = -one/h2 + (5.0E-1, 0.0E+0) *rho/h
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
diff --git a/EXAMPLES/COMPLEX/cndrv2.f b/EXAMPLES/COMPLEX/cndrv2.f
index 98073d0..509d046 100644
--- a/EXAMPLES/COMPLEX/cndrv2.f
+++ b/EXAMPLES/COMPLEX/cndrv2.f
@@ -42,7 +42,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: ndrv2.F SID: 2.2 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: ndrv2.F SID: 2.6 DATE OF SID: 10/18/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -69,14 +69,14 @@ c %--------------%
c
integer iparam(11), ipntr(14), ipiv(maxn)
logical select(maxncv)
- Complex
+ Complex
& ax(maxn), d(maxncv), resid(maxn),
& v(ldv, maxncv), workd(3*maxn),
& workev(2*maxncv),
& workl(3*maxncv*maxncv+5*maxncv),
& dd(maxn), dl(maxn), du(maxn),
& du2(maxn)
- Real
+ Real
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
@@ -86,11 +86,11 @@ c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, j, ierr,
& nconv, maxitr, ishfts, mode
- Complex
+ Complex
& h, h2, s, sigma, s1, s2, s3, rho
common /convct/ rho
c
- Real
+ Real
& tol
logical rvec
c
@@ -98,19 +98,20 @@ c %------------%
c | Parameters |
c %------------%
c
- Complex
+ Complex
& one, zero, two
- parameter (one = (1.0E+0, 0.0E+0),
- & zero = (0.0E+0, 0.0E+0),
- & two = (2.0E+0, 0.0E+0))
+ parameter (one = (1.0E+0, 0.0E+0) ,
+ & zero = (0.0E+0, 0.0E+0) ,
+ & two = (2.0E+0, 0.0E+0) )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Real
+ Real
& scnrm2, slapy2
- external cgttrf, cgttrs, caxpy, ccopy, scnrm2, slapy2
+ external cgttrf, cgttrs, caxpy, ccopy, scnrm2,
+ & slapy2
c
c %-----------------------%
c | Executable statements |
@@ -154,12 +155,12 @@ c | Construct C = A - SIGMA*I, factor C in complex |
c | arithmetic (using LAPACK subroutine cgttrf). The |
c | matrix A is chosen to be the tridiagonal matrix |
c | derived from standard central difference of the |
-c | 1-d convection diffusion operator - u" + rho*u' on |
+c | 1-d convection diffusion operator - u``+ rho*u` on |
c | the interval [0, 1] with zero Dirichlet boundary |
c | condition. |
c %----------------------------------------------------%
c
- rho = (1.0E+1, 0.0E+0)
+ rho = (1.0E+1, 0.0E+0)
h = one / cmplx(n+1)
h2 = h*h
s = rho / two
@@ -341,7 +342,7 @@ c %---------------------------%
c
call av(n, v(1,j), ax)
call caxpy(n, -d(j), v(1,j), 1, ax, 1)
- rd(j,1) = real(d(j))
+ rd(j,1) = real (d(j))
rd(j,2) = aimag(d(j))
rd(j,3) = scnrm2(n, ax, 1)
rd(j,3) = rd(j,3) / slapy2(rd(j,1),rd(j,2))
@@ -366,8 +367,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
@@ -404,10 +405,11 @@ c matrix vector multiplication subroutine
c
subroutine av (n, v, w)
integer n, j
- Complex
+ Complex
& v(n), w(n), rho, two, one, dd, dl, du, s, h,
& h2
- parameter (one = (1.0E+0, 0.0E+0), two = (2.0E+0, 0.0E+0))
+ parameter (one = (1.0E+0, 0.0E+0) ,
+ & two = (2.0E+0, 0.0E+0) )
common /convct/ rho
c
h = one / cmplx(n+1)
diff --git a/EXAMPLES/COMPLEX/cndrv3.f b/EXAMPLES/COMPLEX/cndrv3.f
index 58ecd4b..bf8fd7f 100644
--- a/EXAMPLES/COMPLEX/cndrv3.f
+++ b/EXAMPLES/COMPLEX/cndrv3.f
@@ -42,7 +42,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: ndrv3.F SID: 2.2 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: ndrv3.F SID: 2.4 DATE OF SID: 10/18/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -69,13 +69,13 @@ c %--------------%
c
integer iparam(11), ipntr(14), ipiv(maxn)
logical select(maxncv)
- Complex
+ Complex
& ax(maxn), mx(maxn), d(maxncv), resid(maxn),
& v(ldv,maxncv), workd(3*maxn),
& workev(2*maxncv),
& workl(3*maxncv*maxncv+5*maxncv),
& dd(maxn), dl(maxn), du(maxn), du2(maxn)
- Real
+ Real
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
@@ -85,9 +85,9 @@ c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, ierr, j,
& nconv, maxitr, ishfts, mode
- Complex
+ Complex
& sigma, h
- Real
+ Real
& tol
logical rvec
c
@@ -95,18 +95,19 @@ c %------------%
c | Parameters |
c %------------%
c
- Complex
+ Complex
& zero, one
- parameter (zero = (0.0E+0, 0.0E+0),
- & one = (1.0E+0, 0.0E+0))
+ parameter (zero = (0.0E+0, 0.0E+0) ,
+ & one = (1.0E+0, 0.0E+0) )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Real
+ Real
& scnrm2, slapy2
- external caxpy, ccopy, scnrm2, cgttrf, cgttrs, slapy2
+ external caxpy, ccopy, scnrm2, cgttrf, cgttrs,
+ & slapy2
c
c %-----------------------%
c | Executable Statements |
@@ -152,10 +153,10 @@ c
h = one / cmplx(n+1)
do 20 j = 1, n-1
dl(j) = one*h
- dd(j) = (4.0E+0, 0.0E+0)*h
+ dd(j) = (4.0E+0, 0.0E+0) *h
du(j) = one*h
20 continue
- dd(n) = (4.0E+0, 0.0E+0)*h
+ dd(n) = (4.0E+0, 0.0E+0) *h
c
call cgttrf(n, dl, dd, du, du2, ipiv, ierr)
if ( ierr .ne. 0 ) then
@@ -344,7 +345,7 @@ c
call av(n, v(1,j), ax)
call mv(n, v(1,j), mx)
call caxpy(n, -d(j), mx, 1, ax, 1)
- rd(j,1) = real(d(j))
+ rd(j,1) = real (d(j))
rd(j,2) = aimag(d(j))
rd(j,3) = scnrm2(n, ax, 1)
rd(j,3) = rd(j,3) / slapy2(rd(j,1),rd(j,2))
@@ -369,8 +370,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
@@ -403,10 +404,11 @@ c matrix vector multiplication subroutine
c
subroutine av (n, v, w)
integer n, j
- Complex
+ Complex
& v(n), w(n), one, two, dd, dl, du, s, h, rho
- parameter (one = (1.0E+0, 0.0E+0), two = (2.0E+0, 0.0E+0),
- & rho = (1.0E+1, 0.0E+0))
+ parameter (one = (1.0E+0, 0.0E+0) ,
+ & two = (2.0E+0, 0.0E+0) ,
+ & rho = (1.0E+1, 0.0E+0) )
c
c Compute the matrix vector multiplication y<---A*x
c where A is the stiffness matrix formed by using piecewise linear
@@ -428,10 +430,10 @@ c
c------------------------------------------------------------------------
subroutine mv (n, v, w)
integer n, j
- Complex
+ Complex
& v(n), w(n), one, four, h
- parameter (one = (1.0E+0, 0.0E+0),
- & four = (4.0E+0, 0.0E+0))
+ parameter (one = (1.0E+0, 0.0E+0) ,
+ & four = (4.0E+0, 0.0E+0) )
c
c Compute the matrix vector multiplication y<---M*x
c where M is the mass matrix formed by using piecewise linear elements
diff --git a/EXAMPLES/COMPLEX/cndrv4.f b/EXAMPLES/COMPLEX/cndrv4.f
index 64821a7..e1b06cb 100644
--- a/EXAMPLES/COMPLEX/cndrv4.f
+++ b/EXAMPLES/COMPLEX/cndrv4.f
@@ -45,7 +45,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: ndrv4.F SID: 2.2 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: ndrv4.F SID: 2.4 DATE OF SID: 10/18/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -72,14 +72,14 @@ c %--------------%
c
integer iparam(11), ipntr(14), ipiv(maxn)
logical select(maxncv)
- Complex
+ Complex
& ax(maxn), mx(maxn), d(maxncv),
& v(ldv,maxncv), workd(3*maxn), resid(maxn),
& workev(2*maxncv),
& workl(3*maxncv*maxncv+5*maxncv),
& dd(maxn), dl(maxn), du(maxn),
& du2(maxn)
- Real
+ Real
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
@@ -89,12 +89,12 @@ c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, j, ierr,
& nconv, maxitr, ishfts, mode
- Complex
+ Complex
& rho, h, s,
& sigma, s1, s2, s3
common /convct/ rho
c
- Real
+ Real
& tol
logical rvec
c
@@ -102,19 +102,22 @@ c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Real
+ Real
& scnrm2, slapy2
- external scnrm2, caxpy, ccopy, cgttrf, cgttrs, slapy2
+ external scnrm2, caxpy, ccopy, cgttrf, cgttrs,
+ & slapy2
c
c %------------%
c | Parameters |
c %------------%
c
- Complex
- & one, zero, two
- parameter (one = (1.0E+0, 0.0E+0),
- & zero = (0.0E+0, 0.0E+0),
- & two = (2.0E+0, 0.0E+0))
+ Complex
+ & one, zero, two, four, six
+ parameter (one = (1.0E+0, 0.0E+0) ,
+ & zero = (0.0E+0, 0.0E+0) ,
+ & two = (2.0E+0, 0.0E+0) ,
+ & four = (4.0E+0, 0.0E+0) ,
+ & six = (6.0E+0, 0.0E+0) )
c
c %-----------------------%
c | Executable statements |
@@ -158,20 +161,20 @@ c | Factor C in COMPLEX arithmetic (using LAPACK |
c | subroutine cgttrf). The matrix A is chosen to be |
c | the tridiagonal matrix derived from the standard |
c | central difference discretization of the 1-d |
-c | convection-diffusion operator u" + rho*u' on the |
+c | convection-diffusion operator u``+ rho*u` on the |
c | interval [0, 1] with zero Dirichlet boundary |
c | condition. The matrix M is chosen to be the |
c | symmetric tridiagonal matrix with 4.0 on the |
c | diagonal and 1.0 on the off-diagonals. |
c %--------------------------------------------------%
c
- rho = (1.0E+1, 0.0E+0)
+ rho = (1.0E+1, 0.0E+0)
h = one / cmplx(n+1)
s = rho / two
c
- s1 = -one/h - s - sigma*h
- s2 = two/h - (4.0E+0, 0.0E+0)*sigma*h
- s3 = -one/h + s - sigma*h
+ s1 = -one/h - s - sigma*h/six
+ s2 = two/h - four*sigma*h/six
+ s3 = -one/h + s - sigma*h/six
c
do 10 j = 1, n-1
dl(j) = s1
@@ -383,7 +386,7 @@ c
call av(n, v(1,j), ax)
call mv(n, v(1,j), mx)
call caxpy(n, -d(j), mx, 1, ax, 1)
- rd(j,1) = real(d(j))
+ rd(j,1) = real (d(j))
rd(j,2) = aimag(d(j))
rd(j,3) = scnrm2(n, ax, 1)
rd(j,3) = rd(j,3) / slapy2(rd(j,1),rd(j,2))
@@ -408,8 +411,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
@@ -442,20 +445,21 @@ c matrix vector multiplication subroutine
c
subroutine mv (n, v, w)
integer n, j
- Complex
- & v(n), w(n), one, four, h
- parameter (one = (1.0E+0, 0.0E+0),
- & four = (4.0E+0, 0.0E+0))
+ Complex
+ & v(n), w(n), one, four, six, h
+ parameter (one = (1.0E+0, 0.0E+0) ,
+ & four = (4.0E+0, 0.0E+0) ,
+ & six = (6.0E+0, 0.0E+0) )
c
c Compute the matrix vector multiplication y<---M*x
c where M is a n by n symmetric tridiagonal matrix with 4 on the
c diagonal, 1 on the subdiagonal and superdiagonal.
c
- w(1) = four*v(1) + one*v(2)
+ w(1) = ( four*v(1) + one*v(2) ) / six
do 40 j = 2,n-1
- w(j) = one*v(j-1) + four*v(j) + one*v(j+1)
+ w(j) = ( one*v(j-1) + four*v(j) + one*v(j+1) ) / six
40 continue
- w(n) = one*v(n-1) + four*v(n)
+ w(n) = ( one*v(n-1) + four*v(n) ) / six
c
h = one / cmplx(n+1)
call cscal(n, h, w, 1)
@@ -464,10 +468,10 @@ c
c------------------------------------------------------------------
subroutine av (n, v, w)
integer n, j
- Complex
+ Complex
& v(n), w(n), one, two, dd, dl, du, s, h, rho
- parameter (one = (1.0E+0, 0.0E+0),
- & two = (2.0E+0, 0.0E+0))
+ parameter (one = (1.0E+0, 0.0E+0) ,
+ & two = (2.0E+0, 0.0E+0) )
common /convct/ rho
c
h = one / cmplx(n+1)
diff --git a/EXAMPLES/COMPLEX/zndrv1.f b/EXAMPLES/COMPLEX/zndrv1.f
index 06cbace..4622440 100644
--- a/EXAMPLES/COMPLEX/zndrv1.f
+++ b/EXAMPLES/COMPLEX/zndrv1.f
@@ -1,4 +1,4 @@
- program zndrv1
+ program zndrv1
c
c Example program to illustrate the idea of reverse communication
c for a standard complex nonsymmetric eigenvalue problem.
@@ -17,17 +17,17 @@ c ... OP = A and B = I.
c
c ... Assume "call av (nx,x,y)" computes y = A*x
c
-c ... Use mode 1 of ZNAUPD.
+c ... Use mode 1 of ZNAUPD .
c
c\BeginLib
c
c\Routines called
-c znaupd ARPACK reverse communication interface routine.
-c zneupd ARPACK routine that returns Ritz values and (optionally)
+c znaupd ARPACK reverse communication interface routine.
+c zneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
-c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c dznrm2 Level 1 BLAS that computes the norm of a complex vector.
-c zaxpy Level 1 BLAS that computes y <- alpha*x+y.
+c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
+c dznrm2 Level 1 BLAS that computes the norm of a complex vector.
+c zaxpy Level 1 BLAS that computes y <- alpha*x+y.
c av Matrix vector multiplication routine that computes A*x.
c tv Matrix vector multiplication routine that computes T*x,
c where T is a tridiagonal matrix. It is used in routine
@@ -43,7 +43,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: ndrv1.F SID: 2.2 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: ndrv1.F SID: 2.4 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -69,12 +69,12 @@ c %--------------%
c
integer iparam(11), ipntr(14)
logical select(maxncv)
- Complex*16
+ Complex*16
& ax(maxn), d(maxncv),
& v(ldv,maxncv), workd(3*maxn),
& workev(3*maxncv), resid(maxn),
& workl(3*maxncv*maxncv+5*maxncv)
- Double precision
+ Double precision
& rwork(maxncv), rd(maxncv,3)
c
c %---------------%
@@ -84,9 +84,9 @@ c
character bmat*1, which*2
integer ido, n, nx, nev, ncv, lworkl, info, j,
& ierr, nconv, maxitr, ishfts, mode
- Complex*16
+ Complex*16
& sigma
- Double precision
+ Double precision
& tol
logical rvec
c
@@ -94,9 +94,9 @@ c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Double precision
- & dznrm2, dlapy2
- external dznrm2, zaxpy, dlapy2
+ Double precision
+ & dznrm2 , dlapy2
+ external dznrm2 , zaxpy , dlapy2
c
c %-----------------------%
c | Executable Statements |
@@ -138,7 +138,7 @@ c
which = 'LM'
c
c %---------------------------------------------------%
-c | The work array WORKL is used in ZNAUPD as |
+c | The work array WORKL is used in ZNAUPD as |
c | workspace. Its dimension LWORKL is set as |
c | illustrated below. The parameter TOL determines |
c | the stopping criterion. If TOL<=0, machine |
@@ -157,10 +157,10 @@ c %---------------------------------------------------%
c | This program uses exact shift with respect to |
c | the current Hessenberg matrix (IPARAM(1) = 1). |
c | IPARAM(3) specifies the maximum number of Arnoldi |
-c | iterations allowed. Mode 1 of ZNAUPD is used |
+c | iterations allowed. Mode 1 of ZNAUPD is used |
c | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details see the documentation in |
-c | ZNAUPD. |
+c | ZNAUPD . |
c %---------------------------------------------------%
c
ishfts = 1
@@ -178,13 +178,13 @@ c
10 continue
c
c %---------------------------------------------%
-c | Repeatedly call the routine ZNAUPD and take |
+c | Repeatedly call the routine ZNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
- call znaupd ( ido, bmat, n, which, nev, tol, resid, ncv,
+ call znaupd ( ido, bmat, n, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& rwork,info )
c
@@ -203,7 +203,7 @@ c
call av (nx, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
-c | L O O P B A C K to call ZNAUPD again. |
+c | L O O P B A C K to call ZNAUPD again. |
c %-----------------------------------------%
c
go to 10
@@ -219,7 +219,7 @@ c
c
c %--------------------------%
c | Error message, check the |
-c | documentation in ZNAUPD |
+c | documentation in ZNAUPD |
c %--------------------------%
c
print *, ' '
@@ -231,7 +231,7 @@ c
c
c %-------------------------------------------%
c | No fatal errors occurred. |
-c | Post-Process using ZNEUPD. |
+c | Post-Process using ZNEUPD . |
c | |
c | Computed eigenvalues may be extracted. |
c | |
@@ -241,7 +241,7 @@ c %-------------------------------------------%
c
rvec = .true.
c
- call zneupd (rvec, 'A', select, d, v, ldv, sigma,
+ call zneupd (rvec, 'A', select, d, v, ldv, sigma,
& workev, bmat, n, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& rwork, ierr)
@@ -261,7 +261,7 @@ c
c
c %------------------------------------%
c | Error condition: |
-c | Check the documentation of ZNEUPD. |
+c | Check the documentation of ZNEUPD . |
c %------------------------------------%
c
print *, ' '
@@ -288,18 +288,18 @@ c | tolerance) |
c %---------------------------%
c
call av(nx, v(1,j), ax)
- call zaxpy(n, -d(j), v(1,j), 1, ax, 1)
- rd(j,1) = dble(d(j))
- rd(j,2) = dimag(d(j))
- rd(j,3) = dznrm2(n, ax, 1)
- rd(j,3) = rd(j,3) / dlapy2(rd(j,1),rd(j,2))
+ call zaxpy (n, -d(j), v(1,j), 1, ax, 1)
+ rd(j,1) = dble (d(j))
+ rd(j,2) = dimag (d(j))
+ rd(j,3) = dznrm2 (n, ax, 1)
+ rd(j,3) = rd(j,3) / dlapy2 (rd(j,1),rd(j,2))
20 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
- call dmout(6, nconv, 3, rd, maxncv, -6,
+ call dmout (6, nconv, 3, rd, maxncv, -6,
& 'Ritz values (Real, Imag) and relative residuals')
end if
c
@@ -313,8 +313,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
@@ -338,7 +338,7 @@ c
end if
c
c %---------------------------%
-c | Done with program zndrv1. |
+c | Done with program zndrv1 . |
c %---------------------------%
c
9000 continue
@@ -354,10 +354,10 @@ c discretized using centered difference.
c
subroutine av (nx, v, w)
integer nx, j, lo
- Complex*16
+ Complex*16
& v(nx*nx), w(nx*nx), one, h2
- parameter (one = (1.0D+0, 0.0D+0))
- external zaxpy, tv
+ parameter (one = (1.0D+0, 0.0D+0) )
+ external zaxpy , tv
c
c Computes w <--- OP*v, where OP is the nx*nx by nx*nx block
c tridiagonal matrix
@@ -375,21 +375,21 @@ c
c The subroutine TV is called to computed y<---T*x.
c
c
- h2 = one / dcmplx((nx+1)*(nx+1))
+ h2 = one / dcmplx ((nx+1)*(nx+1))
c
call tv(nx,v(1),w(1))
- call zaxpy(nx, -one/h2, v(nx+1), 1, w(1), 1)
+ call zaxpy (nx, -one/h2, v(nx+1), 1, w(1), 1)
c
do 10 j = 2, nx-1
lo = (j-1)*nx
call tv(nx, v(lo+1), w(lo+1))
- call zaxpy(nx, -one/h2, v(lo-nx+1), 1, w(lo+1), 1)
- call zaxpy(nx, -one/h2, v(lo+nx+1), 1, w(lo+1), 1)
+ call zaxpy (nx, -one/h2, v(lo-nx+1), 1, w(lo+1), 1)
+ call zaxpy (nx, -one/h2, v(lo+nx+1), 1, w(lo+1), 1)
10 continue
c
lo = (nx-1)*nx
call tv(nx, v(lo+1), w(lo+1))
- call zaxpy(nx, -one/h2, v(lo-nx+1), 1, w(lo+1), 1)
+ call zaxpy (nx, -one/h2, v(lo-nx+1), 1, w(lo+1), 1)
c
return
end
@@ -397,22 +397,23 @@ c=========================================================================
subroutine tv (nx, x, y)
c
integer nx, j
- Complex*16
+ Complex*16
& x(nx), y(nx), h, h2, dd, dl, du
c
- Complex*16
+ Complex*16
& one, rho
- parameter (one = (1.0D+0, 0.0D+0), rho = (1.0D+2, 0.0D+0))
+ parameter (one = (1.0D+0, 0.0D+0) ,
+ & rho = (1.0D+2, 0.0D+0) )
c
c Compute the matrix vector multiplication y<---T*x
c where T is a nx by nx tridiagonal matrix with DD on the
c diagonal, DL on the subdiagonal, and DU on the superdiagonal
c
- h = one / dcmplx(nx+1)
+ h = one / dcmplx (nx+1)
h2 = h*h
- dd = (4.0D+0, 0.0D+0) / h2
- dl = -one/h2 - (5.0D-1, 0.0D+0)*rho/h
- du = -one/h2 + (5.0D-1, 0.0D+0)*rho/h
+ dd = (4.0D+0, 0.0D+0) / h2
+ dl = -one/h2 - (5.0D-1, 0.0D+0) *rho/h
+ du = -one/h2 + (5.0D-1, 0.0D+0) *rho/h
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
diff --git a/EXAMPLES/COMPLEX/zndrv2.f b/EXAMPLES/COMPLEX/zndrv2.f
index ba82505..86676ee 100644
--- a/EXAMPLES/COMPLEX/zndrv2.f
+++ b/EXAMPLES/COMPLEX/zndrv2.f
@@ -1,4 +1,4 @@
- program zndrv2
+ program zndrv2
c
c Simple program to illustrate the idea of reverse communication
c in shift-invert mode for a standard complex nonsymmetric eigenvalue
@@ -16,20 +16,20 @@ c ... The shift sigma is a complex number.
c
c ... OP = inv[A-sigma*I] and B = I.
c
-c ... Use mode 3 of ZNAUPD.
+c ... Use mode 3 of ZNAUPD .
c
c\BeginLib
c
c\Routines called:
-c znaupd ARPACK reverse communication interface routine.
-c zneupd ARPACK routine that returns Ritz values and (optionally)
+c znaupd ARPACK reverse communication interface routine.
+c zneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
-c zgttrf LAPACK tridiagonal factorization routine.
-c zgttrs LAPACK tridiagonal solve routine.
-c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c zaxpy Level 1 BLAS that computes y <- alpha*x+y.
-c zcopy Level 1 BLAS that copies one vector to another.
-c dznrm2 Level 1 BLAS that computes the norm of a vector.
+c zgttrf LAPACK tridiagonal factorization routine.
+c zgttrs LAPACK tridiagonal solve routine.
+c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
+c zaxpy Level 1 BLAS that computes y <- alpha*x+y.
+c zcopy Level 1 BLAS that copies one vector to another.
+c dznrm2 Level 1 BLAS that computes the norm of a vector.
c av Matrix vector multiplication routine that computes A*x.
c
c\Author
@@ -42,7 +42,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: ndrv2.F SID: 2.2 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: ndrv2.F SID: 2.6 DATE OF SID: 10/18/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -69,14 +69,14 @@ c %--------------%
c
integer iparam(11), ipntr(14), ipiv(maxn)
logical select(maxncv)
- Complex*16
+ Complex*16
& ax(maxn), d(maxncv), resid(maxn),
& v(ldv, maxncv), workd(3*maxn),
& workev(2*maxncv),
& workl(3*maxncv*maxncv+5*maxncv),
& dd(maxn), dl(maxn), du(maxn),
& du2(maxn)
- Double precision
+ Double precision
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
@@ -86,11 +86,11 @@ c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, j, ierr,
& nconv, maxitr, ishfts, mode
- Complex*16
+ Complex*16
& h, h2, s, sigma, s1, s2, s3, rho
common /convct/ rho
c
- Double precision
+ Double precision
& tol
logical rvec
c
@@ -98,19 +98,20 @@ c %------------%
c | Parameters |
c %------------%
c
- Complex*16
+ Complex*16
& one, zero, two
- parameter (one = (1.0D+0, 0.0D+0),
- & zero = (0.0D+0, 0.0D+0),
- & two = (2.0D+0, 0.0D+0))
+ parameter (one = (1.0D+0, 0.0D+0) ,
+ & zero = (0.0D+0, 0.0D+0) ,
+ & two = (2.0D+0, 0.0D+0) )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Double precision
- & dznrm2, dlapy2
- external zgttrf, zgttrs, zaxpy, zcopy, dznrm2, dlapy2
+ Double precision
+ & dznrm2 , dlapy2
+ external zgttrf , zgttrs , zaxpy , zcopy , dznrm2 ,
+ & dlapy2
c
c %-----------------------%
c | Executable statements |
@@ -151,16 +152,16 @@ c
c
c %----------------------------------------------------%
c | Construct C = A - SIGMA*I, factor C in complex |
-c | arithmetic (using LAPACK subroutine zgttrf). The |
+c | arithmetic (using LAPACK subroutine zgttrf ). The |
c | matrix A is chosen to be the tridiagonal matrix |
c | derived from standard central difference of the |
-c | 1-d convection diffusion operator - u" + rho*u' on |
+c | 1-d convection diffusion operator - u``+ rho*u` on |
c | the interval [0, 1] with zero Dirichlet boundary |
c | condition. |
c %----------------------------------------------------%
c
- rho = (1.0D+1, 0.0D+0)
- h = one / dcmplx(n+1)
+ rho = (1.0D+1, 0.0D+0)
+ h = one / dcmplx (n+1)
h2 = h*h
s = rho / two
c
@@ -175,7 +176,7 @@ c
10 continue
dd(n) = s2
c
- call zgttrf(n, dl, dd, du, du2, ipiv, ierr)
+ call zgttrf (n, dl, dd, du, du2, ipiv, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrf in _NDRV2.'
@@ -184,14 +185,14 @@ c
end if
c
c %-----------------------------------------------------%
-c | The work array WORKL is used in ZNAUPD as |
+c | The work array WORKL is used in ZNAUPD as |
c | workspace. Its dimension LWORKL is set as |
c | illustrated below. The parameter TOL determines |
c | the stopping criterion. If TOL<=0, machine |
c | precision is used. The variable IDO is used for |
c | reverse communication, and is initially set to 0. |
c | Setting INFO=0 indicates that a random vector is |
-c | generated in ZNAUPD to start the Arnoldi iteration. |
+c | generated in ZNAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+5*ncv
@@ -203,10 +204,10 @@ c %---------------------------------------------------%
c | This program uses exact shifts with respect to |
c | the current Hessenberg matrix (IPARAM(1) = 1). |
c | IPARAM(3) specifies the maximum number of Arnoldi |
-c | iterations allowed. Mode 3 of ZNAUPD is used |
+c | iterations allowed. Mode 3 of ZNAUPD is used |
c | (IPARAM(7) = 3). All these options can be |
c | changed by the user. For details see the |
-c | documentation in ZNAUPD. |
+c | documentation in ZNAUPD . |
c %---------------------------------------------------%
c
ishfts = 1
@@ -224,13 +225,13 @@ c
20 continue
c
c %---------------------------------------------%
-c | Repeatedly call the routine ZNAUPD and take |
+c | Repeatedly call the routine ZNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
- call znaupd ( ido, bmat, n, which, nev, tol, resid, ncv,
+ call znaupd ( ido, bmat, n, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& rwork,info )
c
@@ -244,9 +245,9 @@ c | workd(ipntr(1)) as the input, and returns |
c | the result to workd(ipntr(2)). |
c %-------------------------------------------%
c
- call zcopy( n, workd(ipntr(1)),1, workd(ipntr(2)), 1)
+ call zcopy ( n, workd(ipntr(1)),1, workd(ipntr(2)), 1)
c
- call zgttrs('N', n, 1, dl, dd, du, du2, ipiv,
+ call zgttrs ('N', n, 1, dl, dd, du, du2, ipiv,
& workd(ipntr(2)), n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
@@ -256,7 +257,7 @@ c
end if
c
c %-----------------------------------------%
-c | L O O P B A C K to call ZNAUPD again. |
+c | L O O P B A C K to call ZNAUPD again. |
c %-----------------------------------------%
c
go to 20
@@ -272,7 +273,7 @@ c
c
c %--------------------------%
c | Error message, check the |
-c | documentation in ZNAUPD |
+c | documentation in ZNAUPD |
c %--------------------------%
c
print *, ' '
@@ -284,7 +285,7 @@ c
c
c %-------------------------------------------%
c | No fatal errors occurred. |
-c | Post-Process using ZNEUPD. |
+c | Post-Process using ZNEUPD . |
c | |
c | Computed eigenvalues may be extracted. |
c | |
@@ -294,7 +295,7 @@ c %-------------------------------------------%
c
rvec = .true.
c
- call zneupd (rvec, 'A', select, d, v, ldv, sigma,
+ call zneupd (rvec, 'A', select, d, v, ldv, sigma,
& workev, bmat, n, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, rwork, ierr)
@@ -314,7 +315,7 @@ c
c
c %------------------------------------%
c | Error condition: |
-c | Check the documentation of ZNEUPD. |
+c | Check the documentation of ZNEUPD . |
c %------------------------------------%
c
print *, ' '
@@ -340,18 +341,18 @@ c | tolerance) |
c %---------------------------%
c
call av(n, v(1,j), ax)
- call zaxpy(n, -d(j), v(1,j), 1, ax, 1)
- rd(j,1) = dble(d(j))
- rd(j,2) = dimag(d(j))
- rd(j,3) = dznrm2(n, ax, 1)
- rd(j,3) = rd(j,3) / dlapy2(rd(j,1),rd(j,2))
+ call zaxpy (n, -d(j), v(1,j), 1, ax, 1)
+ rd(j,1) = dble (d(j))
+ rd(j,2) = dimag (d(j))
+ rd(j,3) = dznrm2 (n, ax, 1)
+ rd(j,3) = rd(j,3) / dlapy2 (rd(j,1),rd(j,2))
60 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
- call dmout(6, nconv, 3, rd, maxncv, -6,
+ call dmout (6, nconv, 3, rd, maxncv, -6,
& 'Ritz values (Real, Imag) and relative residuals')
c
end if
@@ -366,8 +367,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
@@ -391,7 +392,7 @@ c
end if
c
c %---------------------------%
-c | Done with program zndrv2. |
+c | Done with program zndrv2 . |
c %---------------------------%
c
9000 continue
@@ -404,13 +405,14 @@ c matrix vector multiplication subroutine
c
subroutine av (n, v, w)
integer n, j
- Complex*16
+ Complex*16
& v(n), w(n), rho, two, one, dd, dl, du, s, h,
& h2
- parameter (one = (1.0D+0, 0.0D+0), two = (2.0D+0, 0.0D+0))
+ parameter (one = (1.0D+0, 0.0D+0) ,
+ & two = (2.0D+0, 0.0D+0) )
common /convct/ rho
c
- h = one / dcmplx(n+1)
+ h = one / dcmplx (n+1)
h2 = h*h
s = rho / two
dd = two / h2
diff --git a/EXAMPLES/COMPLEX/zndrv3.f b/EXAMPLES/COMPLEX/zndrv3.f
index 4afc7c3..fdc48f9 100644
--- a/EXAMPLES/COMPLEX/zndrv3.f
+++ b/EXAMPLES/COMPLEX/zndrv3.f
@@ -1,4 +1,4 @@
- program zndrv3
+ program zndrv3
c
c Simple program to illustrate the idea of reverse communication
c in inverse mode for a generalized complex nonsymmetric eigenvalue
@@ -16,19 +16,19 @@ c piecewise linear elements.
c
c ... OP = inv[M]*A and B = M.
c
-c ... Use mode 2 of ZNAUPD.
+c ... Use mode 2 of ZNAUPD .
c
c\BeginLib
c
c\Routines called:
-c znaupd ARPACK reverse communication interface routine.
-c zneupd ARPACK routine that returns Ritz values and (optionally)
+c znaupd ARPACK reverse communication interface routine.
+c zneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
-c zgttrf LAPACK tridiagonal factorization routine.
-c zgttrs LAPACK tridiagonal solve routine.
-c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c zaxpy Level 1 BLAS that computes y <- alpha*x+y.
-c dznrm2 Level 1 BLAS that computes the norm of a vector.
+c zgttrf LAPACK tridiagonal factorization routine.
+c zgttrs LAPACK tridiagonal solve routine.
+c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
+c zaxpy Level 1 BLAS that computes y <- alpha*x+y.
+c dznrm2 Level 1 BLAS that computes the norm of a vector.
c av Matrix vector multiplication routine that computes A*x.
c mv Matrix vector multiplication routine that computes M*x.
c
@@ -42,7 +42,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: ndrv3.F SID: 2.2 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: ndrv3.F SID: 2.4 DATE OF SID: 10/18/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -69,13 +69,13 @@ c %--------------%
c
integer iparam(11), ipntr(14), ipiv(maxn)
logical select(maxncv)
- Complex*16
+ Complex*16
& ax(maxn), mx(maxn), d(maxncv), resid(maxn),
& v(ldv,maxncv), workd(3*maxn),
& workev(2*maxncv),
& workl(3*maxncv*maxncv+5*maxncv),
& dd(maxn), dl(maxn), du(maxn), du2(maxn)
- Double precision
+ Double precision
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
@@ -85,9 +85,9 @@ c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, ierr, j,
& nconv, maxitr, ishfts, mode
- Complex*16
+ Complex*16
& sigma, h
- Double precision
+ Double precision
& tol
logical rvec
c
@@ -95,18 +95,19 @@ c %------------%
c | Parameters |
c %------------%
c
- Complex*16
+ Complex*16
& zero, one
- parameter (zero = (0.0D+0, 0.0D+0),
- & one = (1.0D+0, 0.0D+0))
+ parameter (zero = (0.0D+0, 0.0D+0) ,
+ & one = (1.0D+0, 0.0D+0) )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Double precision
- & dznrm2, dlapy2
- external zaxpy, zcopy, dznrm2, zgttrf, zgttrs, dlapy2
+ Double precision
+ & dznrm2 , dlapy2
+ external zaxpy , zcopy , dznrm2 , zgttrf , zgttrs ,
+ & dlapy2
c
c %-----------------------%
c | Executable Statements |
@@ -146,18 +147,18 @@ c %-----------------------------------------------------%
c | The matrix M is chosen to be the symmetric tri- |
c | diagonal matrix with 4 on the diagonal and 1 on the |
c | off diagonals. It is factored by LAPACK subroutine |
-c | zgttrf. |
+c | zgttrf . |
c %-----------------------------------------------------%
c
- h = one / dcmplx(n+1)
+ h = one / dcmplx (n+1)
do 20 j = 1, n-1
dl(j) = one*h
- dd(j) = (4.0D+0, 0.0D+0)*h
+ dd(j) = (4.0D+0, 0.0D+0) *h
du(j) = one*h
20 continue
- dd(n) = (4.0D+0, 0.0D+0)*h
+ dd(n) = (4.0D+0, 0.0D+0) *h
c
- call zgttrf(n, dl, dd, du, du2, ipiv, ierr)
+ call zgttrf (n, dl, dd, du, du2, ipiv, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrf. '
@@ -166,14 +167,14 @@ c
end if
c
c %-----------------------------------------------------%
-c | The work array WORKL is used in ZNAUPD as |
+c | The work array WORKL is used in ZNAUPD as |
c | workspace. Its dimension LWORKL is set as |
c | illustrated below. The parameter TOL determines |
c | the stopping criterion. If TOL<=0, machine |
c | precision is used. The variable IDO is used for |
c | reverse communication, and is initially set to 0. |
c | Setting INFO=0 indicates that a random vector is |
-c | generated in ZNAUPD to start the Arnoldi iteration. |
+c | generated in ZNAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+5*ncv
@@ -185,10 +186,10 @@ c %---------------------------------------------------%
c | This program uses exact shifts with respect to |
c | the current Hessenberg matrix (IPARAM(1) = 1). |
c | IPARAM(3) specifies the maximum number of Arnoldi |
-c | iterations allowed. Mode 2 of ZNAUPD is used |
+c | iterations allowed. Mode 2 of ZNAUPD is used |
c | (IPARAM(7) = 2). All these options can be |
c | changed by the user. For details, see the |
-c | documentation in ZNAUPD. |
+c | documentation in ZNAUPD . |
c %---------------------------------------------------%
c
ishfts = 1
@@ -206,13 +207,13 @@ c
10 continue
c
c %---------------------------------------------%
-c | Repeatedly call the routine ZNAUPD and take |
+c | Repeatedly call the routine ZNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
- call znaupd ( ido, bmat, n, which, nev, tol, resid, ncv,
+ call znaupd ( ido, bmat, n, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& rwork, info )
c
@@ -229,7 +230,7 @@ c | be returned to workd(ipntr(2)). |
c %----------------------------------------%
c
call av (n, workd(ipntr(1)), workd(ipntr(2)))
- call zgttrs('N', n, 1, dl, dd, du, du2, ipiv,
+ call zgttrs ('N', n, 1, dl, dd, du, du2, ipiv,
& workd(ipntr(2)), n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
@@ -239,7 +240,7 @@ c
end if
c
c %-----------------------------------------%
-c | L O O P B A C K to call ZNAUPD again. |
+c | L O O P B A C K to call ZNAUPD again. |
c %-----------------------------------------%
c
go to 10
@@ -257,7 +258,7 @@ c
call mv (n, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
-c | L O O P B A C K to call ZNAUPD again. |
+c | L O O P B A C K to call ZNAUPD again. |
c %-----------------------------------------%
c
go to 10
@@ -273,7 +274,7 @@ c
c
c %--------------------------%
c | Error message. Check the |
-c | documentation in ZNAUPD. |
+c | documentation in ZNAUPD . |
c %--------------------------%
c
print *, ' '
@@ -285,7 +286,7 @@ c
c
c %-------------------------------------------%
c | No fatal errors occurred. |
-c | Post-Process using ZNEUPD. |
+c | Post-Process using ZNEUPD . |
c | |
c | Computed eigenvalues may be extracted. |
c | |
@@ -295,7 +296,7 @@ c %-------------------------------------------%
c
rvec = .true.
c
- call zneupd ( rvec, 'A', select, d, v, ldv, sigma,
+ call zneupd ( rvec, 'A', select, d, v, ldv, sigma,
& workev, bmat, n, which, nev, tol, resid, ncv, v,
& ldv, iparam, ipntr, workd, workl, lworkl, rwork,
& ierr )
@@ -315,7 +316,7 @@ c
c
c %------------------------------------%
c | Error condition: |
-c | Check the documentation of ZNEUPD. |
+c | Check the documentation of ZNEUPD . |
c %------------------------------------%
c
print *, ' '
@@ -343,18 +344,18 @@ c %---------------------------%
c
call av(n, v(1,j), ax)
call mv(n, v(1,j), mx)
- call zaxpy(n, -d(j), mx, 1, ax, 1)
- rd(j,1) = dble(d(j))
- rd(j,2) = dimag(d(j))
- rd(j,3) = dznrm2(n, ax, 1)
- rd(j,3) = rd(j,3) / dlapy2(rd(j,1),rd(j,2))
+ call zaxpy (n, -d(j), mx, 1, ax, 1)
+ rd(j,1) = dble (d(j))
+ rd(j,2) = dimag (d(j))
+ rd(j,3) = dznrm2 (n, ax, 1)
+ rd(j,3) = rd(j,3) / dlapy2 (rd(j,1),rd(j,2))
80 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
- call dmout(6, nconv, 3, rd, maxncv, -6,
+ call dmout (6, nconv, 3, rd, maxncv, -6,
& 'Ritz values (Real, Imag) and relative residuals')
c
end if
@@ -369,8 +370,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
@@ -403,16 +404,17 @@ c matrix vector multiplication subroutine
c
subroutine av (n, v, w)
integer n, j
- Complex*16
+ Complex*16
& v(n), w(n), one, two, dd, dl, du, s, h, rho
- parameter (one = (1.0D+0, 0.0D+0), two = (2.0D+0, 0.0D+0),
- & rho = (1.0D+1, 0.0D+0))
+ parameter (one = (1.0D+0, 0.0D+0) ,
+ & two = (2.0D+0, 0.0D+0) ,
+ & rho = (1.0D+1, 0.0D+0) )
c
c Compute the matrix vector multiplication y<---A*x
c where A is the stiffness matrix formed by using piecewise linear
c elements on [0,1].
c
- h = one / dcmplx(n+1)
+ h = one / dcmplx (n+1)
s = rho / two
dd = two / h
dl = -one/h - s
@@ -428,10 +430,10 @@ c
c------------------------------------------------------------------------
subroutine mv (n, v, w)
integer n, j
- Complex*16
+ Complex*16
& v(n), w(n), one, four, h
- parameter (one = (1.0D+0, 0.0D+0),
- & four = (4.0D+0, 0.0D+0))
+ parameter (one = (1.0D+0, 0.0D+0) ,
+ & four = (4.0D+0, 0.0D+0) )
c
c Compute the matrix vector multiplication y<---M*x
c where M is the mass matrix formed by using piecewise linear elements
@@ -443,7 +445,7 @@ c
10 continue
w(n) = one*v(n-1) + four*v(n)
c
- h = one / dcmplx(n+1)
- call zscal(n, h, w, 1)
+ h = one / dcmplx (n+1)
+ call zscal (n, h, w, 1)
return
end
diff --git a/EXAMPLES/COMPLEX/zndrv4.f b/EXAMPLES/COMPLEX/zndrv4.f
index c190c32..ebf857a 100644
--- a/EXAMPLES/COMPLEX/zndrv4.f
+++ b/EXAMPLES/COMPLEX/zndrv4.f
@@ -1,4 +1,4 @@
- program zndrv4
+ program zndrv4
c
c Simple program to illustrate the idea of reverse communication
c in shift and invert mode for a generalized complex nonsymmetric
@@ -18,20 +18,20 @@ c ... where the shift sigma is a complex number.
c
c ... OP = inv[A-SIGMA*M]*M and B = M.
c
-c ... Use mode 3 of ZNAUPD.
+c ... Use mode 3 of ZNAUPD .
c
c\BeginLib
c
c\Routines called:
-c znaupd ARPACK reverse communication interface routine.
-c zneupd ARPACK routine that returns Ritz values and (optionally)
+c znaupd ARPACK reverse communication interface routine.
+c zneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
-c zgttrf LAPACK tridiagonal factorization routine.
-c zgttrs LAPACK tridiagonal solve routine.
-c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c zaxpy Level 1 BLAS that computes y <- alpha*x+y.
-c zcopy Level 1 BLAS that copies one vector to another.
-c dznrm2 Level 1 BLAS that computes the norm of a complex vector.
+c zgttrf LAPACK tridiagonal factorization routine.
+c zgttrs LAPACK tridiagonal solve routine.
+c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
+c zaxpy Level 1 BLAS that computes y <- alpha*x+y.
+c zcopy Level 1 BLAS that copies one vector to another.
+c dznrm2 Level 1 BLAS that computes the norm of a complex vector.
c av Matrix vector multiplication routine that computes A*x.
c mv Matrix vector multiplication routine that computes M*x.
c
@@ -45,7 +45,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: ndrv4.F SID: 2.2 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: ndrv4.F SID: 2.4 DATE OF SID: 10/18/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -72,14 +72,14 @@ c %--------------%
c
integer iparam(11), ipntr(14), ipiv(maxn)
logical select(maxncv)
- Complex*16
+ Complex*16
& ax(maxn), mx(maxn), d(maxncv),
& v(ldv,maxncv), workd(3*maxn), resid(maxn),
& workev(2*maxncv),
& workl(3*maxncv*maxncv+5*maxncv),
& dd(maxn), dl(maxn), du(maxn),
& du2(maxn)
- Double precision
+ Double precision
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
@@ -89,12 +89,12 @@ c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, j, ierr,
& nconv, maxitr, ishfts, mode
- Complex*16
+ Complex*16
& rho, h, s,
& sigma, s1, s2, s3
common /convct/ rho
c
- Double precision
+ Double precision
& tol
logical rvec
c
@@ -102,19 +102,22 @@ c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Double precision
- & dznrm2, dlapy2
- external dznrm2, zaxpy, zcopy, zgttrf, zgttrs, dlapy2
+ Double precision
+ & dznrm2 , dlapy2
+ external dznrm2 , zaxpy , zcopy , zgttrf , zgttrs ,
+ & dlapy2
c
c %------------%
c | Parameters |
c %------------%
c
- Complex*16
- & one, zero, two
- parameter (one = (1.0D+0, 0.0D+0),
- & zero = (0.0D+0, 0.0D+0),
- & two = (2.0D+0, 0.0D+0))
+ Complex*16
+ & one, zero, two, four, six
+ parameter (one = (1.0D+0, 0.0D+0) ,
+ & zero = (0.0D+0, 0.0D+0) ,
+ & two = (2.0D+0, 0.0D+0) ,
+ & four = (4.0D+0, 0.0D+0) ,
+ & six = (6.0D+0, 0.0D+0) )
c
c %-----------------------%
c | Executable statements |
@@ -155,23 +158,23 @@ c
c %--------------------------------------------------%
c | Construct C = A - SIGMA*M in COMPLEX arithmetic. |
c | Factor C in COMPLEX arithmetic (using LAPACK |
-c | subroutine zgttrf). The matrix A is chosen to be |
+c | subroutine zgttrf ). The matrix A is chosen to be |
c | the tridiagonal matrix derived from the standard |
c | central difference discretization of the 1-d |
-c | convection-diffusion operator u" + rho*u' on the |
+c | convection-diffusion operator u``+ rho*u` on the |
c | interval [0, 1] with zero Dirichlet boundary |
c | condition. The matrix M is chosen to be the |
c | symmetric tridiagonal matrix with 4.0 on the |
c | diagonal and 1.0 on the off-diagonals. |
c %--------------------------------------------------%
c
- rho = (1.0D+1, 0.0D+0)
- h = one / dcmplx(n+1)
+ rho = (1.0D+1, 0.0D+0)
+ h = one / dcmplx (n+1)
s = rho / two
c
- s1 = -one/h - s - sigma*h
- s2 = two/h - (4.0D+0, 0.0D+0)*sigma*h
- s3 = -one/h + s - sigma*h
+ s1 = -one/h - s - sigma*h/six
+ s2 = two/h - four*sigma*h/six
+ s3 = -one/h + s - sigma*h/six
c
do 10 j = 1, n-1
dl(j) = s1
@@ -180,7 +183,7 @@ c
10 continue
dd(n) = s2
c
- call zgttrf(n, dl, dd, du, du2, ipiv, ierr)
+ call zgttrf (n, dl, dd, du, du2, ipiv, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrf in _NDRV4.'
@@ -189,14 +192,14 @@ c
end if
c
c %-----------------------------------------------------%
-c | The work array WORKL is used in ZNAUPD as |
+c | The work array WORKL is used in ZNAUPD as |
c | workspace. Its dimension LWORKL is set as |
c | illustrated below. The parameter TOL determines |
c | the stopping criterion. If TOL<=0, machine |
c | precision is used. The variable IDO is used for |
c | reverse communication, and is initially set to 0. |
c | Setting INFO=0 indicates that a random vector is |
-c | generated in ZNAUPD to start the Arnoldi iteration. |
+c | generated in ZNAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+5*ncv
@@ -208,10 +211,10 @@ c %---------------------------------------------------%
c | This program uses exact shifts with respect to |
c | the current Hessenberg matrix (IPARAM(1) = 1). |
c | IPARAM(3) specifies the maximum number of Arnoldi |
-c | iterations allowed. Mode 3 of ZNAUPD is used |
+c | iterations allowed. Mode 3 of ZNAUPD is used |
c | (IPARAM(7) = 3). All these options can be |
c | changed by the user. For details see the |
-c | documentation in ZNAUPD. |
+c | documentation in ZNAUPD . |
c %---------------------------------------------------%
c
ishfts = 1
@@ -229,13 +232,13 @@ c
20 continue
c
c %---------------------------------------------%
-c | Repeatedly call the routine ZNAUPD and take |
+c | Repeatedly call the routine ZNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
- call znaupd ( ido, bmat, n, which, nev, tol, resid, ncv,
+ call znaupd ( ido, bmat, n, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& rwork, info )
@@ -255,7 +258,7 @@ c | workd(ipntr(2)). |
c %-------------------------------------------%
c
call mv (n, workd(ipntr(1)), workd(ipntr(2)))
- call zgttrs('N', n, 1, dl, dd, du, du2, ipiv,
+ call zgttrs ('N', n, 1, dl, dd, du, du2, ipiv,
& workd(ipntr(2)), n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
@@ -265,7 +268,7 @@ c
end if
c
c %-----------------------------------------%
-c | L O O P B A C K to call ZNAUPD again. |
+c | L O O P B A C K to call ZNAUPD again. |
c %-----------------------------------------%
c
go to 20
@@ -281,8 +284,8 @@ c | as input, and returns the result to |
c | workd(ipntr(2)). |
c %-----------------------------------------%
c
- call zcopy( n, workd(ipntr(3)), 1, workd(ipntr(2)), 1)
- call zgttrs ('N', n, 1, dl, dd, du, du2, ipiv,
+ call zcopy ( n, workd(ipntr(3)), 1, workd(ipntr(2)), 1)
+ call zgttrs ('N', n, 1, dl, dd, du, du2, ipiv,
& workd(ipntr(2)), n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
@@ -292,7 +295,7 @@ c
end if
c
c %-----------------------------------------%
-c | L O O P B A C K to call ZNAUPD again. |
+c | L O O P B A C K to call ZNAUPD again. |
c %-----------------------------------------%
c
go to 20
@@ -309,7 +312,7 @@ c
call mv (n, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
-c | L O O P B A C K to call ZNAUPD again. |
+c | L O O P B A C K to call ZNAUPD again. |
c %-----------------------------------------%
c
go to 20
@@ -325,7 +328,7 @@ c
c
c %----------------------------%
c | Error message, check the |
-c | documentation in ZNAUPD |
+c | documentation in ZNAUPD |
c %----------------------------%
c
print *, ' '
@@ -337,7 +340,7 @@ c
c
c %-------------------------------------------%
c | No fatal errors occurred. |
-c | Post-Process using ZNEUPD. |
+c | Post-Process using ZNEUPD . |
c | |
c | Computed eigenvalues may be extracted. |
c | |
@@ -347,7 +350,7 @@ c %-------------------------------------------%
c
rvec = .true.
c
- call zneupd (rvec, 'A', select, d, v, ldv, sigma,
+ call zneupd (rvec, 'A', select, d, v, ldv, sigma,
& workev, bmat, n, which, nev, tol, resid, ncv, v,
& ldv, iparam, ipntr, workd, workl, lworkl, rwork,
& ierr)
@@ -367,7 +370,7 @@ c
c
c %------------------------------------%
c | Error condition: |
-c | Check the documentation of ZNEUPD. |
+c | Check the documentation of ZNEUPD . |
c %------------------------------------%
c
print *, ' '
@@ -382,18 +385,18 @@ c
c
call av(n, v(1,j), ax)
call mv(n, v(1,j), mx)
- call zaxpy(n, -d(j), mx, 1, ax, 1)
- rd(j,1) = dble(d(j))
- rd(j,2) = dimag(d(j))
- rd(j,3) = dznrm2(n, ax, 1)
- rd(j,3) = rd(j,3) / dlapy2(rd(j,1),rd(j,2))
+ call zaxpy (n, -d(j), mx, 1, ax, 1)
+ rd(j,1) = dble (d(j))
+ rd(j,2) = dimag (d(j))
+ rd(j,3) = dznrm2 (n, ax, 1)
+ rd(j,3) = rd(j,3) / dlapy2 (rd(j,1),rd(j,2))
80 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
- call dmout(6, nconv, 3, rd, maxncv, -6,
+ call dmout (6, nconv, 3, rd, maxncv, -6,
& 'Ritz values (Real, Imag) and direct residuals')
c
end if
@@ -408,8 +411,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
@@ -442,35 +445,36 @@ c matrix vector multiplication subroutine
c
subroutine mv (n, v, w)
integer n, j
- Complex*16
- & v(n), w(n), one, four, h
- parameter (one = (1.0D+0, 0.0D+0),
- & four = (4.0D+0, 0.0D+0))
+ Complex*16
+ & v(n), w(n), one, four, six, h
+ parameter (one = (1.0D+0, 0.0D+0) ,
+ & four = (4.0D+0, 0.0D+0) ,
+ & six = (6.0D+0, 0.0D+0) )
c
c Compute the matrix vector multiplication y<---M*x
c where M is a n by n symmetric tridiagonal matrix with 4 on the
c diagonal, 1 on the subdiagonal and superdiagonal.
c
- w(1) = four*v(1) + one*v(2)
+ w(1) = ( four*v(1) + one*v(2) ) / six
do 40 j = 2,n-1
- w(j) = one*v(j-1) + four*v(j) + one*v(j+1)
+ w(j) = ( one*v(j-1) + four*v(j) + one*v(j+1) ) / six
40 continue
- w(n) = one*v(n-1) + four*v(n)
+ w(n) = ( one*v(n-1) + four*v(n) ) / six
c
- h = one / dcmplx(n+1)
- call zscal(n, h, w, 1)
+ h = one / dcmplx (n+1)
+ call zscal (n, h, w, 1)
return
end
c------------------------------------------------------------------
subroutine av (n, v, w)
integer n, j
- Complex*16
+ Complex*16
& v(n), w(n), one, two, dd, dl, du, s, h, rho
- parameter (one = (1.0D+0, 0.0D+0),
- & two = (2.0D+0, 0.0D+0))
+ parameter (one = (1.0D+0, 0.0D+0) ,
+ & two = (2.0D+0, 0.0D+0) )
common /convct/ rho
c
- h = one / dcmplx(n+1)
+ h = one / dcmplx (n+1)
s = rho / two
dd = two / h
dl = -one/h - s
diff --git a/EXAMPLES/NONSYM/dndrv1.f b/EXAMPLES/NONSYM/dndrv1.f
index 14217e8..10e9ea1 100644
--- a/EXAMPLES/NONSYM/dndrv1.f
+++ b/EXAMPLES/NONSYM/dndrv1.f
@@ -44,7 +44,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: ndrv1.F SID: 2.4 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: ndrv1.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -355,8 +355,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/NONSYM/dndrv2.f b/EXAMPLES/NONSYM/dndrv2.f
index 9b23348..0f0d5cd 100644
--- a/EXAMPLES/NONSYM/dndrv2.f
+++ b/EXAMPLES/NONSYM/dndrv2.f
@@ -43,7 +43,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: ndrv2.F SID: 2.4 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: ndrv2.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -398,8 +398,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/NONSYM/dndrv3.f b/EXAMPLES/NONSYM/dndrv3.f
index 8c6a77f..e511a9b 100644
--- a/EXAMPLES/NONSYM/dndrv3.f
+++ b/EXAMPLES/NONSYM/dndrv3.f
@@ -42,7 +42,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: ndrv3.F SID: 2.4 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: ndrv3.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -400,8 +400,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/NONSYM/dndrv4.f b/EXAMPLES/NONSYM/dndrv4.f
index efed506..cc9d2c0 100644
--- a/EXAMPLES/NONSYM/dndrv4.f
+++ b/EXAMPLES/NONSYM/dndrv4.f
@@ -46,7 +46,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: ndrv4.F SID: 2.4 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: ndrv4.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -72,7 +72,7 @@ c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14), ipiv(maxn)
- logical select(maxnev)
+ logical select(maxncv)
Double precision
& ax(maxn), mx(maxn), d(maxncv,3), resid(maxn),
& v(ldv,maxncv), workd(3*maxn), workev(3*maxncv),
@@ -111,10 +111,10 @@ c | Parameters |
c %------------%
c
Double precision
- & one, zero, two, rho
+ & one, zero, two, six, rho
common /convct/ rho
parameter (one = 1.0D+0, zero = 0.0D+0,
- & two = 2.0D+0)
+ & two = 2.0D+0, six = 6.0D+0)
c
c %-----------------------%
c | Executable statements |
@@ -170,9 +170,9 @@ c
h = one / dble(n+1)
s = rho / two
c
- s1 = -one/h - s - sigmar*h
- s2 = two/h - 4.0D+0*sigmar*h
- s3 = -one/h + s - sigmar*h
+ s1 = -one/h - s - sigmar*h/six
+ s2 = two/h - 4.0D+0*sigmar*h/six
+ s3 = -one/h + s - sigmar*h/six
c
do 10 j = 1, n-1
dl(j) = s1
@@ -456,8 +456,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
@@ -495,18 +495,18 @@ c
subroutine mv (n, v, w)
integer n, j
Double precision
- & v(n), w(n), one, four, h
- parameter (one = 1.0D+0, four = 4.0D+0)
+ & v(n), w(n), one, four, six, h
+ parameter (one = 1.0D+0, four = 4.0D+0, six = 6.0D+0)
c
c Compute the matrix vector multiplication y<---M*x
c where M is mass matrix formed by using piecewise linear elements
c on [0,1].
c
- w(1) = four*v(1) + one*v(2)
+ w(1) = ( four*v(1) + one*v(2) ) / six
do 10 j = 2,n-1
- w(j) = one*v(j-1) + four*v(j) + one*v(j+1)
+ w(j) = ( one*v(j-1) + four*v(j) + one*v(j+1) ) / six
10 continue
- w(n) = one*v(n-1) + four*v(n)
+ w(n) = ( one*v(n-1) + four*v(n) ) / six
c
h = one / dble(n+1)
call dscal(n, h, w, 1)
diff --git a/EXAMPLES/NONSYM/dndrv5.f b/EXAMPLES/NONSYM/dndrv5.f
index 11b6851..b952472 100644
--- a/EXAMPLES/NONSYM/dndrv5.f
+++ b/EXAMPLES/NONSYM/dndrv5.f
@@ -41,7 +41,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: ndrv5.F SID: 2.4 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: ndrv5.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -67,7 +67,7 @@ c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14), ipiv(maxn)
- logical select(maxnev)
+ logical select(maxncv)
Double precision
& ax(maxn), mx(maxn), d(maxncv,3), resid(maxn),
& v(ldv,maxncv), workd(3*maxn),
@@ -539,8 +539,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/NONSYM/dndrv6.f b/EXAMPLES/NONSYM/dndrv6.f
index 23fa93d..63a23be 100644
--- a/EXAMPLES/NONSYM/dndrv6.f
+++ b/EXAMPLES/NONSYM/dndrv6.f
@@ -41,7 +41,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: ndrv6.F SID: 2.4 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: ndrv6.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -67,7 +67,7 @@ c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14), ipiv(maxn)
- logical select(maxnev)
+ logical select(maxncv)
Double precision
& ax(maxn), mx(maxn), d(maxncv,3), resid(maxn),
& v(ldv,maxncv), workd(3*maxn),
@@ -538,8 +538,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/NONSYM/sndrv1.f b/EXAMPLES/NONSYM/sndrv1.f
index 06c8eda..d88699c 100644
--- a/EXAMPLES/NONSYM/sndrv1.f
+++ b/EXAMPLES/NONSYM/sndrv1.f
@@ -44,7 +44,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: ndrv1.F SID: 2.4 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: ndrv1.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -355,8 +355,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/NONSYM/sndrv2.f b/EXAMPLES/NONSYM/sndrv2.f
index bec17fb..75482b0 100644
--- a/EXAMPLES/NONSYM/sndrv2.f
+++ b/EXAMPLES/NONSYM/sndrv2.f
@@ -43,7 +43,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: ndrv2.F SID: 2.4 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: ndrv2.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -398,8 +398,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/NONSYM/sndrv3.f b/EXAMPLES/NONSYM/sndrv3.f
index c9a959a..6629091 100644
--- a/EXAMPLES/NONSYM/sndrv3.f
+++ b/EXAMPLES/NONSYM/sndrv3.f
@@ -42,7 +42,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: ndrv3.F SID: 2.4 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: ndrv3.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -400,8 +400,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/NONSYM/sndrv4.f b/EXAMPLES/NONSYM/sndrv4.f
index c39b1cd..d5807ac 100644
--- a/EXAMPLES/NONSYM/sndrv4.f
+++ b/EXAMPLES/NONSYM/sndrv4.f
@@ -46,7 +46,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: ndrv4.F SID: 2.4 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: ndrv4.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -72,7 +72,7 @@ c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14), ipiv(maxn)
- logical select(maxnev)
+ logical select(maxncv)
Real
& ax(maxn), mx(maxn), d(maxncv,3), resid(maxn),
& v(ldv,maxncv), workd(3*maxn), workev(3*maxncv),
@@ -111,10 +111,10 @@ c | Parameters |
c %------------%
c
Real
- & one, zero, two, rho
+ & one, zero, two, six, rho
common /convct/ rho
parameter (one = 1.0E+0, zero = 0.0E+0,
- & two = 2.0E+0)
+ & two = 2.0E+0, six = 6.0E+0)
c
c %-----------------------%
c | Executable statements |
@@ -170,9 +170,9 @@ c
h = one / real(n+1)
s = rho / two
c
- s1 = -one/h - s - sigmar*h
- s2 = two/h - 4.0E+0*sigmar*h
- s3 = -one/h + s - sigmar*h
+ s1 = -one/h - s - sigmar*h/six
+ s2 = two/h - 4.0E+0*sigmar*h/six
+ s3 = -one/h + s - sigmar*h/six
c
do 10 j = 1, n-1
dl(j) = s1
@@ -456,8 +456,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
@@ -495,18 +495,18 @@ c
subroutine mv (n, v, w)
integer n, j
Real
- & v(n), w(n), one, four, h
- parameter (one = 1.0E+0, four = 4.0E+0)
+ & v(n), w(n), one, four, six, h
+ parameter (one = 1.0E+0, four = 4.0E+0, six = 6.0E+0)
c
c Compute the matrix vector multiplication y<---M*x
c where M is mass matrix formed by using piecewise linear elements
c on [0,1].
c
- w(1) = four*v(1) + one*v(2)
+ w(1) = ( four*v(1) + one*v(2) ) / six
do 10 j = 2,n-1
- w(j) = one*v(j-1) + four*v(j) + one*v(j+1)
+ w(j) = ( one*v(j-1) + four*v(j) + one*v(j+1) ) / six
10 continue
- w(n) = one*v(n-1) + four*v(n)
+ w(n) = ( one*v(n-1) + four*v(n) ) / six
c
h = one / real(n+1)
call sscal(n, h, w, 1)
diff --git a/EXAMPLES/NONSYM/sndrv5.f b/EXAMPLES/NONSYM/sndrv5.f
index 296be7e..76d1afb 100644
--- a/EXAMPLES/NONSYM/sndrv5.f
+++ b/EXAMPLES/NONSYM/sndrv5.f
@@ -41,7 +41,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: ndrv5.F SID: 2.4 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: ndrv5.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -67,7 +67,7 @@ c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14), ipiv(maxn)
- logical select(maxnev)
+ logical select(maxncv)
Real
& ax(maxn), mx(maxn), d(maxncv,3), resid(maxn),
& v(ldv,maxncv), workd(3*maxn),
@@ -539,8 +539,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/NONSYM/sndrv6.f b/EXAMPLES/NONSYM/sndrv6.f
index 6ab88ab..5d434eb 100644
--- a/EXAMPLES/NONSYM/sndrv6.f
+++ b/EXAMPLES/NONSYM/sndrv6.f
@@ -41,7 +41,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: ndrv6.F SID: 2.4 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: ndrv6.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -67,7 +67,7 @@ c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14), ipiv(maxn)
- logical select(maxnev)
+ logical select(maxncv)
Real
& ax(maxn), mx(maxn), d(maxncv,3), resid(maxn),
& v(ldv,maxncv), workd(3*maxn),
@@ -538,8 +538,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/SIMPLE/cnsimp.f b/EXAMPLES/SIMPLE/cnsimp.f
index 2c6a450..ca035bf 100644
--- a/EXAMPLES/SIMPLE/cnsimp.f
+++ b/EXAMPLES/SIMPLE/cnsimp.f
@@ -72,8 +72,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: nsimp.F SID: 2.4 DATE OF SID: 10/20/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -112,12 +112,12 @@ c %--------------%
c
integer iparam(11), ipntr(14)
logical select(maxncv)
- Complex
+ Complex
& ax(maxn), d(maxncv),
& v(ldv,maxncv), workd(3*maxn),
& workev(2*maxncv), resid(maxn),
& workl(3*maxncv*maxncv+5*maxncv)
- Real
+ Real
& rwork(maxncv), rd(maxncv,3)
c
c %---------------%
@@ -127,9 +127,9 @@ c
character bmat*1, which*2
integer ido, n, nx, nev, ncv, lworkl, info, ierr,
& j, ishfts, maxitr, mode1, nconv
- Complex
+ Complex
& sigma
- Real
+ Real
& tol
logical rvec
c
@@ -137,7 +137,7 @@ c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Real
+ Real
& scnrm2, slapy2
external scnrm2, caxpy, slapy2
c
@@ -406,7 +406,7 @@ c %---------------------------%
c
call av(nx, v(1,j), ax)
call caxpy(n, -d(j), v(1,j), 1, ax, 1)
- rd(j,1) = real(d(j))
+ rd(j,1) = real (d(j))
rd(j,2) = aimag(d(j))
rd(j,3) = scnrm2(n, ax, 1)
rd(j,3) = rd(j,3) / slapy2(rd(j,1),rd(j,2))
@@ -430,8 +430,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
@@ -471,9 +471,9 @@ c discretized using centered difference.
c
subroutine av (nx, v, w)
integer nx, j, lo
- Complex
+ Complex
& v(nx*nx), w(nx*nx), one, h2
- parameter (one = (1.0E+0, 0.0E+0))
+ parameter (one = (1.0E+0, 0.0E+0) )
external caxpy
c
c Computes w <--- OP*v, where OP is the nx*nx by nx*nx block
@@ -515,13 +515,13 @@ c=========================================================================
subroutine tv (nx, x, y)
c
integer nx, j
- Complex
+ Complex
& x(nx), y(nx), h, h2, dd, dl, du
c
- Complex
+ Complex
& one, rho
- parameter (one = (1.0E+0, 0.0E+0),
- & rho = (1.0E+2, 0.0E+0))
+ parameter (one = (1.0E+0, 0.0E+0) ,
+ & rho = (1.0E+2, 0.0E+0) )
c
c Compute the matrix vector multiplication y<---T*x
c where T is a nx by nx tridiagonal matrix with DD on the
@@ -529,9 +529,9 @@ c diagonal, DL on the subdiagonal, and DU on the superdiagonal
c
h = one / cmplx(nx+1)
h2 = h*h
- dd = (4.0E+0, 0.0E+0) / h2
- dl = -one/h2 - (5.0E-1, 0.0E+0)*rho/h
- du = -one/h2 + (5.0E-1, 0.0E+0)*rho/h
+ dd = (4.0E+0, 0.0E+0) / h2
+ dl = -one/h2 - (5.0E-1, 0.0E+0) *rho/h
+ du = -one/h2 + (5.0E-1, 0.0E+0) *rho/h
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
diff --git a/EXAMPLES/SIMPLE/dnsimp.f b/EXAMPLES/SIMPLE/dnsimp.f
index 5212468..396dbc0 100644
--- a/EXAMPLES/SIMPLE/dnsimp.f
+++ b/EXAMPLES/SIMPLE/dnsimp.f
@@ -77,7 +77,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: nsimp.F SID: 2.4 DATE OF SID: 8/9/96 RELEASE: 2
+c FILE: nsimp.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -473,8 +473,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/SIMPLE/dssimp.f b/EXAMPLES/SIMPLE/dssimp.f
index 6eded2a..a888983 100644
--- a/EXAMPLES/SIMPLE/dssimp.f
+++ b/EXAMPLES/SIMPLE/dssimp.f
@@ -69,7 +69,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: ssimp.F SID: 2.5 DATE OF SID: 9/5/96 RELEASE: 2
+c FILE: ssimp.F SID: 2.6 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -432,8 +432,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/SIMPLE/snsimp.f b/EXAMPLES/SIMPLE/snsimp.f
index 73a2942..25d8433 100644
--- a/EXAMPLES/SIMPLE/snsimp.f
+++ b/EXAMPLES/SIMPLE/snsimp.f
@@ -77,7 +77,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: nsimp.F SID: 2.4 DATE OF SID: 8/9/96 RELEASE: 2
+c FILE: nsimp.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -473,8 +473,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/SIMPLE/sssimp.f b/EXAMPLES/SIMPLE/sssimp.f
index 2791065..a637be3 100644
--- a/EXAMPLES/SIMPLE/sssimp.f
+++ b/EXAMPLES/SIMPLE/sssimp.f
@@ -69,7 +69,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: ssimp.F SID: 2.5 DATE OF SID: 9/5/96 RELEASE: 2
+c FILE: ssimp.F SID: 2.6 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -432,8 +432,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/SIMPLE/znsimp.f b/EXAMPLES/SIMPLE/znsimp.f
index 6d541bb..62ef915 100644
--- a/EXAMPLES/SIMPLE/znsimp.f
+++ b/EXAMPLES/SIMPLE/znsimp.f
@@ -1,4 +1,4 @@
- program znsimp
+ program znsimp
c
c This example program is intended to illustrate the
c simplest case of using ARPACK in considerable detail.
@@ -20,12 +20,12 @@ c eigenvalues of largest magnitude. Other options
c are available.
c
c 2) Illustration of the reverse communication interface
-c needed to utilize the top level ARPACK routine ZNAUPD
+c needed to utilize the top level ARPACK routine ZNAUPD
c that computes the quantities needed to construct
c the desired eigenvalues and eigenvectors(if requested).
c
c 3) How to extract the desired eigenvalues and eigenvectors
-c using the ARPACK routine ZNEUPD.
+c using the ARPACK routine ZNEUPD .
c
c The only thing that must be supplied in order to use this
c routine on your problem is to change the array dimensions
@@ -47,17 +47,17 @@ c\Example-1
c ... Suppose we want to solve A*x = lambda*x in regular mode,
c ... OP = A and B = I.
c ... Assume "call av (nx,x,y)" computes y = A*x
-c ... Use mode 1 of ZNAUPD.
+c ... Use mode 1 of ZNAUPD .
c
c\BeginLib
c
c\Routines called
-c znaupd ARPACK reverse communication interface routine.
-c zneupd ARPACK routine that returns Ritz values and (optionally)
+c znaupd ARPACK reverse communication interface routine.
+c zneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
-c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c dznrm2 Level 1 BLAS that computes the norm of a complex vector.
-c zaxpy Level 1 BLAS that computes y <- alpha*x+y.
+c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
+c dznrm2 Level 1 BLAS that computes the norm of a complex vector.
+c zaxpy Level 1 BLAS that computes y <- alpha*x+y.
c av Matrix vector multiplication routine that computes A*x.
c tv Matrix vector multiplication routine that computes T*x,
c where T is a tridiagonal matrix. It is used in routine
@@ -72,8 +72,8 @@ c Applied Mathematics
c Rice University
c Houston, Texas
c
-c\SCCS Information: %Z%
-c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
+c\SCCS Information: @(#)
+c FILE: nsimp.F SID: 2.4 DATE OF SID: 10/20/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -112,12 +112,12 @@ c %--------------%
c
integer iparam(11), ipntr(14)
logical select(maxncv)
- Complex*16
+ Complex*16
& ax(maxn), d(maxncv),
& v(ldv,maxncv), workd(3*maxn),
& workev(2*maxncv), resid(maxn),
& workl(3*maxncv*maxncv+5*maxncv)
- Double precision
+ Double precision
& rwork(maxncv), rd(maxncv,3)
c
c %---------------%
@@ -127,9 +127,9 @@ c
character bmat*1, which*2
integer ido, n, nx, nev, ncv, lworkl, info, ierr,
& j, ishfts, maxitr, mode1, nconv
- Complex*16
+ Complex*16
& sigma
- Double precision
+ Double precision
& tol
logical rvec
c
@@ -137,9 +137,9 @@ c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Double precision
- & dznrm2, dlapy2
- external dznrm2, zaxpy, dlapy2
+ Double precision
+ & dznrm2 , dlapy2
+ external dznrm2 , zaxpy , dlapy2
c
c %-----------------------%
c | Executable Statements |
@@ -189,7 +189,7 @@ c | |
c | 4) Ask for the NEV eigenvalues of |
c | largest magnitude |
c | (indicated by which = 'LM') |
-c | See documentation in ZNAUPD for the |
+c | See documentation in ZNAUPD for the |
c | other options SM, LR, SR, LI, SI. |
c | |
c | Note: NEV and NCV must satisfy the following |
@@ -218,7 +218,7 @@ c
c %-----------------------------------------------------%
c | |
c | Specification of stopping rules and initial |
-c | conditions before calling ZNAUPD |
+c | conditions before calling ZNAUPD |
c | |
c | TOL determines the stopping criterion. |
c | |
@@ -231,10 +231,10 @@ c | (machine precision) is used. |
c | |
c | IDO is the REVERSE COMMUNICATION parameter |
c | used to specify actions to be taken on return |
-c | from ZNAUPD. (see usage below) |
+c | from ZNAUPD . (see usage below) |
c | |
c | It MUST initially be set to 0 before the first |
-c | call to ZNAUPD. |
+c | call to ZNAUPD . |
c | |
c | INFO on entry specifies starting vector information |
c | and on return indicates error codes |
@@ -246,7 +246,7 @@ c | a nonzero value on the initial call is used |
c | if you want to specify your own starting |
c | vector (This vector must be placed in RESID). |
c | |
-c | The work array WORKL is used in ZNAUPD as |
+c | The work array WORKL is used in ZNAUPD as |
c | workspace. Its dimension LWORKL is set as |
c | illustrated below. |
c | |
@@ -263,10 +263,10 @@ c | |
c | This program uses the exact shift strategy |
c | (indicated by setting IPARAM(1) = 1). |
c | IPARAM(3) specifies the maximum number of Arnoldi |
-c | iterations allowed. Mode 1 of ZNAUPD is used |
+c | iterations allowed. Mode 1 of ZNAUPD is used |
c | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details see the documentation in |
-c | ZNAUPD. |
+c | ZNAUPD . |
c %---------------------------------------------------%
c
ishfts = 1
@@ -286,13 +286,13 @@ c
10 continue
c
c %---------------------------------------------%
-c | Repeatedly call the routine ZNAUPD and take |
+c | Repeatedly call the routine ZNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
- call znaupd ( ido, bmat, n, which, nev, tol, resid, ncv,
+ call znaupd ( ido, bmat, n, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& rwork,info )
c
@@ -314,7 +314,7 @@ c
call av (nx, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
-c | L O O P B A C K to call ZNAUPD again. |
+c | L O O P B A C K to call ZNAUPD again. |
c %-----------------------------------------%
c
go to 10
@@ -330,7 +330,7 @@ c
c
c %--------------------------%
c | Error message, check the |
-c | documentation in ZNAUPD |
+c | documentation in ZNAUPD |
c %--------------------------%
c
print *, ' '
@@ -342,14 +342,14 @@ c
c
c %-------------------------------------------%
c | No fatal errors occurred. |
-c | Post-Process using ZNEUPD. |
+c | Post-Process using ZNEUPD . |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may be also computed now if |
c | desired. (indicated by rvec = .true.) |
c | |
-c | The routine ZNEUPD now called to do this |
+c | The routine ZNEUPD now called to do this |
c | post processing (Other modes may require |
c | more complicated post processing than |
c | mode1.) |
@@ -358,7 +358,7 @@ c %-------------------------------------------%
c
rvec = .true.
c
- call zneupd (rvec, 'A', select, D, V, ldv, sigma,
+ call zneupd (rvec, 'A', select, D, V, ldv, sigma,
& workev, bmat, n, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& rwork, ierr)
@@ -378,7 +378,7 @@ c
c
c %------------------------------------%
c | Error condition: |
-c | Check the documentation of ZNEUPD. |
+c | Check the documentation of ZNEUPD . |
c %------------------------------------%
c
print *, ' '
@@ -405,18 +405,18 @@ c | tolerance) |
c %---------------------------%
c
call av(nx, v(1,j), ax)
- call zaxpy(n, -d(j), v(1,j), 1, ax, 1)
- rd(j,1) = dble(d(j))
- rd(j,2) = dimag(d(j))
- rd(j,3) = dznrm2(n, ax, 1)
- rd(j,3) = rd(j,3) / dlapy2(rd(j,1),rd(j,2))
+ call zaxpy (n, -d(j), v(1,j), 1, ax, 1)
+ rd(j,1) = dble (d(j))
+ rd(j,2) = dimag (d(j))
+ rd(j,3) = dznrm2 (n, ax, 1)
+ rd(j,3) = rd(j,3) / dlapy2 (rd(j,1),rd(j,2))
20 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
- call dmout(6, nconv, 3, rd, maxncv, -6,
+ call dmout (6, nconv, 3, rd, maxncv, -6,
& 'Ritz values (Real, Imag) and relative residuals')
end if
c
@@ -430,8 +430,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
@@ -455,7 +455,7 @@ c
end if
c
c %---------------------------%
-c | Done with program znsimp. |
+c | Done with program znsimp . |
c %---------------------------%
c
9000 continue
@@ -471,10 +471,10 @@ c discretized using centered difference.
c
subroutine av (nx, v, w)
integer nx, j, lo
- Complex*16
+ Complex*16
& v(nx*nx), w(nx*nx), one, h2
- parameter (one = (1.0D+0, 0.0D+0))
- external zaxpy
+ parameter (one = (1.0D+0, 0.0D+0) )
+ external zaxpy
c
c Computes w <--- OP*v, where OP is the nx*nx by nx*nx block
c tridiagonal matrix
@@ -493,21 +493,21 @@ c
c The subroutine TV is called to computed y<---T*x.
c
c
- h2 = one / dcmplx((nx+1)*(nx+1))
+ h2 = one / dcmplx ((nx+1)*(nx+1))
c
call tv(nx,v(1),w(1))
- call zaxpy(nx, -one/h2, v(nx+1), 1, w(1), 1)
+ call zaxpy (nx, -one/h2, v(nx+1), 1, w(1), 1)
c
do 10 j = 2, nx-1
lo = (j-1)*nx
call tv(nx, v(lo+1), w(lo+1))
- call zaxpy(nx, -one/h2, v(lo-nx+1), 1, w(lo+1), 1)
- call zaxpy(nx, -one/h2, v(lo+nx+1), 1, w(lo+1), 1)
+ call zaxpy (nx, -one/h2, v(lo-nx+1), 1, w(lo+1), 1)
+ call zaxpy (nx, -one/h2, v(lo+nx+1), 1, w(lo+1), 1)
10 continue
c
lo = (nx-1)*nx
call tv(nx, v(lo+1), w(lo+1))
- call zaxpy(nx, -one/h2, v(lo-nx+1), 1, w(lo+1), 1)
+ call zaxpy (nx, -one/h2, v(lo-nx+1), 1, w(lo+1), 1)
c
return
end
@@ -515,23 +515,23 @@ c=========================================================================
subroutine tv (nx, x, y)
c
integer nx, j
- Complex*16
+ Complex*16
& x(nx), y(nx), h, h2, dd, dl, du
c
- Complex*16
+ Complex*16
& one, rho
- parameter (one = (1.0D+0, 0.0D+0),
- & rho = (1.0D+2, 0.0D+0))
+ parameter (one = (1.0D+0, 0.0D+0) ,
+ & rho = (1.0D+2, 0.0D+0) )
c
c Compute the matrix vector multiplication y<---T*x
c where T is a nx by nx tridiagonal matrix with DD on the
c diagonal, DL on the subdiagonal, and DU on the superdiagonal
c
- h = one / dcmplx(nx+1)
+ h = one / dcmplx (nx+1)
h2 = h*h
- dd = (4.0D+0, 0.0D+0) / h2
- dl = -one/h2 - (5.0D-1, 0.0D+0)*rho/h
- du = -one/h2 + (5.0D-1, 0.0D+0)*rho/h
+ dd = (4.0D+0, 0.0D+0) / h2
+ dl = -one/h2 - (5.0D-1, 0.0D+0) *rho/h
+ du = -one/h2 + (5.0D-1, 0.0D+0) *rho/h
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
diff --git a/EXAMPLES/SVD/dsvd.f b/EXAMPLES/SVD/dsvd.f
index 80a107b..4ac993d 100644
--- a/EXAMPLES/SVD/dsvd.f
+++ b/EXAMPLES/SVD/dsvd.f
@@ -92,7 +92,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: svd.F SID: 2.3 DATE OF SID: 8/21/96 RELEASE: 2
+c FILE: svd.F SID: 2.4 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -469,8 +469,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/SVD/ssvd.f b/EXAMPLES/SVD/ssvd.f
index b8c86c5..cf30f07 100644
--- a/EXAMPLES/SVD/ssvd.f
+++ b/EXAMPLES/SVD/ssvd.f
@@ -92,7 +92,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: svd.F SID: 2.3 DATE OF SID: 8/21/96 RELEASE: 2
+c FILE: svd.F SID: 2.4 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -469,8 +469,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/SYM/dsdrv1.f b/EXAMPLES/SYM/dsdrv1.f
index 0e43261..3bdaabb 100644
--- a/EXAMPLES/SYM/dsdrv1.f
+++ b/EXAMPLES/SYM/dsdrv1.f
@@ -40,7 +40,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: sdrv1.F SID: 2.4 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: sdrv1.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -319,8 +319,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/SYM/dsdrv2.f b/EXAMPLES/SYM/dsdrv2.f
index 0b8a943..7d90ad1 100644
--- a/EXAMPLES/SYM/dsdrv2.f
+++ b/EXAMPLES/SYM/dsdrv2.f
@@ -38,7 +38,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: sdrv2.F SID: 2.4 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: sdrv2.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -343,8 +343,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/SYM/dsdrv3.f b/EXAMPLES/SYM/dsdrv3.f
index 65f190b..db0d767 100644
--- a/EXAMPLES/SYM/dsdrv3.f
+++ b/EXAMPLES/SYM/dsdrv3.f
@@ -1,9 +1,9 @@
- program dsdrv3
+ program dsdrv3
c
c Program to illustrate the idea of reverse communication in
c inverse mode for a generalized symmetric eigenvalue problem.
-c The following program uses the two LAPACK subroutines dgttrf.f
-c and dgttrs.f to factor and solve a tridiagonal system of equations.
+c The following program uses the two LAPACK subroutines dgttrf .f
+c and dgttrs .f to factor and solve a tridiagonal system of equations.
c
c We implement example three of ex-sym.doc in DOCUMENTS directory
c
@@ -17,20 +17,20 @@ c using piecewise linear elements.
c
c ... OP = inv[M]*A and B = M.
c
-c ... Use mode 2 of DSAUPD.
+c ... Use mode 2 of DSAUPD .
c
c\BeginLib
c
c\Routines called:
-c dsaupd ARPACK reverse communication interface routine.
-c dseupd ARPACK routine that returns Ritz values and (optionally)
+c dsaupd ARPACK reverse communication interface routine.
+c dseupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
-c dgttrf LAPACK tridiagonal factorization routine.
-c dgttrs LAPACK tridiagonal solve routine.
-c daxpy Level 1 BLAS that computes y <- alpha*x+y.
-c dscal Level 1 BLAS that scales a vector by a scalar.
-c dcopy Level 1 BLAS that copies one vector to another.
-c dnrm2 Level 1 BLAS that computes the norm of a vector.
+c dgttrf LAPACK tridiagonal factorization routine.
+c dgttrs LAPACK tridiagonal solve routine.
+c daxpy Level 1 BLAS that computes y <- alpha*x+y.
+c dscal Level 1 BLAS that scales a vector by a scalar.
+c dcopy Level 1 BLAS that copies one vector to another.
+c dnrm2 Level 1 BLAS that computes the norm of a vector.
c av Matrix vector multiplication routine that computes A*x.
c mv Matrix vector multiplication routine that computes M*x.
c
@@ -44,7 +44,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: sdrv3.F SID: 2.4 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: sdrv3.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -69,7 +69,7 @@ c %--------------%
c | Local Arrays |
c %--------------%
c
- Double precision
+ Double precision
& v(ldv,maxncv), workl(maxncv*(maxncv+8)),
& workd(3*maxn), d(maxncv,2), resid(maxn),
& ad(maxn), adl(maxn), adu(maxn), adu2(maxn),
@@ -85,25 +85,25 @@ c
integer ido, n, nev, ncv, lworkl, info, j, ierr,
& nconv, maxitr, ishfts, mode
logical rvec
- Double precision
+ Double precision
& sigma, r1, r2, tol, h
c
c %------------%
c | Parameters |
c %------------%
c
- Double precision
+ Double precision
& zero, one, four, six
- parameter ( zero = 0.0D+0, one = 1.0D+0,
- & four = 4.0D+0, six = 6.0D+0 )
+ parameter ( zero = 0.0D+0 , one = 1.0D+0 ,
+ & four = 4.0D+0 , six = 6.0D+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Double precision
- & dnrm2
- external daxpy, dcopy, dscal, dnrm2, dgttrf, dgttrs
+ Double precision
+ & dnrm2
+ external daxpy , dcopy , dscal , dnrm2 , dgttrf , dgttrs
c
c %--------------------%
c | Intrinsic function |
@@ -145,14 +145,14 @@ c
which = 'LM'
c
c %--------------------------------------------------%
-c | The work array WORKL is used in DSAUPD as |
+c | The work array WORKL is used in DSAUPD as |
c | workspace. Its dimension LWORKL is set as |
c | illustrated below. The parameter TOL determines |
c | the stopping criterion. If TOL<=0, machine |
c | precision is used. The variable IDO is used for |
c | reverse communication and is initially set to 0. |
c | Setting INFO=0 indicates that a random vector is |
-c | generated in DSAUPD to start the Arnoldi |
+c | generated in DSAUPD to start the Arnoldi |
c | iteration. |
c %--------------------------------------------------%
c
@@ -165,10 +165,10 @@ c %---------------------------------------------------%
c | This program uses exact shifts with respect to |
c | the current Hessenberg matrix (IPARAM(1) = 1). |
c | IPARAM(3) specifies the maximum number of Arnoldi |
-c | iterations allowed. Mode 2 of DSAUPD is used |
+c | iterations allowed. Mode 2 of DSAUPD is used |
c | (IPARAM(7) = 2). All these options may be |
c | changed by the user. For details, see the |
-c | documentation in DSAUPD. |
+c | documentation in DSAUPD . |
c %---------------------------------------------------%
c
ishfts = 1
@@ -186,7 +186,7 @@ c | arising from using piecewise linear finite |
c | elements on the interval [0, 1]. |
c %------------------------------------------------%
c
- h = one / dble(n+1)
+ h = one / dble (n+1)
c
r1 = (four / six) * h
r2 = (one / six) * h
@@ -194,8 +194,8 @@ c
ad(j) = r1
adl(j) = r2
20 continue
- call dcopy (n, adl, 1, adu, 1)
- call dgttrf (n, adl, ad, adu, adu2, ipiv, ierr)
+ call dcopy (n, adl, 1, adu, 1)
+ call dgttrf (n, adl, ad, adu, adu2, ipiv, ierr)
if (ierr .ne. 0) then
print *, ' '
print *, ' Error with _gttrf in _SDRV3. '
@@ -210,13 +210,13 @@ c
10 continue
c
c %---------------------------------------------%
-c | Repeatedly call the routine DSAUPD and take |
+c | Repeatedly call the routine DSAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
- call dsaupd ( ido, bmat, n, which, nev, tol, resid,
+ call dsaupd ( ido, bmat, n, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, info )
c
@@ -236,8 +236,8 @@ c | overwrites workd(ipntr(1)). |
c %--------------------------------------%
c
call av (n, workd(ipntr(1)), workd(ipntr(2)))
- call dcopy(n, workd(ipntr(2)), 1, workd(ipntr(1)), 1)
- call dgttrs ('Notranspose', n, 1, adl, ad, adu, adu2, ipiv,
+ call dcopy (n, workd(ipntr(2)), 1, workd(ipntr(1)), 1)
+ call dgttrs ('Notranspose', n, 1, adl, ad, adu, adu2, ipiv,
& workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print *, ' '
@@ -247,7 +247,7 @@ c
end if
c
c %-----------------------------------------%
-c | L O O P B A C K to call DSAUPD again. |
+c | L O O P B A C K to call DSAUPD again. |
c %-----------------------------------------%
c
go to 10
@@ -266,7 +266,7 @@ c
call mv (n, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
-c | L O O P B A C K to call DSAUPD again. |
+c | L O O P B A C K to call DSAUPD again. |
c %-----------------------------------------%
c
go to 10
@@ -284,7 +284,7 @@ c
c
c %--------------------------%
c | Error message, check the |
-c | documentation in DSAUPD |
+c | documentation in DSAUPD |
c %--------------------------%
c
print *, ' '
@@ -296,7 +296,7 @@ c
c
c %-------------------------------------------%
c | No fatal errors occurred. |
-c | Post-Process using DSEUPD. |
+c | Post-Process using DSEUPD . |
c | |
c | Computed eigenvalues may be extracted. |
c | |
@@ -306,7 +306,7 @@ c %-------------------------------------------%
c
rvec = .true.
c
- call dseupd ( rvec, 'All', select, d, v, ldv, sigma,
+ call dseupd ( rvec, 'All', select, d, v, ldv, sigma,
& bmat, n, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, ierr )
c
@@ -325,7 +325,7 @@ c
c
c %------------------------------------%
c | Error condition: |
-c | Check the documentation of DSEUPD. |
+c | Check the documentation of DSEUPD . |
c %------------------------------------%
c
print *, ' '
@@ -353,8 +353,8 @@ c %---------------------------%
c
call av(n, v(1,j), ax)
call mv(n, v(1,j), mx)
- call daxpy(n, -d(j,1), mx, 1, ax, 1)
- d(j,2) = dnrm2(n, ax, 1)
+ call daxpy (n, -d(j,1), mx, 1, ax, 1)
+ d(j,2) = dnrm2 (n, ax, 1)
d(j,2) = d(j,2) / abs(d(j,1))
c
30 continue
@@ -363,7 +363,7 @@ c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
- call dmout(6, nconv, 2, d, maxncv, -6,
+ call dmout (6, nconv, 2, d, maxncv, -6,
& 'Ritz values and relative residuals')
end if
c
@@ -377,8 +377,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
@@ -402,7 +402,7 @@ c
end if
c
c %---------------------------%
-c | Done with program dsdrv3. |
+c | Done with program dsdrv3 . |
c %---------------------------%
c
9000 continue
@@ -416,10 +416,10 @@ c on the interval [0,1].
c
subroutine mv (n, v, w)
integer n, j
- Double precision
+ Double precision
& v(n),w(n), one, four, six, h
- parameter (one = 1.0D+0, four = 4.0D+0,
- & six = 6.0D+0)
+ parameter (one = 1.0D+0 , four = 4.0D+0 ,
+ & six = 6.0D+0 )
c
w(1) = four*v(1) + v(2)
do 100 j = 2,n-1
@@ -430,8 +430,8 @@ c
c
c Scale the vector w by h.
c
- h = one / (dble(n+1)*six)
- call dscal(n, h, w, 1)
+ h = one / (dble (n+1)*six)
+ call dscal (n, h, w, 1)
return
end
c
@@ -445,9 +445,9 @@ c piecewise linear elements.
c
subroutine av (n, v, w)
integer n, j
- Double precision
+ Double precision
& v(n),w(n), two, one, h
- parameter ( one = 1.0D+0, two = 2.0D+0 )
+ parameter ( one = 1.0D+0 , two = 2.0D+0 )
c
w(1) = two*v(1) - v(2)
do 100 j = 2,n-1
@@ -458,7 +458,7 @@ c
c
c Scale the vector w by (1 / h).
c
- h = one / dble(n+1)
- call dscal(n, one/h, w, 1)
+ h = one / dble (n+1)
+ call dscal (n, one/h, w, 1)
return
end
diff --git a/EXAMPLES/SYM/dsdrv4.f b/EXAMPLES/SYM/dsdrv4.f
index 7e03f83..3258750 100644
--- a/EXAMPLES/SYM/dsdrv4.f
+++ b/EXAMPLES/SYM/dsdrv4.f
@@ -45,7 +45,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: sdrv4.F SID: 2.4 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: sdrv4.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -399,8 +399,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/SYM/dsdrv5.f b/EXAMPLES/SYM/dsdrv5.f
index 8daa43b..e27c1e3 100644
--- a/EXAMPLES/SYM/dsdrv5.f
+++ b/EXAMPLES/SYM/dsdrv5.f
@@ -48,7 +48,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: sdrv5.F SID: 2.4 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: sdrv5.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -397,8 +397,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/SYM/dsdrv6.f b/EXAMPLES/SYM/dsdrv6.f
index 2e23bbc..b72a747 100644
--- a/EXAMPLES/SYM/dsdrv6.f
+++ b/EXAMPLES/SYM/dsdrv6.f
@@ -50,7 +50,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: sdrv6.F SID: 2.4 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: sdrv6.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -408,8 +408,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/SYM/ssdrv1.f b/EXAMPLES/SYM/ssdrv1.f
index d4588bb..7767301 100644
--- a/EXAMPLES/SYM/ssdrv1.f
+++ b/EXAMPLES/SYM/ssdrv1.f
@@ -40,7 +40,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: sdrv1.F SID: 2.4 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: sdrv1.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -319,8 +319,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/SYM/ssdrv2.f b/EXAMPLES/SYM/ssdrv2.f
index aba92da..8552dfc 100644
--- a/EXAMPLES/SYM/ssdrv2.f
+++ b/EXAMPLES/SYM/ssdrv2.f
@@ -38,7 +38,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: sdrv2.F SID: 2.4 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: sdrv2.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -343,8 +343,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/SYM/ssdrv3.f b/EXAMPLES/SYM/ssdrv3.f
index 4069f01..f524612 100644
--- a/EXAMPLES/SYM/ssdrv3.f
+++ b/EXAMPLES/SYM/ssdrv3.f
@@ -44,7 +44,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: sdrv3.F SID: 2.4 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: sdrv3.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -69,7 +69,7 @@ c %--------------%
c | Local Arrays |
c %--------------%
c
- Real
+ Real
& v(ldv,maxncv), workl(maxncv*(maxncv+8)),
& workd(3*maxn), d(maxncv,2), resid(maxn),
& ad(maxn), adl(maxn), adu(maxn), adu2(maxn),
@@ -85,23 +85,23 @@ c
integer ido, n, nev, ncv, lworkl, info, j, ierr,
& nconv, maxitr, ishfts, mode
logical rvec
- Real
+ Real
& sigma, r1, r2, tol, h
c
c %------------%
c | Parameters |
c %------------%
c
- Real
+ Real
& zero, one, four, six
- parameter ( zero = 0.0E+0, one = 1.0E+0,
- & four = 4.0E+0, six = 6.0E+0 )
+ parameter ( zero = 0.0E+0 , one = 1.0E+0 ,
+ & four = 4.0E+0 , six = 6.0E+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
- Real
+ Real
& snrm2
external saxpy, scopy, sscal, snrm2, sgttrf, sgttrs
c
@@ -186,7 +186,7 @@ c | arising from using piecewise linear finite |
c | elements on the interval [0, 1]. |
c %------------------------------------------------%
c
- h = one / real(n+1)
+ h = one / real (n+1)
c
r1 = (four / six) * h
r2 = (one / six) * h
@@ -377,8 +377,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
@@ -416,10 +416,10 @@ c on the interval [0,1].
c
subroutine mv (n, v, w)
integer n, j
- Real
+ Real
& v(n),w(n), one, four, six, h
- parameter (one = 1.0E+0, four = 4.0E+0,
- & six = 6.0E+0)
+ parameter (one = 1.0E+0 , four = 4.0E+0 ,
+ & six = 6.0E+0 )
c
w(1) = four*v(1) + v(2)
do 100 j = 2,n-1
@@ -430,7 +430,7 @@ c
c
c Scale the vector w by h.
c
- h = one / (real(n+1)*six)
+ h = one / (real (n+1)*six)
call sscal(n, h, w, 1)
return
end
@@ -445,9 +445,9 @@ c piecewise linear elements.
c
subroutine av (n, v, w)
integer n, j
- Real
+ Real
& v(n),w(n), two, one, h
- parameter ( one = 1.0E+0, two = 2.0E+0 )
+ parameter ( one = 1.0E+0 , two = 2.0E+0 )
c
w(1) = two*v(1) - v(2)
do 100 j = 2,n-1
@@ -458,7 +458,7 @@ c
c
c Scale the vector w by (1 / h).
c
- h = one / real(n+1)
+ h = one / real (n+1)
call sscal(n, one/h, w, 1)
return
end
diff --git a/EXAMPLES/SYM/ssdrv4.f b/EXAMPLES/SYM/ssdrv4.f
index b2a1825..2faee6a 100644
--- a/EXAMPLES/SYM/ssdrv4.f
+++ b/EXAMPLES/SYM/ssdrv4.f
@@ -45,7 +45,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: sdrv4.F SID: 2.4 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: sdrv4.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -399,8 +399,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/SYM/ssdrv5.f b/EXAMPLES/SYM/ssdrv5.f
index e863ab1..11ec962 100644
--- a/EXAMPLES/SYM/ssdrv5.f
+++ b/EXAMPLES/SYM/ssdrv5.f
@@ -48,7 +48,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: sdrv5.F SID: 2.4 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: sdrv5.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -397,8 +397,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/EXAMPLES/SYM/ssdrv6.f b/EXAMPLES/SYM/ssdrv6.f
index eebc83e..507ad0d 100644
--- a/EXAMPLES/SYM/ssdrv6.f
+++ b/EXAMPLES/SYM/ssdrv6.f
@@ -50,7 +50,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: sdrv6.F SID: 2.4 DATE OF SID: 4/22/96 RELEASE: 2
+c FILE: sdrv6.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -408,8 +408,8 @@ c
print *, ' '
else if ( info .eq. 3) then
print *, ' '
- print *, ' No shifts could be applied during implicit
- & Arnoldi update, try increasing NCV.'
+ print *, ' No shifts could be applied during implicit',
+ & ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
diff --git a/README b/README
index 66aafc9..572097f 100644
--- a/README
+++ b/README
@@ -1,8 +1,16 @@
1. You have successfully unbundled ARPACK and are now in the ARPACK
directory that was created for you.
+2. Recent bug fixes are included in patch.tar.gz and ppatch.tar.gz
+ (only needed if you are using PARPACK also.) If you have not
+ retrieved these files, please do so and place them in the
+ directory right above the current directory. (They should
+ be in the same directory where arpack96.tar reside).
+ Use uncompress or gunzip to unzip the tar files, and use 'tar -xvf '
+ to unbundle these patches. The source codes in these patches will
+ overwrite those contained in arpack96.tar and parpack96.tar.
-2. Upon executing the 'ls | more ' command you should see
+3. Upon executing the 'ls | more ' command you should see
BLAS
DOCUMENTS
@@ -30,7 +38,7 @@
sequence and usage. Additional information is in the DOCUMENTS directory.
-3. Example driver programs that illustrate all the computational modes,
+4. Example driver programs that illustrate all the computational modes,
data types and precisions may be found in the EXAMPLES directory.
Upon executing the 'ls EXAMPLES | more ' command you should see
@@ -53,7 +61,7 @@
The following instructions explain how to make the ARPACK library.
-4. Before you can compile anything, you must first edit and correct the file
+5. Before you can compile anything, you must first edit and correct the file
ARmake.inc. Sample ARmake.inc's can be found in the ARMAKES directory.
Edit "ARmake.inc" and change the definition "home" to the root of the
source tree (Top level of ARPACK directory)
@@ -63,23 +71,24 @@
BLAS and LAPACK libraries installed on your system you might want to
change the definition of DIRS as indicated in the ARmake.inc file.
- *** NOTE *** The LAPACK library on your system MUST be the public release.
- The current release is version 2.0. If you are not certain if the public
- release has been installed, we strongly recommend that you compile and link
- to the subset of LAPACK included here.
+ *** NOTE *** Unless the LAPACK library on your system is version 2.0,
+ we strongly recommend that you install the LAPACK routines provided with
+ ARPACK. Note that the current LAPACK release is version 3.0; if you are
+ not sure which version of LAPACK is installed, pleaase compile and link
+ to the subset of LAPACK included with ARPACK.
-5. You will also need to change the file "second.f" in the UTIL directory
+6. You will also need to change the file "second.f" in the UTIL directory
to whatever is appropriate for timing on your system. The "second" routine
provided works on most workstations. If you are running on a Cray,
you can just edit the makefile in UTIL and take out the reference to
"second.o" to use the system second routine.
-6. Do "make lib" in the current directory to build the standard library
+7. Do "make lib" in the current directory to build the standard library
"libarpack_$(PLAT).a"
-7. Within DOCUMENTS directory there are three files
+8. Within DOCUMENTS directory there are three files
ex-sym.doc
ex-nonsym.doc and
@@ -91,9 +100,12 @@
Danny Sorensen at [email protected]
- Richard Lehoucq at [email protected]
- Chao Yang at [email protected]
- Kristi Maschhoff at [email protected]
+ Richard Lehoucq at [email protected]
+ Chao Yang at [email protected]
+ Kristi Maschhoff at [email protected]
+
+If you have questions regarding using ARPACK, please send email
+to [email protected].
Good luck and enjoy.
diff --git a/SRC/cgetv0.f b/SRC/cgetv0.f
index dde0e58..6344b65 100644
--- a/SRC/cgetv0.f
+++ b/SRC/cgetv0.f
@@ -106,7 +106,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: getv0.F SID: 2.3 DATE OF SID: 8/27/96 RELEASE: 2
+c FILE: getv0.F SID: 2.3 DATE OF SID: 08/27/96 RELEASE: 2
c
c\EndLib
c
diff --git a/SRC/cnapps.f b/SRC/cnapps.f
index b6e685d..0c8c85b 100644
--- a/SRC/cnapps.f
+++ b/SRC/cnapps.f
@@ -117,7 +117,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: napps.F SID: 2.2 DATE OF SID: 4/20/96 RELEASE: 2
+c FILE: napps.F SID: 2.3 DATE OF SID: 3/28/97 RELEASE: 2
c
c\Remarks
c 1. In this version, each shift is applied to all the sublocks of
@@ -362,7 +362,7 @@ c %-----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G' |
c %-----------------------------------------------------%
c
- do 70 j = 1, min(j+jj, kplusp)
+ do 70 j = 1, min(i+jj, kplusp)
t = c*q(j,i) + conjg(s)*q(j,i+1)
q(j,i+1) = - s*q(j,i) + c*q(j,i+1)
q(j,i) = t
diff --git a/SRC/cnaup2.f b/SRC/cnaup2.f
index d7a6d98..072b10f 100644
--- a/SRC/cnaup2.f
+++ b/SRC/cnaup2.f
@@ -37,7 +37,7 @@ c IUPD Integer. (INPUT)
c IUPD .EQ. 0: use explicit restart instead implicit update.
c IUPD .NE. 0: use implicit update.
c
-c V Complex N by (NEV+NP) array. (INPUT/OUTPUT)
+c V Complex N by (NEV+NP) array. (INPUT/OUTPUT)
c The Arnoldi basis vectors are returned in the first NEV
c columns of V.
c
@@ -45,21 +45,21 @@ c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
-c H Complex (NEV+NP) by (NEV+NP) array. (OUTPUT)
+c H Complex (NEV+NP) by (NEV+NP) array. (OUTPUT)
c H is used to store the generated upper Hessenberg matrix
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
-c RITZ Complex array of length NEV+NP. (OUTPUT)
+c RITZ Complex array of length NEV+NP. (OUTPUT)
c RITZ(1:NEV) contains the computed Ritz values of OP.
c
-c BOUNDS Complex array of length NEV+NP. (OUTPUT)
+c BOUNDS Complex array of length NEV+NP. (OUTPUT)
c BOUNDS(1:NEV) contain the error bounds corresponding to
c the computed Ritz values.
c
-c Q Complex (NEV+NP) by (NEV+NP) array. (WORKSPACE)
+c Q Complex (NEV+NP) by (NEV+NP) array. (WORKSPACE)
c Private (replicated) work array used to accumulate the
c rotation in the shift application step.
c
@@ -67,7 +67,7 @@ c LDQ Integer. (INPUT)
c Leading dimension of Q exactly as declared in the calling
c program.
c
-c WORKL Complex work array of length at least
+c WORKL Complex work array of length at least
c (NEV+NP)**2 + 3*(NEV+NP). (WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end. It is used in shifts calculation, shifts
@@ -84,13 +84,13 @@ c IPNTR(3): pointer to the vector B * X when used in the
c shift-and-invert mode. X is the current operand.
c -------------------------------------------------------------
c
-c WORKD Complex work array of length 3*N. (WORKSPACE)
+c WORKD Complex work array of length 3*N. (WORKSPACE)
c Distributed array to be used in the basic Arnoldi iteration
c for reverse communication. The user should not use WORKD
c as temporary workspace during the iteration !!!!!!!!!!
c See Data Distribution Note in CNAUPD.
c
-c RWORK Real work array of length NEV+NP ( WORKSPACE)
+c RWORK Real work array of length NEV+NP ( WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end.
c
@@ -117,7 +117,7 @@ c
c\BeginLib
c
c\Local variables:
-c xxxxxx Complex
+c xxxxxx Complex
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
@@ -156,7 +156,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: naup2.F SID: 2.5 DATE OF SID: 8/16/96 RELEASE: 2
+c FILE: naup2.F SID: 2.6 DATE OF SID: 06/01/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -184,7 +184,7 @@ c
character bmat*1, which*2
integer ido, info, ishift, iupd, mode, ldh, ldq, ldv, mxiter,
& n, nev, np
- Real
+ Real
& tol
c
c %-----------------%
@@ -192,40 +192,41 @@ c | Array Arguments |
c %-----------------%
c
integer ipntr(13)
- Complex
+ Complex
& bounds(nev+np), h(ldh,nev+np), q(ldq,nev+np),
& resid(n), ritz(nev+np), v(ldv,nev+np),
& workd(3*n), workl( (nev+np)*(nev+np+3) )
- Real
+ Real
& rwork(nev+np)
c
c %------------%
c | Parameters |
c %------------%
c
- Complex
+ Complex
& one, zero
- Real
+ Real
& rzero
- parameter (one = (1.0E+0, 0.0E+0), zero = (0.0E+0, 0.0E+0),
- & rzero = 0.0E+0)
+ parameter (one = (1.0E+0, 0.0E+0) , zero = (0.0E+0, 0.0E+0) ,
+ & rzero = 0.0E+0 )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
- logical cnorm, getv0, initv, update, ushift
- integer ierr, iter, i, j, kplusp, msglvl, nconv, nevbef, nev0,
- & np0, nptemp
- Complex
+ logical cnorm , getv0, initv , update, ushift
+ integer ierr , iter , kplusp, msglvl, nconv,
+ & nevbef, nev0 , np0 , nptemp, i ,
+ & j
+ Complex
& cmpnorm
- Real
- & rtemp, eps23, rnorm
+ Real
+ & rnorm , eps23, rtemp
character wprime*2
c
- save cnorm, getv0, initv, update, ushift,
- & iter, kplusp, msglvl, nconv, nev0, np0,
- & eps23
+ save cnorm, getv0, initv , update, ushift,
+ & rnorm, iter , kplusp, msglvl, nconv ,
+ & nevbef, nev0 , np0 , eps23
c
c
c %-----------------------%
@@ -245,9 +246,9 @@ c %--------------------%
c | External functions |
c %--------------------%
c
- Complex
+ Complex
& cdotc
- Real
+ Real
& scnrm2, slamch, slapy2
external cdotc, scnrm2, slamch, slapy2
c
@@ -255,7 +256,7 @@ c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
- intrinsic aimag, real, min, max
+ intrinsic aimag, real , min, max
c
c %-----------------------%
c | Executable Statements |
@@ -288,7 +289,7 @@ c | Get machine dependent constant. |
c %---------------------------------%
c
eps23 = slamch('Epsilon-Machine')
- eps23 = eps23**(2.0E+0 / 3.0E+0)
+ eps23 = eps23**(2.0E+0 / 3.0E+0 )
c
c %---------------------------------------%
c | Set flags for computing the first NEV |
@@ -415,8 +416,8 @@ c
20 continue
update = .true.
c
- call cnaitr (ido, bmat, n, nev, np, mode, resid, rnorm, v, ldv,
- & h, ldh, ipntr, workd, info)
+ call cnaitr(ido, bmat, n, nev, np, mode, resid, rnorm,
+ & v , ldv , h, ldh, ipntr, workd, info)
c
if (ido .ne. 99) go to 9000
c
@@ -487,9 +488,9 @@ c
nconv = 0
c
do 25 i = 1, nev
- rtemp = max( eps23, slapy2( real(ritz(np+i)),
+ rtemp = max( eps23, slapy2( real (ritz(np+i)),
& aimag(ritz(np+i)) ) )
- if ( slapy2(real(bounds(np+i)),aimag(bounds(np+i)))
+ if ( slapy2(real (bounds(np+i)),aimag(bounds(np+i)))
& .le. tol*rtemp ) then
nconv = nconv + 1
end if
@@ -573,7 +574,7 @@ c | by 1 / max(eps23, magnitude of the Ritz value). |
c %--------------------------------------------------%
c
do 35 j = 1, nev0
- rtemp = max( eps23, slapy2( real(ritz(j)),
+ rtemp = max( eps23, slapy2( real (ritz(j)),
& aimag(ritz(j)) ) )
bounds(j) = bounds(j)/rtemp
35 continue
@@ -594,7 +595,7 @@ c | value. |
c %----------------------------------------------%
c
do 40 j = 1, nev0
- rtemp = max( eps23, slapy2( real(ritz(j)),
+ rtemp = max( eps23, slapy2( real (ritz(j)),
& aimag(ritz(j)) ) )
bounds(j) = bounds(j)*rtemp
40 continue
@@ -754,7 +755,7 @@ c
c
if (bmat .eq. 'G') then
cmpnorm = cdotc (n, resid, 1, workd, 1)
- rnorm = sqrt(slapy2(real(cmpnorm),aimag(cmpnorm)))
+ rnorm = sqrt(slapy2(real (cmpnorm),aimag(cmpnorm)))
else if (bmat .eq. 'I') then
rnorm = scnrm2(n, resid, 1)
end if
diff --git a/SRC/cnaupd.f b/SRC/cnaupd.f
index a78c606..1d15534 100644
--- a/SRC/cnaupd.f
+++ b/SRC/cnaupd.f
@@ -20,11 +20,11 @@ c
c Mode 1: A*x = lambda*x.
c ===> OP = A and B = I.
c
-c Mode 2: A*x = lambda*M*x, M symmetric positive definite
+c Mode 2: A*x = lambda*M*x, M hermitian positive definite
c ===> OP = inv[M]*A and B = M.
c ===> (If M can be factored see remark 3 below)
c
-c Mode 3: A*x = lambda*M*x, M symmetric semi-definite
+c Mode 3: A*x = lambda*M*x, M hermitian semi-definite
c ===> OP = inv[A - sigma*M]*M and B = M.
c ===> shift-and-invert mode
c If OP*x = amu*x, then lambda = sigma + 1/amu.
@@ -167,7 +167,7 @@ c No longer referenced. Implicit restarting is ALWAYS used.
c
c IPARAM(7) = MODE
c On INPUT determines what type of eigenproblem is being solved.
-c Must be 1,2,3,4; See under \Description of cnaupd for the
+c Must be 1,2,3; See under \Description of cnaupd for the
c four modes available.
c
c IPARAM(8) = NP
@@ -246,7 +246,7 @@ c is to increase the size of NCV relative to NEV.
c See remark 4 below.
c = -1: N must be positive.
c = -2: NEV must be positive.
-c = -3: NCV-NEV >= 2 and less than or equal to N.
+c = -3: NCV-NEV >= 1 and less than or equal to N.
c = -4: The maximum number of Arnoldi update iteration
c must be greater than zero.
c = -5: WHICH must be one of 'LM', 'SM', 'LR', 'SR', 'LI', 'SI'
@@ -255,7 +255,7 @@ c = -7: Length of private work array is not sufficient.
c = -8: Error return from LAPACK eigenvalue calculation;
c = -9: Starting vector is zero.
c = -10: IPARAM(7) must be 1,2,3.
-c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatable.
+c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatible.
c = -12: IPARAM(1) must be equal to 0 or 1.
c = -9999: Could not build an Arnoldi factorization.
c User input error highly likely. Please
@@ -275,16 +275,16 @@ c 2. If a basis for the invariant subspace corresponding to the converged Ritz
c values is needed, the user must call cneupd immediately following
c completion of cnaupd. This is new starting with release 2 of ARPACK.
c
-c 3. If M can be factored into a Cholesky factorization M = LL'
+c 3. If M can be factored into a Cholesky factorization M = LL`
c then Mode = 2 should not be selected. Instead one should use
-c Mode = 1 with OP = inv(L)*A*inv(L'). Appropriate triangular
-c linear systems should be solved with L and L' rather
+c Mode = 1 with OP = inv(L)*A*inv(L`). Appropriate triangular
+c linear systems should be solved with L and L` rather
c than computing inverses. After convergence, an approximate
c eigenvector z of the original problem is recovered by solving
-c L'z = x where x is a Ritz vector of OP.
+c L`z = x where x is a Ritz vector of OP.
c
c 4. At present there is no a-priori analysis to guide the selection
-c of NCV relative to NEV. The only formal requrement is that NCV > NEV + 1.
+c of NCV relative to NEV. The only formal requirement is that NCV > NEV + 1.
c However, it is recommended that NCV .ge. 2*NEV. If many problems of
c the same type are to be solved, one should experiment with increasing
c NCV while keeping NEV fixed for a given test problem. This will
@@ -368,7 +368,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: naupd.F SID: 2.4 DATE OF SID: 8/27/96 RELEASE: 2
+c FILE: naupd.F SID: 2.9 DATE OF SID: 07/21/02 RELEASE: 2
c
c\Remarks
c
@@ -460,9 +460,10 @@ c %----------------%
c
ierr = 0
ishift = iparam(1)
- levec = iparam(2)
+c levec = iparam(2)
mxiter = iparam(3)
- nb = iparam(4)
+c nb = iparam(4)
+ nb = 1
c
c %--------------------------------------------%
c | Revision 2 performs only implicit restart. |
@@ -490,7 +491,7 @@ c
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 5*ncv) then
ierr = -7
- else if (mode .lt. 1 .or. mode .gt. 5) then
+ else if (mode .lt. 1 .or. mode .gt. 3) then
ierr = -10
else if (mode .eq. 1 .and. bmat .eq. 'G') then
ierr = -11
diff --git a/SRC/cneupd.f b/SRC/cneupd.f
index 811b251..3a72b41 100644
--- a/SRC/cneupd.f
+++ b/SRC/cneupd.f
@@ -161,7 +161,7 @@ c occurs.
c
c = -1: N must be positive.
c = -2: NEV must be positive.
-c = -3: NCV-NEV >= 2 and less than or equal to N.
+c = -3: NCV-NEV >= 1 and less than or equal to N.
c = -5: WHICH must be one of 'LM', 'SM', 'LR', 'SR', 'LI', 'SI'
c = -6: BMAT must be one of 'I' or 'G'.
c = -7: Length of private work WORKL array is not sufficient.
@@ -175,6 +175,11 @@ c = -12: HOWMNY = 'S' not yet implemented
c = -13: HOWMNY must be one of 'A' or 'P' if RVEC = .true.
c = -14: CNAUPD did not find any eigenvalues to sufficient
c accuracy.
+c = -15: CNEUPD got a different count of the number of converged
+c Ritz values than CNAUPD got. This indicates the user
+c probably made an error in passing data from CNAUPD to
+c CNEUPD or that the data was modified before entering
+c CNEUPD
c
c\BeginLib
c
@@ -220,7 +225,8 @@ c 2. Schur vectors are an orthogonal representation for the basis of
c Ritz vectors. Thus, their numerical properties are often superior.
c If RVEC = .true. then the relationship
c A * V(:,1:IPARAM(5)) = V(:,1:IPARAM(5)) * T, and
-c V(:,1:IPARAM(5))' * V(:,1:IPARAM(5)) = I are approximately satisfied.
+c transpose( V(:,1:IPARAM(5)) ) * V(:,1:IPARAM(5)) = I
+c are approximately satisfied.
c Here T is the leading submatrix of order IPARAM(5) of the
c upper triangular matrix stored workl(ipntr(12)).
c
@@ -234,15 +240,17 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: neupd.F SID: 2.4 DATE OF SID: 7/31/96 RELEASE: 2
+c FILE: neupd.F SID: 2.8 DATE OF SID: 07/21/02 RELEASE: 2
c
c\EndLib
c
c-----------------------------------------------------------------------
- subroutine cneupd (rvec, howmny, select, d, z, ldz, sigma,
- & workev, bmat, n, which, nev, tol,
- & resid, ncv, v, ldv, iparam, ipntr, workd,
- & workl, lworkl, rwork, info)
+ subroutine cneupd(rvec , howmny, select, d ,
+ & z , ldz , sigma , workev,
+ & bmat , n , which , nev ,
+ & tol , resid , ncv , v ,
+ & ldv , iparam, ipntr , workd ,
+ & workl, lworkl, rwork , info )
c
c %----------------------------------------------------%
c | Include files for debugging and timing information |
@@ -272,8 +280,9 @@ c
Real
& rwork(ncv)
Complex
- & d(nev), resid(n), v(ldv,ncv), z(ldz, nev),
- & workd(3*n), workl(lworkl), workev(2*ncv)
+ & d(nev) , resid(n) , v(ldv,ncv),
+ & z(ldz, nev),
+ & workd(3*n) , workl(lworkl), workev(2*ncv)
c
c %------------%
c | Parameters |
@@ -288,21 +297,22 @@ c | Local Scalars |
c %---------------%
c
character type*6
- integer bounds, ierr, ih, ihbds, iheig, nconv,
- & invsub, iuptri, iwev, j,
- & ldh, ldq, mode, msglvl, ritz, wr, k,
- & irz, ibd, ktrord, outncv, iq
+ integer bounds, ierr , ih , ihbds, iheig , nconv ,
+ & invsub, iuptri, iwev , j , ldh , ldq ,
+ & mode , msglvl, ritz , wr , k , irz ,
+ & ibd , outncv, iq , np , numcnv, jj ,
+ & ishift
Complex
& rnorm, temp, vl(1)
Real
- & thres, conds, sep, rtemp, eps23
+ & conds, sep, rtemp, eps23
logical reord
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
- external ccopy, cgeru, cgeqr2, clacpy, cmout,
+ external ccopy , cgeru, cgeqr2, clacpy, cmout,
& cunm2r, ctrmm, cvout, ivout,
& clahqr
c
@@ -352,7 +362,7 @@ c
ierr = -1
else if (nev .le. 0) then
ierr = -2
- else if (ncv .le. nev+1 .or. ncv .gt. n) then
+ else if (ncv .le. nev .or. ncv .gt. n) then
ierr = -3
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
@@ -402,7 +412,7 @@ c | workl(ncv*ncv+ncv+1:ncv*ncv+2*ncv) := error bounds |
c %--------------------------------------------------------%
c
c %-----------------------------------------------------------%
-c | The following is used and set by CNEUPD. |
+c | The following is used and set by CNEUPD. |
c | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := The untransformed |
c | Ritz values. |
c | workl(ncv*ncv+3*ncv+1:ncv*ncv+4*ncv) := The untransformed |
@@ -453,140 +463,108 @@ c %------------------------------------%
c
rnorm = workl(ih+2)
workl(ih+2) = zero
-c
+c
+ if (msglvl .gt. 2) then
+ call cvout(logfil, ncv, workl(irz), ndigit,
+ & '_neupd: Ritz values passed in from _NAUPD.')
+ call cvout(logfil, ncv, workl(ibd), ndigit,
+ & '_neupd: Ritz estimates passed in from _NAUPD.')
+ end if
+c
if (rvec) then
c
-c %-------------------------------------------%
-c | Get converged Ritz value on the boundary. |
-c | Note: converged Ritz values have been |
-c | placed in the first NCONV locations in |
-c | workl(ritz). They have been sorted |
-c | (in _naup2) according to the WHICH |
-c | selection criterion |
-c %-------------------------------------------%
-c
- if (which .eq. 'LM' .or. which .eq. 'SM') then
- thres = slapy2(real(workl(ritz)),aimag(workl(ritz)))
- else if (which .eq. 'LR' .or. which .eq. 'SR') then
- thres = real(workl(ritz))
- else if (which .eq. 'LI' .or. which .eq. 'SI') then
- thres = aimag(workl(ritz))
- end if
+ reord = .false.
+c
+c %---------------------------------------------------%
+c | Use the temporary bounds array to store indices |
+c | These will be used to mark the select array later |
+c %---------------------------------------------------%
+c
+ do 10 j = 1,ncv
+ workl(bounds+j-1) = j
+ select(j) = .false.
+ 10 continue
+c
+c %-------------------------------------%
+c | Select the wanted Ritz values. |
+c | Sort the Ritz values so that the |
+c | wanted ones appear at the tailing |
+c | NEV positions of workl(irr) and |
+c | workl(iri). Move the corresponding |
+c | error estimates in workl(ibd) |
+c | accordingly. |
+c %-------------------------------------%
+c
+ np = ncv - nev
+ ishift = 0
+ call cngets(ishift, which , nev ,
+ & np , workl(irz), workl(bounds))
+c
if (msglvl .gt. 2) then
- call svout(logfil, 1, thres, ndigit,
- & '_neupd: Threshold eigenvalue used for re-ordering')
+ call cvout (logfil, ncv, workl(irz), ndigit,
+ & '_neupd: Ritz values after calling _NGETS.')
+ call cvout (logfil, ncv, workl(bounds), ndigit,
+ & '_neupd: Ritz value indices after calling _NGETS.')
end if
c
-c %---------------------------------------------------------%
-c | Check to see if all converged Ritz values appear at the |
-c | at the top of the upper triangular matrix computed by |
-c | _neigh in _naup2. This is done in the following way: |
-c | |
-c | 1) For each Ritz value from _neigh, compare it with the |
-c | threshold Ritz value computed above to determine |
-c | whether it is a wanted one. |
-c | |
-c | 2) If it is wanted, then check the corresponding Ritz |
-c | estimate to see if it has converged. If it has, set |
-c | correponding entry in the logical array SELECT to |
-c | .TRUE.. |
-c | |
-c | If SELECT(j) = .TRUE. and j > NCONV, then there is a |
-c | converged Ritz value that does not appear at the top of |
-c | the upper triangular matrix computed by _neigh in |
-c | _naup2. Reordering is needed. |
-c %---------------------------------------------------------%
+c %-----------------------------------------------------%
+c | Record indices of the converged wanted Ritz values |
+c | Mark the select array for possible reordering |
+c %-----------------------------------------------------%
+c
+ numcnv = 0
+ do 11 j = 1,ncv
+ rtemp = max(eps23,
+ & slapy2 ( real(workl(irz+ncv-j)),
+ & aimag(workl(irz+ncv-j)) ))
+ jj = workl(bounds + ncv - j)
+ if (numcnv .lt. nconv .and.
+ & slapy2( real(workl(ibd+jj-1)),
+ & aimag(workl(ibd+jj-1)) )
+ & .le. tol*rtemp) then
+ select(jj) = .true.
+ numcnv = numcnv + 1
+ if (jj .gt. nev) reord = .true.
+ endif
+ 11 continue
c
- reord = .false.
- ktrord = 0
- do 10 j = 0, ncv-1
- select(j+1) = .false.
- if (which .eq. 'LM') then
- if ( slapy2(real(workl(irz+j)),
- & aimag(workl(irz+j))) .ge. thres ) then
- rtemp = max( eps23, slapy2(real(workl(irz+j-1)),
- & aimag(workl(irz+j-1))) )
- if ( slapy2(real(workl(ibd+j)),
- & aimag(workl(ibd+j))) .le. tol*rtemp )
- & select(j+1) = .true.
- end if
- else if (which .eq. 'SM') then
- if ( slapy2(real(workl(irz+j)),
- & aimag(workl(irz+j))) .le. thres ) then
- rtemp = max( eps23, slapy2(real(workl(irz+j-1)),
- & aimag(workl(irz+j-1))) )
- if ( slapy2(real(workl(ibd+j)),
- & aimag(workl(ibd+j))) .le. tol*rtemp )
- & select(j+1) = .true.
- end if
- else if (which .eq. 'LR') then
- if ( real(workl(irz+j)) .ge. thres ) then
- rtemp = max( eps23, slapy2(real(workl(irz+j-1)),
- & aimag(workl(irz+j-1))) )
- if ( slapy2(real(workl(ibd+j)),
- & aimag(workl(ibd+j))) .le. tol*rtemp )
- & select(j+1) = .true.
- end if
- else if (which .eq. 'SR') then
- if ( real(workl(irz+j)) .le. thres ) then
- rtemp = max( eps23, slapy2(real(workl(irz+j-1)),
- & aimag(workl(irz+j-1))) )
- if ( slapy2(real(workl(ibd+j)),
- & aimag(workl(ibd+j))) .le. tol*rtemp )
- & select(j+1) = .true.
- end if
- else if (which .eq. 'LI') then
- if ( aimag(workl(irz+j)) .ge. thres ) then
- rtemp = max( eps23, slapy2(real(workl(irz+j-1)),
- & aimag(workl(irz+j-1))) )
- if ( slapy2(real(workl(ibd+j)),
- & aimag(workl(ibd+j))) .le. tol*rtemp )
- & select(j+1) = .true.
- end if
- else if (which .eq. 'SI') then
- if ( aimag(workl(irz+j)) .le. thres ) then
- rtemp = max( eps23, slapy2(real(workl(irz+j-1)),
- & aimag(workl(irz+j-1))) )
- if ( slapy2(real(workl(ibd+j)),
- & aimag(workl(ibd+j))) .le. tol*rtemp )
- & select(j+1) = .true.
- end if
- end if
- if (j+1 .gt. nconv ) reord = ( select(j+1) .or. reord )
- if (select(j+1)) ktrord = ktrord + 1
- 10 continue
+c %-----------------------------------------------------------%
+c | Check the count (numcnv) of converged Ritz values with |
+c | the number (nconv) reported by dnaupd. If these two |
+c | are different then there has probably been an error |
+c | caused by incorrect passing of the dnaupd data. |
+c %-----------------------------------------------------------%
c
if (msglvl .gt. 2) then
- call ivout(logfil, 1, ktrord, ndigit,
+ call ivout(logfil, 1, numcnv, ndigit,
& '_neupd: Number of specified eigenvalues')
call ivout(logfil, 1, nconv, ndigit,
& '_neupd: Number of "converged" eigenvalues')
- end if
-c
-c if (ktrord .gt. nconv) then
-c
-c %-----------------------------------%
-c | More than NCONV Ritz values have |
-c | "converged", and they all satisfy |
-c | the WHICH selection criterion. |
-c %-----------------------------------%
-c
-c iparam(6) = ktrord
+ end if
c
-c end if
+ if (numcnv .ne. nconv) then
+ info = -15
+ go to 9000
+ end if
c
c %-------------------------------------------------------%
-c | Call LAPACK routine clahqr to compute the Schur form |
-c | of the upper Hessenberg matrix returned by CNAUPD. |
+c | Call LAPACK routine clahqr to compute the Schur form |
+c | of the upper Hessenberg matrix returned by CNAUPD. |
c | Make a copy of the upper Hessenberg matrix. |
c | Initialize the Schur vector matrix Q to the identity. |
c %-------------------------------------------------------%
c
- call ccopy (ldh*ncv, workl(ih), 1, workl(iuptri), 1)
- call claset ('All', ncv, ncv, zero, one, workl(invsub), ldq)
- call clahqr (.true., .true., ncv, 1, ncv, workl(iuptri),
- & ldh, workl(iheig), 1, ncv, workl(invsub), ldq, ierr)
- call ccopy (ncv, workl(invsub+ncv-1), ldq, workl(ihbds), 1)
+ call ccopy(ldh*ncv, workl(ih), 1, workl(iuptri), 1)
+ call claset('All', ncv, ncv ,
+ & zero , one, workl(invsub),
+ & ldq)
+ call clahqr(.true., .true. , ncv ,
+ & 1 , ncv , workl(iuptri),
+ & ldh , workl(iheig) , 1 ,
+ & ncv , workl(invsub), ldq ,
+ & ierr)
+ call ccopy(ncv , workl(invsub+ncv-1), ldq,
+ & workl(ihbds), 1)
c
if (ierr .ne. 0) then
info = -8
@@ -599,7 +577,8 @@ c
call cvout (logfil, ncv, workl(ihbds), ndigit,
& '_neupd: Last row of the Schur vector matrix')
if (msglvl .gt. 3) then
- call cmout (logfil, ncv, ncv, workl(iuptri), ldh, ndigit,
+ call cmout (logfil , ncv, ncv ,
+ & workl(iuptri), ldh, ndigit,
& '_neupd: The upper triangular matrix ')
end if
end if
@@ -610,9 +589,11 @@ c %-----------------------------------------------%
c | Reorder the computed upper triangular matrix. |
c %-----------------------------------------------%
c
- call ctrsen ('None', 'V', select, ncv, workl(iuptri), ldh,
- & workl(invsub), ldq, workl(iheig), nconv, conds, sep,
- & workev, ncv, ierr)
+ call ctrsen('None' , 'V' , select ,
+ & ncv , workl(iuptri), ldh ,
+ & workl(invsub), ldq , workl(iheig),
+ & nconv , conds , sep ,
+ & workev , ncv , ierr)
c
if (ierr .eq. 1) then
info = 1
@@ -623,8 +604,8 @@ c
call cvout (logfil, ncv, workl(iheig), ndigit,
& '_neupd: Eigenvalues of H--reordered')
if (msglvl .gt. 3) then
- call cmout (logfil, ncv, ncv, workl(iuptri), ldq,
- & ndigit,
+ call cmout(logfil , ncv, ncv ,
+ & workl(iuptri), ldq, ndigit,
& '_neupd: Triangular matrix after re-ordering')
end if
end if
@@ -638,7 +619,8 @@ c | to compute the Ritz estimates of converged |
c | Ritz values. |
c %---------------------------------------------%
c
- call ccopy (ncv, workl(invsub+ncv-1), ldq, workl(ihbds), 1)
+ call ccopy(ncv , workl(invsub+ncv-1), ldq,
+ & workl(ihbds), 1)
c
c %--------------------------------------------%
c | Place the computed eigenvalues of H into D |
@@ -646,7 +628,7 @@ c | if a spectral transformation was not used. |
c %--------------------------------------------%
c
if (type .eq. 'REGULR') then
- call ccopy (nconv, workl(iheig), 1, d, 1)
+ call ccopy(nconv, workl(iheig), 1, d, 1)
end if
c
c %----------------------------------------------------------%
@@ -655,8 +637,9 @@ c | the wanted invariant subspace located in the first NCONV |
c | columns of workl(invsub,ldq). |
c %----------------------------------------------------------%
c
- call cgeqr2 (ncv, nconv, workl(invsub), ldq, workev,
- & workev(ncv+1), ierr)
+ call cgeqr2(ncv , nconv , workl(invsub),
+ & ldq , workev, workev(ncv+1),
+ & ierr)
c
c %--------------------------------------------------------%
c | * Postmultiply V by Q using cunm2r. |
@@ -670,10 +653,11 @@ c | associated with the upper triangular matrix of order |
c | NCONV in workl(iuptri). |
c %--------------------------------------------------------%
c
- call cunm2r ('Right', 'Notranspose', n, ncv, nconv,
- & workl(invsub), ldq, workev, v, ldv, workd(n+1),
- & ierr)
- call clacpy ('All', n, nconv, v, ldv, z, ldz)
+ call cunm2r('Right', 'Notranspose', n ,
+ & ncv , nconv , workl(invsub),
+ & ldq , workev , v ,
+ & ldv , workd(n+1) , ierr)
+ call clacpy('All', n, nconv, v, ldv, z, ldz)
c
do 20 j=1, nconv
c
@@ -688,8 +672,8 @@ c %---------------------------------------------------%
c
if ( real( workl(invsub+(j-1)*ldq+j-1) ) .lt.
& real(zero) ) then
- call cscal (nconv, -one, workl(iuptri+j-1), ldq)
- call cscal (nconv, -one, workl(iuptri+(j-1)*ldq), 1)
+ call cscal(nconv, -one, workl(iuptri+j-1), ldq)
+ call cscal(nconv, -one, workl(iuptri+(j-1)*ldq), 1)
end if
c
20 continue
@@ -709,9 +693,11 @@ c
end if
30 continue
c
- call ctrevc ('Right', 'Select', select, ncv, workl(iuptri),
- & ldq, vl, 1, workl(invsub), ldq, ncv, outncv, workev,
- & rwork, ierr)
+ call ctrevc('Right', 'Select' , select ,
+ & ncv , workl(iuptri), ldq ,
+ & vl , 1 , workl(invsub),
+ & ldq , ncv , outncv ,
+ & workev , rwork , ierr)
c
if (ierr .ne. 0) then
info = -9
@@ -749,10 +735,11 @@ c
call ccopy(nconv, workl(invsub+ncv-1), ldq,
& workl(ihbds), 1)
call cvout (logfil, nconv, workl(ihbds), ndigit,
- & '_neupd: Last row of the eigenvector matrix for T')
+ & '_neupd: Last row of the eigenvector matrix for T')
if (msglvl .gt. 3) then
- call cmout (logfil, ncv, ncv, workl(invsub), ldq,
- & ndigit, '_neupd: The eigenvector matrix for T')
+ call cmout(logfil , ncv, ncv ,
+ & workl(invsub), ldq, ndigit,
+ & '_neupd: The eigenvector matrix for T')
end if
end if
c
@@ -767,9 +754,10 @@ c | The eigenvector matrix Q of T is triangular. |
c | Form Z*Q. |
c %----------------------------------------------%
c
- call ctrmm ('Right', 'Upper', 'No transpose', 'Non-unit',
- & n, nconv, one, workl(invsub), ldq, z, ldz)
-c
+ call ctrmm('Right' , 'Upper' , 'No transpose',
+ & 'Non-unit', n , nconv ,
+ & one , workl(invsub), ldq ,
+ & z , ldz)
end if
c
else
@@ -779,9 +767,9 @@ c | An approximate invariant subspace is not needed. |
c | Place the Ritz values computed CNAUPD into D. |
c %--------------------------------------------------%
c
- call ccopy (nconv, workl(ritz), 1, d, 1)
- call ccopy (nconv, workl(ritz), 1, workl(iheig), 1)
- call ccopy (nconv, workl(bounds), 1, workl(ihbds), 1)
+ call ccopy(nconv, workl(ritz), 1, d, 1)
+ call ccopy(nconv, workl(ritz), 1, workl(iheig), 1)
+ call ccopy(nconv, workl(bounds), 1, workl(ihbds), 1)
c
end if
c
@@ -878,7 +866,7 @@ c
return
c
c %---------------%
-c | End of cneupd |
+c | End of cneupd|
c %---------------%
c
end
diff --git a/SRC/dgetv0.f b/SRC/dgetv0.f
index 8785a43..40d384e 100644
--- a/SRC/dgetv0.f
+++ b/SRC/dgetv0.f
@@ -110,7 +110,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: getv0.F SID: 2.6 DATE OF SID: 8/27/96 RELEASE: 2
+c FILE: getv0.F SID: 2.7 DATE OF SID: 04/07/99 RELEASE: 2
c
c\EndLib
c
@@ -373,7 +373,7 @@ c
if (rnorm .gt. 0.717*rnorm0) go to 50
c
iter = iter + 1
- if (iter .le. 1) then
+ if (iter .le. 5) then
c
c %-----------------------------------%
c | Perform iterative refinement step |
@@ -400,7 +400,7 @@ c
call dvout (logfil, 1, rnorm, ndigit,
& '_getv0: B-norm of initial / restarted starting vector')
end if
- if (msglvl .gt. 2) then
+ if (msglvl .gt. 3) then
call dvout (logfil, n, resid, ndigit,
& '_getv0: initial / restarted starting vector')
end if
diff --git a/SRC/dnapps.f b/SRC/dnapps.f
index 409e459..5385c1b 100644
--- a/SRC/dnapps.f
+++ b/SRC/dnapps.f
@@ -124,10 +124,10 @@ c Rice University
c Houston, Texas
c
c\Revision history:
-c xx/xx/92: Version ' 2.1'
+c xx/xx/92: Version ' 2.4'
c
c\SCCS Information: @(#)
-c FILE: napps.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2
+c FILE: napps.F SID: 2.4 DATE OF SID: 3/28/97 RELEASE: 2
c
c\Remarks
c 1. In this version, each shift is applied to all the sublocks of
@@ -430,7 +430,7 @@ c %----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G |
c %----------------------------------------------------%
c
- do 70 j = 1, min( j+jj, kplusp )
+ do 70 j = 1, min( i+jj, kplusp )
t = c*q(j,i) + s*q(j,i+1)
q(j,i+1) = - s*q(j,i) + c*q(j,i+1)
q(j,i) = t
diff --git a/SRC/dnaup2.f b/SRC/dnaup2.f
index 6851164..57f0b4f 100644
--- a/SRC/dnaup2.f
+++ b/SRC/dnaup2.f
@@ -162,7 +162,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: naup2.F SID: 2.4 DATE OF SID: 7/30/96 RELEASE: 2
+c FILE: naup2.F SID: 2.8 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -216,25 +216,27 @@ c | Local Scalars |
c %---------------%
c
character wprime*2
- logical cnorm, getv0, initv, update, ushift
- integer ierr, iter, j, kplusp, msglvl, nconv, nevbef, nev0,
- & np0, nptemp, numcnv
+ logical cnorm , getv0, initv, update, ushift
+ integer ierr , iter , j , kplusp, msglvl, nconv,
+ & nevbef, nev0 , np0 , nptemp, numcnv
Double precision
- & rnorm, temp, eps23
+ & rnorm , temp , eps23
+ save cnorm , getv0, initv, update, ushift,
+ & rnorm , iter , eps23, kplusp, msglvl, nconv ,
+ & nevbef, nev0 , np0 , numcnv
c
c %-----------------------%
c | Local array arguments |
c %-----------------------%
c
integer kp(4)
- save
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
- external dcopy, dgetv0, dnaitr, dnconv, dneigh, dngets, dnapps,
- & dvout, ivout, second
+ external dcopy , dgetv0, dnaitr, dnconv, dneigh,
+ & dngets, dnapps, dvout , ivout , second
c
c %--------------------%
c | External Functions |
@@ -413,8 +415,9 @@ c
20 continue
update = .true.
c
- call dnaitr (ido, bmat, n, nev, np, mode, resid, rnorm, v, ldv,
- & h, ldh, ipntr, workd, info)
+ call dnaitr (ido , bmat, n , nev, np , mode , resid,
+ & rnorm, v , ldv, h , ldh, ipntr, workd,
+ & info)
c
c %---------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
@@ -587,7 +590,7 @@ c | Scale the Ritz estimate of each Ritz value |
c | by 1 / max(eps23,magnitude of the Ritz value). |
c %--------------------------------------------------%
c
- do 35 j = 1, nev0
+ do 35 j = 1, numcnv
temp = max(eps23,dlapy2(ritzr(j),
& ritzi(j)))
bounds(j) = bounds(j)/temp
@@ -601,14 +604,14 @@ c | (in the case when NCONV < NEV.) |
c %----------------------------------------------------%
c
wprime = 'LR'
- call dsortc(wprime, .true., nev0, bounds, ritzr, ritzi)
+ call dsortc(wprime, .true., numcnv, bounds, ritzr, ritzi)
c
c %----------------------------------------------%
c | Scale the Ritz estimate back to its original |
c | value. |
c %----------------------------------------------%
c
- do 40 j = 1, nev0
+ do 40 j = 1, numcnv
temp = max(eps23, dlapy2(ritzr(j),
& ritzi(j)))
bounds(j) = bounds(j)*temp
diff --git a/SRC/dnaupd.f b/SRC/dnaupd.f
index 1339ccc..3b7cc3e 100644
--- a/SRC/dnaupd.f
+++ b/SRC/dnaupd.f
@@ -9,7 +9,7 @@ c of a linear operator "OP" with respect to a semi-inner product defined by
c a symmetric positive semi-definite real matrix B. B may be the identity
c matrix. NOTE: If the linear operator "OP" is real and symmetric
c with respect to the real positive semi-definite symmetric matrix B,
-c i.e. B*OP = (OP')*B, then subroutine ssaupd should be used instead.
+c i.e. B*OP = (OP`)*B, then subroutine dsaupd should be used instead.
c
c The computed approximate eigenvalues are called Ritz values and
c the corresponding approximate eigenvectors are called Ritz vectors.
@@ -110,7 +110,7 @@ c 'SR' -> want the NEV eigenvalues of smallest real part.
c 'LI' -> want the NEV eigenvalues of largest imaginary part.
c 'SI' -> want the NEV eigenvalues of smallest imaginary part.
c
-c NEV Integer. (INPUT)
+c NEV Integer. (INPUT/OUTPUT)
c Number of eigenvalues of OP to be computed. 0 < NEV < N-1.
c
c TOL Double precision scalar. (INPUT)
@@ -289,13 +289,13 @@ c 2. If a basis for the invariant subspace corresponding to the converged Ritz
c values is needed, the user must call dneupd immediately following
c completion of dnaupd. This is new starting with release 2 of ARPACK.
c
-c 3. If M can be factored into a Cholesky factorization M = LL'
+c 3. If M can be factored into a Cholesky factorization M = LL`
c then Mode = 2 should not be selected. Instead one should use
-c Mode = 1 with OP = inv(L)*A*inv(L'). Appropriate triangular
-c linear systems should be solved with L and L' rather
+c Mode = 1 with OP = inv(L)*A*inv(L`). Appropriate triangular
+c linear systems should be solved with L and L` rather
c than computing inverses. After convergence, an approximate
c eigenvector z of the original problem is recovered by solving
-c L'z = x where x is a Ritz vector of OP.
+c L`z = x where x is a Ritz vector of OP.
c
c 4. At present there is no a-priori analysis to guide the selection
c of NCV relative to NEV. The only formal requrement is that NCV > NEV + 2.
@@ -395,7 +395,7 @@ c\Revision history:
c 12/16/93: Version '1.1'
c
c\SCCS Information: @(#)
-c FILE: naupd.F SID: 2.5 DATE OF SID: 8/27/96 RELEASE: 2
+c FILE: naupd.F SID: 2.10 DATE OF SID: 08/23/02 RELEASE: 2
c
c\Remarks
c
@@ -485,9 +485,10 @@ c %----------------%
c
ierr = 0
ishift = iparam(1)
- levec = iparam(2)
+c levec = iparam(2)
mxiter = iparam(3)
- nb = iparam(4)
+c nb = iparam(4)
+ nb = 1
c
c %--------------------------------------------%
c | Revision 2 performs only implicit restart. |
@@ -497,13 +498,13 @@ c
mode = iparam(7)
c
if (n .le. 0) then
- ierr = -1
+ ierr = -1
else if (nev .le. 0) then
- ierr = -2
+ ierr = -2
else if (ncv .le. nev+1 .or. ncv .gt. n) then
- ierr = -3
- else if (mxiter .le. 0) then
- ierr = -4
+ ierr = -3
+ else if (mxiter .le. 0) then
+ ierr = 4
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LR' .and.
@@ -515,12 +516,12 @@ c
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 6*ncv) then
ierr = -7
- else if (mode .lt. 1 .or. mode .gt. 5) then
- ierr = -10
+ else if (mode .lt. 1 .or. mode .gt. 4) then
+ ierr = -10
else if (mode .eq. 1 .and. bmat .eq. 'G') then
- ierr = -11
+ ierr = -11
else if (ishift .lt. 0 .or. ishift .gt. 1) then
- ierr = -12
+ ierr = -12
end if
c
c %------------%
diff --git a/SRC/dneupd.f b/SRC/dneupd.f
index 2422340..91e132d 100644
--- a/SRC/dneupd.f
+++ b/SRC/dneupd.f
@@ -1,6 +1,6 @@
c\BeginDoc
c
-c\Name: dneupd
+c\Name: dneupd
c
c\Description:
c
@@ -21,21 +21,21 @@ c
c The approximate eigenvalues and eigenvectors of A*z = lambda*B*z
c are derived from approximate eigenvalues and eigenvectors of
c of the linear operator OP prescribed by the MODE selection in the
-c call to DNAUPD. DNAUPD must be called before this routine is called.
+c call to DNAUPD . DNAUPD must be called before this routine is called.
c These approximate eigenvalues and vectors are commonly called Ritz
c values and Ritz vectors respectively. They are referred to as such
c in the comments that follow. The computed orthonormal basis for the
c invariant subspace corresponding to these Ritz values is referred to as a
c Schur basis.
c
-c See documentation in the header of the subroutine DNAUPD for
+c See documentation in the header of the subroutine DNAUPD for
c definition of OP as well as other terms and the relation of computed
c Ritz values and Ritz vectors of OP with respect to the given problem
c A*z = lambda*B*z. For a brief description, see definitions of
-c IPARAM(7), MODE and WHICH in the documentation of DNAUPD.
+c IPARAM(7), MODE and WHICH in the documentation of DNAUPD .
c
c\Usage:
-c call dneupd
+c call dneupd
c ( RVEC, HOWMNY, SELECT, DR, DI, Z, LDZ, SIGMAR, SIGMAI, WORKEV, BMAT,
c N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, WORKL,
c LWORKL, INFO )
@@ -66,17 +66,17 @@ c computed. To select the Ritz vector corresponding to a
c Ritz value (DR(j), DI(j)), SELECT(j) must be set to .TRUE..
c If HOWMNY = 'A' or 'P', SELECT is used as internal workspace.
c
-c DR Double precision array of dimension NEV+1. (OUTPUT)
+c DR Double precision array of dimension NEV+1. (OUTPUT)
c If IPARAM(7) = 1,2 or 3 and SIGMAI=0.0 then on exit: DR contains
c the real part of the Ritz approximations to the eigenvalues of
c A*z = lambda*B*z.
c If IPARAM(7) = 3, 4 and SIGMAI is not equal to zero, then on exit:
c DR contains the real part of the Ritz values of OP computed by
-c DNAUPD. A further computation must be performed by the user
-c to transform the Ritz values computed for OP by DNAUPD to those
+c DNAUPD . A further computation must be performed by the user
+c to transform the Ritz values computed for OP by DNAUPD to those
c of the original system A*z = lambda*B*z. See remark 3 below.
c
-c DI Double precision array of dimension NEV+1. (OUTPUT)
+c DI Double precision array of dimension NEV+1. (OUTPUT)
c On exit, DI contains the imaginary part of the Ritz value
c approximations to the eigenvalues of A*z = lambda*B*z associated
c with DR.
@@ -88,7 +88,7 @@ c pairs and the real and imaginary parts of these are
c represented in two consecutive columns of the array Z
c (see below).
c
-c Z Double precision N by NEV+1 array if RVEC = .TRUE. and HOWMNY = 'A'. (OUTPUT)
+c Z Double precision N by NEV+1 array if RVEC = .TRUE. and HOWMNY = 'A'. (OUTPUT)
c On exit, if RVEC = .TRUE. and HOWMNY = 'A', then the columns of
c Z represent approximate eigenvectors (Ritz vectors) corresponding
c to the NCONV=IPARAM(5) Ritz values for eigensystem
@@ -106,41 +106,41 @@ c If RVEC = .FALSE. or HOWMNY = 'P', then Z is not referenced.
c
c NOTE: If if RVEC = .TRUE. and a Schur basis is not required,
c the array Z may be set equal to first NEV+1 columns of the Arnoldi
-c basis array V computed by DNAUPD. In this case the Arnoldi basis
+c basis array V computed by DNAUPD . In this case the Arnoldi basis
c will be destroyed and overwritten with the eigenvector basis.
c
c LDZ Integer. (INPUT)
c The leading dimension of the array Z. If Ritz vectors are
c desired, then LDZ >= max( 1, N ). In any case, LDZ >= 1.
c
-c SIGMAR Double precision (INPUT)
+c SIGMAR Double precision (INPUT)
c If IPARAM(7) = 3 or 4, represents the real part of the shift.
c Not referenced if IPARAM(7) = 1 or 2.
c
-c SIGMAI Double precision (INPUT)
+c SIGMAI Double precision (INPUT)
c If IPARAM(7) = 3 or 4, represents the imaginary part of the shift.
c Not referenced if IPARAM(7) = 1 or 2. See remark 3 below.
c
-c WORKEV Double precision work array of dimension 3*NCV. (WORKSPACE)
+c WORKEV Double precision work array of dimension 3*NCV. (WORKSPACE)
c
c **** The remaining arguments MUST be the same as for the ****
-c **** call to DNAUPD that was just completed. ****
+c **** call to DNAUPD that was just completed. ****
c
c NOTE: The remaining arguments
c
c BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR,
c WORKD, WORKL, LWORKL, INFO
c
-c must be passed directly to DNEUPD following the last call
-c to DNAUPD. These arguments MUST NOT BE MODIFIED between
-c the the last call to DNAUPD and the call to DNEUPD.
+c must be passed directly to DNEUPD following the last call
+c to DNAUPD . These arguments MUST NOT BE MODIFIED between
+c the the last call to DNAUPD and the call to DNEUPD .
c
c Three of these parameters (V, WORKL, INFO) are also output parameters:
c
-c V Double precision N by NCV array. (INPUT/OUTPUT)
+c V Double precision N by NCV array. (INPUT/OUTPUT)
c
c Upon INPUT: the NCV columns of V contain the Arnoldi basis
-c vectors for OP as constructed by DNAUPD .
+c vectors for OP as constructed by DNAUPD .
c
c Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns
c contain approximate Schur vectors that span the
@@ -153,16 +153,16 @@ c Ritz vectors. If a separate array Z has been passed then
c the first NCONV=IPARAM(5) columns of V will contain approximate
c Schur vectors that span the desired invariant subspace.
c
-c WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE)
+c WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE)
c WORKL(1:ncv*ncv+3*ncv) contains information obtained in
-c dnaupd. They are not changed by dneupd.
+c dnaupd . They are not changed by dneupd .
c WORKL(ncv*ncv+3*ncv+1:3*ncv*ncv+6*ncv) holds the
c real and imaginary part of the untransformed Ritz values,
c the upper quasi-triangular matrix for H, and the
c associated matrix representation of the invariant subspace for H.
c
c Note: IPNTR(9:13) contains the pointer into WORKL for addresses
-c of the above information computed by dneupd.
+c of the above information computed by dneupd .
c -------------------------------------------------------------
c IPNTR(9): pointer to the real part of the NCV RITZ values of the
c original system.
@@ -173,7 +173,7 @@ c IPNTR(12): pointer to the NCV by NCV upper quasi-triangular
c Schur matrix for H.
c IPNTR(13): pointer to the NCV by NCV matrix of eigenvectors
c of the upper Hessenberg matrix H. Only referenced by
-c dneupd if RVEC = .TRUE. See Remark 2 below.
+c dneupd if RVEC = .TRUE. See Remark 2 below.
c -------------------------------------------------------------
c
c INFO Integer. (OUTPUT)
@@ -181,9 +181,9 @@ c Error flag on output.
c
c = 0: Normal exit.
c
-c = 1: The Schur form computed by LAPACK routine dlahqr
-c could not be reordered by LAPACK routine dtrsen.
-c Re-enter subroutine dneupd with IPARAM(5)=NCV and
+c = 1: The Schur form computed by LAPACK routine dlahqr
+c could not be reordered by LAPACK routine dtrsen .
+c Re-enter subroutine dneupd with IPARAM(5)=NCV and
c increase the size of the arrays DR and DI to have
c dimension at least dimension NCV and allocate at least NCV
c columns for Z. NOTE: Not necessary if Z and V share
@@ -197,15 +197,20 @@ c = -5: WHICH must be one of 'LM', 'SM', 'LR', 'SR', 'LI', 'SI'
c = -6: BMAT must be one of 'I' or 'G'.
c = -7: Length of private work WORKL array is not sufficient.
c = -8: Error return from calculation of a real Schur form.
-c Informational error from LAPACK routine dlahqr.
+c Informational error from LAPACK routine dlahqr .
c = -9: Error return from calculation of eigenvectors.
-c Informational error from LAPACK routine dtrevc.
+c Informational error from LAPACK routine dtrevc .
c = -10: IPARAM(7) must be 1,2,3,4.
c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatible.
c = -12: HOWMNY = 'S' not yet implemented
c = -13: HOWMNY must be one of 'A' or 'P' if RVEC = .true.
-c = -14: DNAUPD did not find any eigenvalues to sufficient
+c = -14: DNAUPD did not find any eigenvalues to sufficient
c accuracy.
+c = -15: DNEUPD got a different count of the number of converged
+c Ritz values than DNAUPD got. This indicates the user
+c probably made an error in passing data from DNAUPD to
+c DNEUPD or that the data was modified before entering
+c DNEUPD
c
c\BeginLib
c
@@ -222,41 +227,41 @@ c pp 575-595, (1987).
c
c\Routines called:
c ivout ARPACK utility routine that prints integers.
-c dmout ARPACK utility routine that prints matrices
-c dvout ARPACK utility routine that prints vectors.
-c dgeqr2 LAPACK routine that computes the QR factorization of
+c dmout ARPACK utility routine that prints matrices
+c dvout ARPACK utility routine that prints vectors.
+c dgeqr2 LAPACK routine that computes the QR factorization of
c a matrix.
-c dlacpy LAPACK matrix copy routine.
-c dlahqr LAPACK routine to compute the real Schur form of an
+c dlacpy LAPACK matrix copy routine.
+c dlahqr LAPACK routine to compute the real Schur form of an
c upper Hessenberg matrix.
-c dlamch LAPACK routine that determines machine constants.
-c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c dlaset LAPACK matrix initialization routine.
-c dorm2r LAPACK routine that applies an orthogonal matrix in
+c dlamch LAPACK routine that determines machine constants.
+c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
+c dlaset LAPACK matrix initialization routine.
+c dorm2r LAPACK routine that applies an orthogonal matrix in
c factored form.
-c dtrevc LAPACK routine to compute the eigenvectors of a matrix
+c dtrevc LAPACK routine to compute the eigenvectors of a matrix
c in upper quasi-triangular form.
-c dtrsen LAPACK routine that re-orders the Schur form.
-c dtrmm Level 3 BLAS matrix times an upper triangular matrix.
-c dger Level 2 BLAS rank one update to a matrix.
-c dcopy Level 1 BLAS that copies one vector to another .
-c ddot Level 1 BLAS that computes the scalar product of two vectors.
-c dnrm2 Level 1 BLAS that computes the norm of a vector.
-c dscal Level 1 BLAS that scales a vector.
+c dtrsen LAPACK routine that re-orders the Schur form.
+c dtrmm Level 3 BLAS matrix times an upper triangular matrix.
+c dger Level 2 BLAS rank one update to a matrix.
+c dcopy Level 1 BLAS that copies one vector to another .
+c ddot Level 1 BLAS that computes the scalar product of two vectors.
+c dnrm2 Level 1 BLAS that computes the norm of a vector.
+c dscal Level 1 BLAS that scales a vector.
c
c\Remarks
c
c 1. Currently only HOWMNY = 'A' and 'P' are implemented.
c
-c Let X' denote the transpose of X.
+c Let trans(X) denote the transpose of X.
c
c 2. Schur vectors are an orthogonal representation for the basis of
c Ritz vectors. Thus, their numerical properties are often superior.
c If RVEC = .TRUE. then the relationship
c A * V(:,1:IPARAM(5)) = V(:,1:IPARAM(5)) * T, and
-c V(:,1:IPARAM(5))' * V(:,1:IPARAM(5)) = I are approximately satisfied.
-c Here T is the leading submatrix of order IPARAM(5) of the real
-c upper quasi-triangular matrix stored workl(ipntr(12)). That is,
+c trans(V(:,1:IPARAM(5))) * V(:,1:IPARAM(5)) = I are approximately
+c satisfied. Here T is the leading submatrix of order IPARAM(5) of the
+c real upper quasi-triangular matrix stored workl(ipntr(12)). That is,
c T is block upper triangular with 1-by-1 and 2-by-2 diagonal blocks;
c each 2-by-2 diagonal block has its diagonal elements equal and its
c off-diagonal elements of opposite sign. Corresponding to each 2-by-2
@@ -265,16 +270,17 @@ c Ritz values are stored on the diagonal of T.
c
c 3. If IPARAM(7) = 3 or 4 and SIGMAI is not equal zero, then the user must
c form the IPARAM(5) Rayleigh quotients in order to transform the Ritz
-c values computed by DNAUPD for OP to those of A*z = lambda*B*z.
+c values computed by DNAUPD for OP to those of A*z = lambda*B*z.
c Set RVEC = .true. and HOWMNY = 'A', and
c compute
-c Z(:,I)' * A * Z(:,I) if DI(I) = 0.
+c trans(Z(:,I)) * A * Z(:,I) if DI(I) = 0.
c If DI(I) is not equal to zero and DI(I+1) = - D(I),
c then the desired real and imaginary parts of the Ritz value are
-c Z(:,I)' * A * Z(:,I) + Z(:,I+1)' * A * Z(:,I+1),
-c Z(:,I)' * A * Z(:,I+1) - Z(:,I+1)' * A * Z(:,I), respectively.
+c trans(Z(:,I)) * A * Z(:,I) + trans(Z(:,I+1)) * A * Z(:,I+1),
+c trans(Z(:,I)) * A * Z(:,I+1) - trans(Z(:,I+1)) * A * Z(:,I),
+c respectively.
c Another possibility is to set RVEC = .true. and HOWMNY = 'P' and
-c compute V(:,1:IPARAM(5))' * A * V(:,1:IPARAM(5)) and then an upper
+c compute trans(V(:,1:IPARAM(5))) * A * V(:,1:IPARAM(5)) and then an upper
c quasi-triangular matrix of order IPARAM(5) is computed. See remark
c 2 above.
c
@@ -288,15 +294,16 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: neupd.F SID: 2.5 DATE OF SID: 7/31/96 RELEASE: 2
+c FILE: neupd.F SID: 2.7 DATE OF SID: 09/20/00 RELEASE: 2
c
c\EndLib
c
c-----------------------------------------------------------------------
- subroutine dneupd (rvec, howmny, select, dr, di, z, ldz, sigmar,
- & sigmai, workev, bmat, n, which, nev, tol,
- & resid, ncv, v, ldv, iparam, ipntr, workd,
- & workl, lworkl, info)
+ subroutine dneupd (rvec , howmny, select, dr , di,
+ & z , ldz , sigmar, sigmai, workev,
+ & bmat , n , which , nev , tol,
+ & resid, ncv , v , ldv , iparam,
+ & ipntr, workd , workl , lworkl, info)
c
c %----------------------------------------------------%
c | Include files for debugging and timing information |
@@ -312,7 +319,7 @@ c
character bmat, howmny, which*2
logical rvec
integer info, ldz, ldv, lworkl, n, ncv, nev
- Double precision
+ Double precision
& sigmar, sigmai, tol
c
c %-----------------%
@@ -321,45 +328,53 @@ c %-----------------%
c
integer iparam(11), ipntr(14)
logical select(ncv)
- Double precision
- & dr(nev+1), di(nev+1), resid(n), v(ldv,ncv), z(ldz,*),
- & workd(3*n), workl(lworkl), workev(3*ncv)
+ Double precision
+ & dr(nev+1) , di(nev+1), resid(n) ,
+ & v(ldv,ncv) , z(ldz,*) , workd(3*n),
+ & workl(lworkl), workev(3*ncv)
c
c %------------%
c | Parameters |
c %------------%
c
- Double precision
+ Double precision
& one, zero
- parameter (one = 1.0D+0, zero = 0.0D+0)
+ parameter (one = 1.0D+0 , zero = 0.0D+0 )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character type*6
- integer bounds, ierr, ih, ihbds, iheigr, iheigi, iconj, nconv,
- & invsub, iuptri, iwev, iwork(1), j, k, ktrord,
- & ldh, ldq, mode, msglvl, outncv, ritzr, ritzi, wri, wrr,
- & irr, iri, ibd
+ integer bounds, ierr , ih , ihbds ,
+ & iheigr, iheigi, iconj , nconv ,
+ & invsub, iuptri, iwev , iwork(1),
+ & j , k , ldh , ldq ,
+ & mode , msglvl, outncv, ritzr ,
+ & ritzi , wri , wrr , irr ,
+ & iri , ibd , ishift, numcnv ,
+ & np , jj
logical reord
- Double precision
- & conds, rnorm, sep, temp, thres, vl(1,1), temp1, eps23
+ Double precision
+ & conds , rnorm, sep , temp,
+ & vl(1,1), temp1, eps23
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
- external dcopy, dger, dgeqr2, dlacpy, dlahqr, dlaset, dmout,
- & dorm2r, dtrevc, dtrmm, dtrsen, dscal, dvout, ivout
+ external dcopy , dger , dgeqr2 , dlacpy ,
+ & dlahqr , dlaset , dmout , dorm2r ,
+ & dtrevc , dtrmm , dtrsen , dscal ,
+ & dvout , ivout
c
c %--------------------%
c | External Functions |
c %--------------------%
c
- Double precision
- & dlapy2, dnrm2, dlamch, ddot
- external dlapy2, dnrm2, dlamch, ddot
+ Double precision
+ & dlapy2 , dnrm2 , dlamch , ddot
+ external dlapy2 , dnrm2 , dlamch , ddot
c
c %---------------------%
c | Intrinsic Functions |
@@ -384,8 +399,8 @@ c %---------------------------------%
c | Get machine dependent constant. |
c %---------------------------------%
c
- eps23 = dlamch('Epsilon-Machine')
- eps23 = eps23**(2.0D+0 / 3.0D+0)
+ eps23 = dlamch ('Epsilon-Machine')
+ eps23 = eps23**(2.0D+0 / 3.0D+0 )
c
c %--------------%
c | Quick return |
@@ -454,7 +469,7 @@ c | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := error bounds |
c %--------------------------------------------------------%
c
c %-----------------------------------------------------------%
-c | The following is used and set by DNEUPD. |
+c | The following is used and set by DNEUPD . |
c | workl(ncv*ncv+3*ncv+1:ncv*ncv+4*ncv) := The untransformed |
c | real part of the Ritz values. |
c | workl(ncv*ncv+4*ncv+1:ncv*ncv+5*ncv) := The untransformed |
@@ -511,124 +526,110 @@ c %------------------------------------%
c
rnorm = workl(ih+2)
workl(ih+2) = zero
-c
+c
+ if (msglvl .gt. 2) then
+ call dvout (logfil, ncv, workl(irr), ndigit,
+ & '_neupd: Real part of Ritz values passed in from _NAUPD.')
+ call dvout (logfil, ncv, workl(iri), ndigit,
+ & '_neupd: Imag part of Ritz values passed in from _NAUPD.')
+ call dvout (logfil, ncv, workl(ibd), ndigit,
+ & '_neupd: Ritz estimates passed in from _NAUPD.')
+ end if
+c
if (rvec) then
c
-c %-------------------------------------------%
-c | Get converged Ritz value on the boundary. |
-c | Note: converged Ritz values have been |
-c | placed in the first NCONV locations in |
-c | workl(ritzr) and workl(ritzi). They have |
-c | been sorted (in _naup2) according to the |
-c | WHICH selection criterion. |
-c %-------------------------------------------%
-c
- if (which .eq. 'LM' .or. which .eq. 'SM') then
- thres = dlapy2( workl(ritzr), workl(ritzi) )
- else if (which .eq. 'LR' .or. which .eq. 'SR') then
- thres = workl(ritzr)
- else if (which .eq. 'LI' .or. which .eq. 'SI') then
- thres = abs( workl(ritzi) )
- end if
+ reord = .false.
+c
+c %---------------------------------------------------%
+c | Use the temporary bounds array to store indices |
+c | These will be used to mark the select array later |
+c %---------------------------------------------------%
+c
+ do 10 j = 1,ncv
+ workl(bounds+j-1) = j
+ select(j) = .false.
+ 10 continue
+c
+c %-------------------------------------%
+c | Select the wanted Ritz values. |
+c | Sort the Ritz values so that the |
+c | wanted ones appear at the tailing |
+c | NEV positions of workl(irr) and |
+c | workl(iri). Move the corresponding |
+c | error estimates in workl(bound) |
+c | accordingly. |
+c %-------------------------------------%
+c
+ np = ncv - nev
+ ishift = 0
+ call dngets (ishift , which , nev ,
+ & np , workl(irr), workl(iri),
+ & workl(bounds), workl , workl(np+1))
c
if (msglvl .gt. 2) then
- call dvout(logfil, 1, thres, ndigit,
- & '_neupd: Threshold eigenvalue used for re-ordering')
+ call dvout (logfil, ncv, workl(irr), ndigit,
+ & '_neupd: Real part of Ritz values after calling _NGETS.')
+ call dvout (logfil, ncv, workl(iri), ndigit,
+ & '_neupd: Imag part of Ritz values after calling _NGETS.')
+ call dvout (logfil, ncv, workl(bounds), ndigit,
+ & '_neupd: Ritz value indices after calling _NGETS.')
end if
c
-c %----------------------------------------------------------%
-c | Check to see if all converged Ritz values appear at the |
-c | top of the upper quasi-triangular matrix computed by |
-c | _neigh in _naup2. This is done in the following way: |
-c | |
-c | 1) For each Ritz value obtained from _neigh, compare it |
-c | with the threshold Ritz value computed above to |
-c | determine whether it is a wanted one. |
-c | |
-c | 2) If it is wanted, then check the corresponding Ritz |
-c | estimate to see if it has converged. If it has, set |
-c | correponding entry in the logical array SELECT to |
-c | .TRUE.. |
-c | |
-c | If SELECT(j) = .TRUE. and j > NCONV, then there is a |
-c | converged Ritz value that does not appear at the top of |
-c | the upper quasi-triangular matrix computed by _neigh in |
-c | _naup2. Reordering is needed. |
-c %----------------------------------------------------------%
+c %-----------------------------------------------------%
+c | Record indices of the converged wanted Ritz values |
+c | Mark the select array for possible reordering |
+c %-----------------------------------------------------%
+c
+ numcnv = 0
+ do 11 j = 1,ncv
+ temp1 = max(eps23,
+ & dlapy2 ( workl(irr+ncv-j), workl(iri+ncv-j) ))
+ jj = workl(bounds + ncv - j)
+ if (numcnv .lt. nconv .and.
+ & workl(ibd+jj-1) .le. tol*temp1) then
+ select(jj) = .true.
+ numcnv = numcnv + 1
+ if (jj .gt. nev) reord = .true.
+ endif
+ 11 continue
c
- reord = .false.
- ktrord = 0
- do 10 j = 0, ncv-1
- select(j+1) = .false.
- if (which .eq. 'LM') then
- if (dlapy2(workl(irr+j), workl(iri+j))
- & .ge. thres) then
- temp1 = max( eps23,
- & dlapy2( workl(irr+j), workl(iri+j) ) )
- if (workl(ibd+j) .le. tol*temp1)
- & select(j+1) = .true.
- end if
- else if (which .eq. 'SM') then
- if (dlapy2(workl(irr+j), workl(iri+j))
- & .le. thres) then
- temp1 = max( eps23,
- & dlapy2( workl(irr+j), workl(iri+j) ) )
- if (workl(ibd+j) .le. tol*temp1)
- & select(j+1) = .true.
- end if
- else if (which .eq. 'LR') then
- if (workl(irr+j) .ge. thres) then
- temp1 = max( eps23,
- & dlapy2( workl(irr+j), workl(iri+j) ) )
- if (workl(ibd+j) .le. tol*temp1)
- & select(j+1) = .true.
- end if
- else if (which .eq. 'SR') then
- if (workl(irr+j) .le. thres) then
- temp1 = max( eps23,
- & dlapy2( workl(irr+j), workl(iri+j) ) )
- if (workl(ibd+j) .le. tol*temp1)
- & select(j+1) = .true.
- end if
- else if (which .eq. 'LI') then
- if (abs(workl(iri+j)) .ge. thres) then
- temp1 = max( eps23,
- & dlapy2( workl(irr+j), workl(iri+j) ) )
- if (workl(ibd+j) .le. tol*temp1)
- & select(j+1) = .true.
- end if
- else if (which .eq. 'SI') then
- if (abs(workl(iri+j)) .le. thres) then
- temp1 = max( eps23,
- & dlapy2( workl(irr+j), workl(iri+j) ) )
- if (workl(ibd+j) .le. tol*temp1)
- & select(j+1) = .true.
- end if
- end if
- if (j+1 .gt. nconv ) reord = ( select(j+1) .or. reord )
- if (select(j+1)) ktrord = ktrord + 1
- 10 continue
+c %-----------------------------------------------------------%
+c | Check the count (numcnv) of converged Ritz values with |
+c | the number (nconv) reported by dnaupd. If these two |
+c | are different then there has probably been an error |
+c | caused by incorrect passing of the dnaupd data. |
+c %-----------------------------------------------------------%
c
if (msglvl .gt. 2) then
- call ivout(logfil, 1, ktrord, ndigit,
+ call ivout(logfil, 1, numcnv, ndigit,
& '_neupd: Number of specified eigenvalues')
call ivout(logfil, 1, nconv, ndigit,
& '_neupd: Number of "converged" eigenvalues')
end if
c
+ if (numcnv .ne. nconv) then
+ info = -15
+ go to 9000
+ end if
+c
c %-----------------------------------------------------------%
-c | Call LAPACK routine dlahqr to compute the real Schur form |
-c | of the upper Hessenberg matrix returned by DNAUPD. |
+c | Call LAPACK routine dlahqr to compute the real Schur form |
+c | of the upper Hessenberg matrix returned by DNAUPD . |
c | Make a copy of the upper Hessenberg matrix. |
c | Initialize the Schur vector matrix Q to the identity. |
c %-----------------------------------------------------------%
c
call dcopy (ldh*ncv, workl(ih), 1, workl(iuptri), 1)
- call dlaset ('All', ncv, ncv, zero, one, workl(invsub), ldq)
- call dlahqr (.true., .true., ncv, 1, ncv, workl(iuptri), ldh,
- & workl(iheigr), workl(iheigi), 1, ncv,
- & workl(invsub), ldq, ierr)
- call dcopy (ncv, workl(invsub+ncv-1), ldq, workl(ihbds), 1)
+ call dlaset ('All', ncv, ncv,
+ & zero , one, workl(invsub),
+ & ldq)
+ call dlahqr (.true., .true. , ncv,
+ & 1 , ncv , workl(iuptri),
+ & ldh , workl(iheigr), workl(iheigi),
+ & 1 , ncv , workl(invsub),
+ & ldq , ierr)
+ call dcopy (ncv , workl(invsub+ncv-1), ldq,
+ & workl(ihbds), 1)
c
if (ierr .ne. 0) then
info = -8
@@ -643,7 +644,8 @@ c
call dvout (logfil, ncv, workl(ihbds), ndigit,
& '_neupd: Last row of the Schur vector matrix')
if (msglvl .gt. 3) then
- call dmout (logfil, ncv, ncv, workl(iuptri), ldh, ndigit,
+ call dmout (logfil , ncv, ncv ,
+ & workl(iuptri), ldh, ndigit,
& '_neupd: The upper quasi-triangular matrix ')
end if
end if
@@ -654,9 +656,15 @@ c %-----------------------------------------------------%
c | Reorder the computed upper quasi-triangular matrix. |
c %-----------------------------------------------------%
c
- call dtrsen ('None', 'V', select, ncv, workl(iuptri), ldh,
- & workl(invsub), ldq, workl(iheigr), workl(iheigi),
- & nconv, conds, sep, workl(ihbds), ncv, iwork, 1, ierr)
+ call dtrsen ('None' , 'V' ,
+ & select , ncv ,
+ & workl(iuptri), ldh ,
+ & workl(invsub), ldq ,
+ & workl(iheigr), workl(iheigi),
+ & nconv , conds ,
+ & sep , workl(ihbds) ,
+ & ncv , iwork ,
+ & 1 , ierr)
c
if (ierr .eq. 1) then
info = 1
@@ -669,9 +677,9 @@ c
call dvout (logfil, ncv, workl(iheigi), ndigit,
& '_neupd: Imag part of the eigenvalues of H--reordered')
if (msglvl .gt. 3) then
- call dmout (logfil, ncv, ncv, workl(iuptri), ldq,
- & ndigit,
- & '_neupd: Quasi-triangular matrix after re-ordering')
+ call dmout (logfil , ncv, ncv ,
+ & workl(iuptri), ldq, ndigit,
+ & '_neupd: Quasi-triangular matrix after re-ordering')
end if
end if
c
@@ -684,7 +692,7 @@ c | to compute the Ritz estimates of |
c | converged Ritz values. |
c %---------------------------------------%
c
- call dcopy(ncv, workl(invsub+ncv-1), ldq, workl(ihbds), 1)
+ call dcopy (ncv, workl(invsub+ncv-1), ldq, workl(ihbds), 1)
c
c %----------------------------------------------------%
c | Place the computed eigenvalues of H into DR and DI |
@@ -702,11 +710,12 @@ c | the wanted invariant subspace located in the first NCONV |
c | columns of workl(invsub,ldq). |
c %----------------------------------------------------------%
c
- call dgeqr2 (ncv, nconv, workl(invsub), ldq, workev,
- & workev(ncv+1), ierr)
+ call dgeqr2 (ncv, nconv , workl(invsub),
+ & ldq, workev, workev(ncv+1),
+ & ierr)
c
c %---------------------------------------------------------%
-c | * Postmultiply V by Q using dorm2r. |
+c | * Postmultiply V by Q using dorm2r . |
c | * Copy the first NCONV columns of VQ into Z. |
c | * Postmultiply Z by R. |
c | The N by NCONV matrix Z is now a matrix representation |
@@ -717,8 +726,10 @@ c | vectors associated with the real upper quasi-triangular |
c | matrix of order NCONV in workl(iuptri) |
c %---------------------------------------------------------%
c
- call dorm2r ('Right', 'Notranspose', n, ncv, nconv,
- & workl(invsub), ldq, workev, v, ldv, workd(n+1), ierr)
+ call dorm2r ('Right', 'Notranspose', n ,
+ & ncv , nconv , workl(invsub),
+ & ldq , workev , v ,
+ & ldv , workd(n+1) , ierr)
call dlacpy ('All', n, nconv, v, ldv, z, ldz)
c
do 20 j=1, nconv
@@ -754,9 +765,11 @@ c
end if
30 continue
c
- call dtrevc ('Right', 'Select', select, ncv, workl(iuptri),
- & ldq, vl, 1, workl(invsub), ldq, ncv, outncv, workev,
- & ierr)
+ call dtrevc ('Right', 'Select' , select ,
+ & ncv , workl(iuptri), ldq ,
+ & vl , 1 , workl(invsub),
+ & ldq , ncv , outncv ,
+ & workev , ierr)
c
if (ierr .ne. 0) then
info = -9
@@ -766,7 +779,7 @@ c
c %------------------------------------------------%
c | Scale the returning eigenvectors so that their |
c | Euclidean norms are all one. LAPACK subroutine |
-c | dtrevc returns each eigenvector normalized so |
+c | dtrevc returns each eigenvector normalized so |
c | that the element of largest magnitude has |
c | magnitude 1; |
c %------------------------------------------------%
@@ -780,7 +793,7 @@ c %----------------------%
c | real eigenvalue case |
c %----------------------%
c
- temp = dnrm2( ncv, workl(invsub+(j-1)*ldq), 1 )
+ temp = dnrm2 ( ncv, workl(invsub+(j-1)*ldq), 1 )
call dscal ( ncv, one / temp,
& workl(invsub+(j-1)*ldq), 1 )
c
@@ -795,12 +808,16 @@ c | square root of two. |
c %-------------------------------------------%
c
if (iconj .eq. 0) then
- temp = dlapy2( dnrm2( ncv, workl(invsub+(j-1)*ldq),
- & 1 ), dnrm2( ncv, workl(invsub+j*ldq), 1) )
- call dscal ( ncv, one / temp,
- & workl(invsub+(j-1)*ldq), 1 )
- call dscal ( ncv, one / temp,
- & workl(invsub+j*ldq), 1 )
+ temp = dlapy2 (dnrm2 (ncv,
+ & workl(invsub+(j-1)*ldq),
+ & 1),
+ & dnrm2 (ncv,
+ & workl(invsub+j*ldq),
+ & 1))
+ call dscal (ncv, one/temp,
+ & workl(invsub+(j-1)*ldq), 1 )
+ call dscal (ncv, one/temp,
+ & workl(invsub+j*ldq), 1 )
iconj = 1
else
iconj = 0
@@ -810,8 +827,8 @@ c
c
40 continue
c
- call dgemv('T', ncv, nconv, one, workl(invsub),
- & ldq, workl(ihbds), 1, zero, workev, 1)
+ call dgemv ('T', ncv, nconv, one, workl(invsub),
+ & ldq, workl(ihbds), 1, zero, workev, 1)
c
iconj = 0
do 45 j=1, nconv
@@ -824,7 +841,7 @@ c | the eigenvector are stored in consecutive |
c %-------------------------------------------%
c
if (iconj .eq. 0) then
- workev(j) = dlapy2(workev(j), workev(j+1))
+ workev(j) = dlapy2 (workev(j), workev(j+1))
workev(j+1) = workev(j)
iconj = 1
else
@@ -834,7 +851,7 @@ c
45 continue
c
if (msglvl .gt. 2) then
- call dcopy(ncv, workl(invsub+ncv-1), ldq,
+ call dcopy (ncv, workl(invsub+ncv-1), ldq,
& workl(ihbds), 1)
call dvout (logfil, ncv, workl(ihbds), ndigit,
& '_neupd: Last row of the eigenvector matrix for T')
@@ -848,7 +865,7 @@ c %---------------------------------------%
c | Copy Ritz estimates into workl(ihbds) |
c %---------------------------------------%
c
- call dcopy(nconv, workev, 1, workl(ihbds), 1)
+ call dcopy (nconv, workev, 1, workl(ihbds), 1)
c
c %---------------------------------------------------------%
c | Compute the QR factorization of the eigenvector matrix |
@@ -856,8 +873,9 @@ c | associated with leading portion of T in the first NCONV |
c | columns of workl(invsub,ldq). |
c %---------------------------------------------------------%
c
- call dgeqr2 (ncv, nconv, workl(invsub), ldq, workev,
- & workev(ncv+1), ierr)
+ call dgeqr2 (ncv, nconv , workl(invsub),
+ & ldq, workev, workev(ncv+1),
+ & ierr)
c
c %----------------------------------------------%
c | * Postmultiply Z by Q. |
@@ -867,11 +885,15 @@ c | Ritz vectors associated with the Ritz values |
c | in workl(iheigr) and workl(iheigi). |
c %----------------------------------------------%
c
- call dorm2r ('Right', 'Notranspose', n, ncv, nconv,
- & workl(invsub), ldq, workev, z, ldz, workd(n+1), ierr)
+ call dorm2r ('Right', 'Notranspose', n ,
+ & ncv , nconv , workl(invsub),
+ & ldq , workev , z ,
+ & ldz , workd(n+1) , ierr)
c
- call dtrmm ('Right', 'Upper', 'No transpose', 'Non-unit',
- & n, nconv, one, workl(invsub), ldq, z, ldz)
+ call dtrmm ('Right' , 'Upper' , 'No transpose',
+ & 'Non-unit', n , nconv ,
+ & one , workl(invsub), ldq ,
+ & z , ldz)
c
end if
c
@@ -879,7 +901,7 @@ c
c
c %------------------------------------------------------%
c | An approximate invariant subspace is not needed. |
-c | Place the Ritz values computed DNAUPD into DR and DI |
+c | Place the Ritz values computed DNAUPD into DR and DI |
c %------------------------------------------------------%
c
call dcopy (nconv, workl(ritzr), 1, dr, 1)
@@ -914,7 +936,7 @@ c
& call dscal (ncv, rnorm, workl(ihbds), 1)
c
do 50 k=1, ncv
- temp = dlapy2( workl(iheigr+k-1),
+ temp = dlapy2 ( workl(iheigr+k-1),
& workl(iheigi+k-1) )
workl(ihbds+k-1) = abs( workl(ihbds+k-1) )
& / temp / temp
@@ -945,11 +967,11 @@ c
if (type .eq. 'SHIFTI') then
c
do 80 k=1, ncv
- temp = dlapy2( workl(iheigr+k-1),
+ temp = dlapy2 ( workl(iheigr+k-1),
& workl(iheigi+k-1) )
- workl(iheigr+k-1) = workl(iheigr+k-1) / temp / temp
+ workl(iheigr+k-1) = workl(iheigr+k-1)/temp/temp
& + sigmar
- workl(iheigi+k-1) = -workl(iheigi+k-1) / temp / temp
+ workl(iheigi+k-1) = -workl(iheigi+k-1)/temp/temp
& + sigmai
80 continue
c
@@ -968,14 +990,14 @@ c
if (type .eq. 'SHIFTI' .and. msglvl .gt. 1) then
call dvout (logfil, nconv, dr, ndigit,
& '_neupd: Untransformed real part of the Ritz valuess.')
- call dvout (logfil, nconv, di, ndigit,
+ call dvout (logfil, nconv, di, ndigit,
& '_neupd: Untransformed imag part of the Ritz valuess.')
call dvout (logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Ritz estimates of untransformed Ritz values.')
else if (type .eq. 'REGULR' .and. msglvl .gt. 1) then
call dvout (logfil, nconv, dr, ndigit,
& '_neupd: Real parts of converged Ritz values.')
- call dvout (logfil, nconv, di, ndigit,
+ call dvout (logfil, nconv, di, ndigit,
& '_neupd: Imag parts of converged Ritz values.')
call dvout (logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Associated Ritz estimates.')
@@ -1006,7 +1028,7 @@ c
workev(j) = workl(invsub+(j-1)*ldq+ncv-1) /
& workl(iheigr+j-1)
else if (iconj .eq. 0) then
- temp = dlapy2( workl(iheigr+j-1), workl(iheigi+j-1) )
+ temp = dlapy2 ( workl(iheigr+j-1), workl(iheigi+j-1) )
workev(j) = ( workl(invsub+(j-1)*ldq+ncv-1) *
& workl(iheigr+j-1) +
& workl(invsub+j*ldq+ncv-1) *
@@ -1035,7 +1057,7 @@ c
return
c
c %---------------%
-c | End of DNEUPD |
+c | End of DNEUPD |
c %---------------%
c
end
diff --git a/SRC/dsapps.f b/SRC/dsapps.f
index 482f749..5c91780 100644
--- a/SRC/dsapps.f
+++ b/SRC/dsapps.f
@@ -111,10 +111,10 @@ c Rice University
c Houston, Texas
c
c\Revision history:
-c 12/16/93: Version ' 2.1'
+c 12/16/93: Version ' 2.4'
c
c\SCCS Information: @(#)
-c FILE: sapps.F SID: 2.5 DATE OF SID: 4/19/96 RELEASE: 2
+c FILE: sapps.F SID: 2.6 DATE OF SID: 3/28/97 RELEASE: 2
c
c\Remarks
c 1. In this version, each shift is applied to all the subblocks of
@@ -372,7 +372,7 @@ c %----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G |
c %----------------------------------------------------%
c
- do 50 j = 1, min( j+jj, kplusp )
+ do 50 j = 1, min( i+jj, kplusp )
a1 = c*q(j,i) + s*q(j,i+1)
q(j,i+1) = - s*q(j,i) + c*q(j,i+1)
q(j,i) = a1
diff --git a/SRC/dsaup2.f b/SRC/dsaup2.f
index 5152214..0b5b512 100644
--- a/SRC/dsaup2.f
+++ b/SRC/dsaup2.f
@@ -170,7 +170,7 @@ c 12/15/93: Version ' 2.4'
c xx/xx/95: Version ' 2.4'. (R.B. Lehoucq)
c
c\SCCS Information: @(#)
-c FILE: saup2.F SID: 2.6 DATE OF SID: 8/16/96 RELEASE: 2
+c FILE: saup2.F SID: 2.7 DATE OF SID: 5/19/98 RELEASE: 2
c
c\EndLib
c
@@ -546,13 +546,13 @@ c %-----------------------------------------------------%
c
wprime = 'SA'
call dsortr (wprime, .true., kplusp, ritz, bounds)
- nevd2 = nev / 2
- nevm2 = nev - nevd2
+ nevd2 = nev0 / 2
+ nevm2 = nev0 - nevd2
if ( nev .gt. 1 ) then
call dswap ( min(nevd2,np), ritz(nevm2+1), 1,
& ritz( max(kplusp-nevd2+1,kplusp-np+1) ), 1)
call dswap ( min(nevd2,np), bounds(nevm2+1), 1,
- & bounds( max(kplusp-nevd2+1,kplusp-np)+1 ), 1)
+ & bounds( max(kplusp-nevd2+1,kplusp-np+1)), 1)
end if
c
else
diff --git a/SRC/dsaupd.f b/SRC/dsaupd.f
index c033bb4..c4272c1 100644
--- a/SRC/dsaupd.f
+++ b/SRC/dsaupd.f
@@ -1,7 +1,7 @@
c-----------------------------------------------------------------------
c\BeginDoc
c
-c\Name: dsaupd
+c\Name: dsaupd
c
c\Description:
c
@@ -12,19 +12,19 @@ c few eigenpairs of a linear operator OP that is real and symmetric
c with respect to a real positive semi-definite symmetric matrix B,
c i.e.
c
-c B*OP = (OP')*B.
+c B*OP = (OP`)*B.
c
c Another way to express this condition is
c
-c < x,OPy > = < OPx,y > where < z,w > = z'Bw .
+c < x,OPy > = < OPx,y > where < z,w > = z`Bw .
c
c In the standard eigenproblem B is the identity matrix.
-c ( A' denotes transpose of A)
+c ( A` denotes transpose of A)
c
c The computed approximate eigenvalues are called Ritz values and
c the corresponding approximate eigenvectors are called Ritz vectors.
c
-c dsaupd is usually called iteratively to solve one of the
+c dsaupd is usually called iteratively to solve one of the
c following problems:
c
c Mode 1: A*x = lambda*x, A symmetric
@@ -60,18 +60,18 @@ c the accuracy requirements for the eigenvalue
c approximations.
c
c\Usage:
-c call dsaupd
+c call dsaupd
c ( IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM,
c IPNTR, WORKD, WORKL, LWORKL, INFO )
c
c\Arguments
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag. IDO must be zero on the first
-c call to dsaupd. IDO will be set internally to
+c call to dsaupd . IDO will be set internally to
c indicate the type of operation to be performed. Control is
c then given back to the calling routine which has the
c responsibility to carry out the requested operation and call
-c dsaupd with the result. The operand is given in
+c dsaupd with the result. The operand is given in
c WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)).
c (If Mode = 2 see remark 5 below)
c -------------------------------------------------------------
@@ -120,14 +120,14 @@ c
c NEV Integer. (INPUT)
c Number of eigenvalues of OP to be computed. 0 < NEV < N.
c
-c TOL Double precision scalar. (INPUT)
+c TOL Double precision scalar. (INPUT)
c Stopping criterion: the relative accuracy of the Ritz value
c is considered acceptable if BOUNDS(I) .LE. TOL*ABS(RITZ(I)).
c If TOL .LE. 0. is passed a default is set:
-c DEFAULT = DLAMCH('EPS') (machine precision as computed
-c by the LAPACK auxiliary subroutine DLAMCH).
+c DEFAULT = DLAMCH ('EPS') (machine precision as computed
+c by the LAPACK auxiliary subroutine DLAMCH ).
c
-c RESID Double precision array of length N. (INPUT/OUTPUT)
+c RESID Double precision array of length N. (INPUT/OUTPUT)
c On INPUT:
c If INFO .EQ. 0, a random initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
@@ -144,7 +144,7 @@ c NCV-NEV Lanczos vectors at each subsequent update iteration.
c Most of the cost in generating each Lanczos vector is in the
c matrix-vector product OP*x. (See remark 4 below).
c
-c V Double precision N by NCV array. (OUTPUT)
+c V Double precision N by NCV array. (OUTPUT)
c The NCV columns of V contain the Lanczos basis vectors.
c
c LDV Integer. (INPUT)
@@ -187,12 +187,12 @@ c No longer referenced. Implicit restarting is ALWAYS used.
c
c IPARAM(7) = MODE
c On INPUT determines what type of eigenproblem is being solved.
-c Must be 1,2,3,4,5; See under \Description of dsaupd for the
+c Must be 1,2,3,4,5; See under \Description of dsaupd for the
c five modes available.
c
c IPARAM(8) = NP
c When ido = 3 and the user provides shifts through reverse
-c communication (IPARAM(1)=0), dsaupd returns NP, the number
+c communication (IPARAM(1)=0), dsaupd returns NP, the number
c of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark
c 6 below.
c
@@ -217,23 +217,23 @@ c IPNTR(7): pointer to the Ritz estimates in array WORKL associated
c with the Ritz values located in RITZ in WORKL.
c IPNTR(11): pointer to the NP shifts in WORKL. See Remark 6 below.
c
-c Note: IPNTR(8:10) is only referenced by dseupd. See Remark 2.
+c Note: IPNTR(8:10) is only referenced by dseupd . See Remark 2.
c IPNTR(8): pointer to the NCV RITZ values of the original system.
c IPNTR(9): pointer to the NCV corresponding error bounds.
c IPNTR(10): pointer to the NCV by NCV matrix of eigenvectors
c of the tridiagonal matrix T. Only referenced by
-c dseupd if RVEC = .TRUE. See Remarks.
+c dseupd if RVEC = .TRUE. See Remarks.
c -------------------------------------------------------------
c
-c WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION)
+c WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION)
c Distributed array to be used in the basic Arnoldi iteration
c for reverse communication. The user should not use WORKD
c as temporary workspace during the iteration. Upon termination
c WORKD(1:N) contains B*RESID(1:N). If the Ritz vectors are desired
-c subroutine dseupd uses this output.
+c subroutine dseupd uses this output.
c See Data Distribution Note below.
c
-c WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE)
+c WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end. See Data Distribution Note below.
c
@@ -264,7 +264,7 @@ c = -5: WHICH must be one of 'LM', 'SM', 'LA', 'SA' or 'BE'.
c = -6: BMAT must be one of 'I' or 'G'.
c = -7: Length of private work array WORKL is not sufficient.
c = -8: Error return from trid. eigenvalue calculation;
-c Informatinal error from LAPACK routine dsteqr.
+c Informatinal error from LAPACK routine dsteqr .
c = -9: Starting vector is zero.
c = -10: IPARAM(7) must be 1,2,3,4,5.
c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatable.
@@ -282,19 +282,19 @@ c algebraic order. The computed Ritz values are approximate
c eigenvalues of OP. The selection of WHICH should be made
c with this in mind when Mode = 3,4,5. After convergence,
c approximate eigenvalues of the original problem may be obtained
-c with the ARPACK subroutine dseupd.
+c with the ARPACK subroutine dseupd .
c
c 2. If the Ritz vectors corresponding to the converged Ritz values
-c are needed, the user must call dseupd immediately following completion
-c of dsaupd. This is new starting with version 2.1 of ARPACK.
+c are needed, the user must call dseupd immediately following completion
+c of dsaupd . This is new starting with version 2.1 of ARPACK.
c
-c 3. If M can be factored into a Cholesky factorization M = LL'
+c 3. If M can be factored into a Cholesky factorization M = LL`
c then Mode = 2 should not be selected. Instead one should use
-c Mode = 1 with OP = inv(L)*A*inv(L'). Appropriate triangular
-c linear systems should be solved with L and L' rather
+c Mode = 1 with OP = inv(L)*A*inv(L`). Appropriate triangular
+c linear systems should be solved with L and L` rather
c than computing inverses. After convergence, an approximate
c eigenvector z of the original problem is recovered by solving
-c L'z = x where x is a Ritz vector of OP.
+c L`z = x where x is a Ritz vector of OP.
c
c 4. At present there is no a-priori analysis to guide the selection
c of NCV relative to NEV. The only formal requrement is that NCV > NEV.
@@ -375,14 +375,14 @@ c 8. R.B. Lehoucq, D.C. Sorensen, "Implementation of Some Spectral
c Transformations in a k-Step Arnoldi Method". In Preparation.
c
c\Routines called:
-c dsaup2 ARPACK routine that implements the Implicitly Restarted
+c dsaup2 ARPACK routine that implements the Implicitly Restarted
c Arnoldi Iteration.
-c dstats ARPACK routine that initialize timing and other statistics
+c dstats ARPACK routine that initialize timing and other statistics
c variables.
c ivout ARPACK utility routine that prints integers.
c second ARPACK utility routine for timing.
-c dvout ARPACK utility routine that prints vectors.
-c dlamch LAPACK routine that determines machine constants.
+c dvout ARPACK utility routine that prints vectors.
+c dlamch LAPACK routine that determines machine constants.
c
c\Authors
c Danny Sorensen Phuong Vu
@@ -393,10 +393,10 @@ c Rice University
c Houston, Texas
c
c\Revision history:
-c 12/15/93: Version ' 2.4'
+c 12/15/93: Version ' 2.4'
c
c\SCCS Information: @(#)
-c FILE: saupd.F SID: 2.7 DATE OF SID: 8/27/96 RELEASE: 2
+c FILE: saupd.F SID: 2.8 DATE OF SID: 04/10/01 RELEASE: 2
c
c\Remarks
c 1. None
@@ -405,7 +405,7 @@ c\EndLib
c
c-----------------------------------------------------------------------
c
- subroutine dsaupd
+ subroutine dsaupd
& ( ido, bmat, n, which, nev, tol, resid, ncv, v, ldv, iparam,
& ipntr, workd, workl, lworkl, info )
c
@@ -422,7 +422,7 @@ c %------------------%
c
character bmat*1, which*2
integer ido, info, ldv, lworkl, n, ncv, nev
- Double precision
+ Double precision
& tol
c
c %-----------------%
@@ -430,16 +430,16 @@ c | Array Arguments |
c %-----------------%
c
integer iparam(11), ipntr(11)
- Double precision
+ Double precision
& resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
c
c %------------%
c | Parameters |
c %------------%
c
- Double precision
+ Double precision
& one, zero
- parameter (one = 1.0D+0, zero = 0.0D+0)
+ parameter (one = 1.0D+0 , zero = 0.0D+0 )
c
c %---------------%
c | Local Scalars |
@@ -456,15 +456,15 @@ c %----------------------%
c | External Subroutines |
c %----------------------%
c
- external dsaup2, dvout, ivout, second, dstats
+ external dsaup2 , dvout , ivout, second, dstats
c
c %--------------------%
c | External Functions |
c %--------------------%
c
- Double precision
- & dlamch
- external dlamch
+ Double precision
+ & dlamch
+ external dlamch
c
c %-----------------------%
c | Executable Statements |
@@ -477,14 +477,15 @@ c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
- call dstats
+ call dstats
call second (t0)
msglvl = msaupd
c
ierr = 0
ishift = iparam(1)
mxiter = iparam(3)
- nb = iparam(4)
+c nb = iparam(4)
+ nb = 1
c
c %--------------------------------------------%
c | Revision 2 performs only implicit restart. |
@@ -546,7 +547,7 @@ c | Set default parameters |
c %------------------------%
c
if (nb .le. 0) nb = 1
- if (tol .le. zero) tol = dlamch('EpsMach')
+ if (tol .le. zero) tol = dlamch ('EpsMach')
c
c %----------------------------------------------%
c | NP is the number of additional steps to |
@@ -598,7 +599,7 @@ c %-------------------------------------------------------%
c | Carry out the Implicitly restarted Lanczos Iteration. |
c %-------------------------------------------------------%
c
- call dsaup2
+ call dsaup2
& ( ido, bmat, n, which, nev0, np, tol, resid, mode, iupd,
& ishift, mxiter, v, ldv, workl(ih), ldh, workl(ritz),
& workl(bounds), workl(iq), ldq, workl(iw), ipntr, workd,
@@ -620,7 +621,7 @@ c
c
c %------------------------------------%
c | Exit if there was an informational |
-c | error within dsaup2. |
+c | error within dsaup2 . |
c %------------------------------------%
c
if (info .lt. 0) go to 9000
@@ -631,9 +632,9 @@ c
& '_saupd: number of update iterations taken')
call ivout (logfil, 1, np, ndigit,
& '_saupd: number of "converged" Ritz values')
- call dvout (logfil, np, workl(Ritz), ndigit,
+ call dvout (logfil, np, workl(Ritz), ndigit,
& '_saupd: final Ritz values')
- call dvout (logfil, np, workl(Bounds), ndigit,
+ call dvout (logfil, np, workl(Bounds), ndigit,
& '_saupd: corresponding error bounds')
end if
c
@@ -653,8 +654,8 @@ c
1000 format (//,
& 5x, '==========================================',/
& 5x, '= Symmetric implicit Arnoldi update code =',/
- & 5x, '= Version Number:', ' 2.4', 19x, ' =',/
- & 5x, '= Version Date: ', ' 07/31/96', 14x, ' =',/
+ & 5x, '= Version Number:', ' 2.4' , 19x, ' =',/
+ & 5x, '= Version Date: ', ' 07/31/96' , 14x, ' =',/
& 5x, '==========================================',/
& 5x, '= Summary of timing statistics =',/
& 5x, '==========================================',//)
@@ -683,7 +684,7 @@ c
return
c
c %---------------%
-c | End of dsaupd |
+c | End of dsaupd |
c %---------------%
c
end
diff --git a/SRC/dseupd.f b/SRC/dseupd.f
index fe0f7f4..2ed0fd6 100644
--- a/SRC/dseupd.f
+++ b/SRC/dseupd.f
@@ -1,6 +1,6 @@
c\BeginDoc
c
-c\Name: dseupd
+c\Name: dseupd
c
c\Description:
c
@@ -20,15 +20,15 @@ c of n*nev if both are requested (in this case a separate array Z must be
c supplied).
c
c These quantities are obtained from the Lanczos factorization computed
-c by DSAUPD for the linear operator OP prescribed by the MODE selection
-c (see IPARAM(7) in DSAUPD documentation.) DSAUPD must be called before
+c by DSAUPD for the linear operator OP prescribed by the MODE selection
+c (see IPARAM(7) in DSAUPD documentation.) DSAUPD must be called before
c this routine is called. These approximate eigenvalues and vectors are
c commonly called Ritz values and Ritz vectors respectively. They are
c referred to as such in the comments that follow. The computed orthonormal
c basis for the invariant subspace corresponding to these Ritz values is
c referred to as a Lanczos basis.
c
-c See documentation in the header of the subroutine DSAUPD for a definition
+c See documentation in the header of the subroutine DSAUPD for a definition
c of OP as well as other terms and the relation of computed Ritz values
c and vectors of OP with respect to the given problem A*z = lambda*B*z.
c
@@ -39,7 +39,7 @@ c There is also the option of computing a selected set of these vectors
c with a single call.
c
c\Usage:
-c call dseupd
+c call dseupd
c ( RVEC, HOWMNY, SELECT, D, Z, LDZ, SIGMA, BMAT, N, WHICH, NEV, TOL,
c RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, WORKL, LWORKL, INFO )
c
@@ -58,67 +58,68 @@ c = 'A': compute NEV Ritz vectors;
c = 'S': compute some of the Ritz vectors, specified
c by the logical array SELECT.
c
-c SELECT Logical array of dimension NEV. (INPUT)
+c SELECT Logical array of dimension NCV. (INPUT/WORKSPACE)
c If HOWMNY = 'S', SELECT specifies the Ritz vectors to be
c computed. To select the Ritz vector corresponding to a
c Ritz value D(j), SELECT(j) must be set to .TRUE..
-c If HOWMNY = 'A' , SELECT is not referenced.
+c If HOWMNY = 'A' , SELECT is used as a workspace for
+c reordering the Ritz values.
c
-c D Double precision array of dimension NEV. (OUTPUT)
+c D Double precision array of dimension NEV. (OUTPUT)
c On exit, D contains the Ritz value approximations to the
c eigenvalues of A*z = lambda*B*z. The values are returned
c in ascending order. If IPARAM(7) = 3,4,5 then D represents
-c the Ritz values of OP computed by dsaupd transformed to
+c the Ritz values of OP computed by dsaupd transformed to
c those of the original eigensystem A*z = lambda*B*z. If
c IPARAM(7) = 1,2 then the Ritz values of OP are the same
c as the those of A*z = lambda*B*z.
c
-c Z Double precision N by NEV array if HOWMNY = 'A'. (OUTPUT)
+c Z Double precision N by NEV array if HOWMNY = 'A'. (OUTPUT)
c On exit, Z contains the B-orthonormal Ritz vectors of the
c eigensystem A*z = lambda*B*z corresponding to the Ritz
c value approximations.
c If RVEC = .FALSE. then Z is not referenced.
c NOTE: The array Z may be set equal to first NEV columns of the
-c Arnoldi/Lanczos basis array V computed by DSAUPD.
+c Arnoldi/Lanczos basis array V computed by DSAUPD .
c
c LDZ Integer. (INPUT)
c The leading dimension of the array Z. If Ritz vectors are
c desired, then LDZ .ge. max( 1, N ). In any case, LDZ .ge. 1.
c
-c SIGMA Double precision (INPUT)
+c SIGMA Double precision (INPUT)
c If IPARAM(7) = 3,4,5 represents the shift. Not referenced if
c IPARAM(7) = 1 or 2.
c
c
c **** The remaining arguments MUST be the same as for the ****
-c **** call to DNAUPD that was just completed. ****
+c **** call to DSAUPD that was just completed. ****
c
c NOTE: The remaining arguments
c
c BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR,
c WORKD, WORKL, LWORKL, INFO
c
-c must be passed directly to DSEUPD following the last call
-c to DSAUPD. These arguments MUST NOT BE MODIFIED between
-c the the last call to DSAUPD and the call to DSEUPD.
+c must be passed directly to DSEUPD following the last call
+c to DSAUPD . These arguments MUST NOT BE MODIFIED between
+c the the last call to DSAUPD and the call to DSEUPD .
c
c Two of these parameters (WORKL, INFO) are also output parameters:
c
-c WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE)
+c WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE)
c WORKL(1:4*ncv) contains information obtained in
-c dsaupd. They are not changed by dseupd.
+c dsaupd . They are not changed by dseupd .
c WORKL(4*ncv+1:ncv*ncv+8*ncv) holds the
c untransformed Ritz values, the computed error estimates,
c and the associated eigenvector matrix of H.
c
c Note: IPNTR(8:10) contains the pointer into WORKL for addresses
-c of the above information computed by dseupd.
+c of the above information computed by dseupd .
c -------------------------------------------------------------
c IPNTR(8): pointer to the NCV RITZ values of the original system.
c IPNTR(9): pointer to the NCV corresponding error bounds.
c IPNTR(10): pointer to the NCV by NCV matrix of eigenvectors
c of the tridiagonal matrix T. Only referenced by
-c dseupd if RVEC = .TRUE. See Remarks.
+c dseupd if RVEC = .TRUE. See Remarks.
c -------------------------------------------------------------
c
c INFO Integer. (OUTPUT)
@@ -131,15 +132,20 @@ c = -5: WHICH must be one of 'LM', 'SM', 'LA', 'SA' or 'BE'.
c = -6: BMAT must be one of 'I' or 'G'.
c = -7: Length of private work WORKL array is not sufficient.
c = -8: Error return from trid. eigenvalue calculation;
-c Information error from LAPACK routine dsteqr.
+c Information error from LAPACK routine dsteqr .
c = -9: Starting vector is zero.
c = -10: IPARAM(7) must be 1,2,3,4,5.
c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatible.
c = -12: NEV and WHICH = 'BE' are incompatible.
-c = -14: DSAUPD did not find any eigenvalues to sufficient
+c = -14: DSAUPD did not find any eigenvalues to sufficient
c accuracy.
c = -15: HOWMNY must be one of 'A' or 'S' if RVEC = .true.
c = -16: HOWMNY = 'S' not yet implemented
+c = -17: DSEUPD got a different count of the number of converged
+c Ritz values than DSAUPD got. This indicates the user
+c probably made an error in passing data from DSAUPD to
+c DSEUPD or that the data was modified before entering
+c DSEUPD .
c
c\BeginLib
c
@@ -172,24 +178,24 @@ c 2. Currently only HOWMNY = 'A' is implemented. It is included at this
c stage for the user who wants to incorporate it.
c
c\Routines called:
-c dsesrt ARPACK routine that sorts an array X, and applies the
+c dsesrt ARPACK routine that sorts an array X, and applies the
c corresponding permutation to a matrix A.
-c dsortr dsortr ARPACK sorting routine.
+c dsortr dsortr ARPACK sorting routine.
c ivout ARPACK utility routine that prints integers.
-c dvout ARPACK utility routine that prints vectors.
-c dgeqr2 LAPACK routine that computes the QR factorization of
+c dvout ARPACK utility routine that prints vectors.
+c dgeqr2 LAPACK routine that computes the QR factorization of
c a matrix.
-c dlacpy LAPACK matrix copy routine.
-c dlamch LAPACK routine that determines machine constants.
-c dorm2r LAPACK routine that applies an orthogonal matrix in
+c dlacpy LAPACK matrix copy routine.
+c dlamch LAPACK routine that determines machine constants.
+c dorm2r LAPACK routine that applies an orthogonal matrix in
c factored form.
-c dsteqr LAPACK routine that computes eigenvalues and eigenvectors
+c dsteqr LAPACK routine that computes eigenvalues and eigenvectors
c of a tridiagonal matrix.
-c dger Level 2 BLAS rank one update to a matrix.
-c dcopy Level 1 BLAS that copies one vector to another .
-c dnrm2 Level 1 BLAS that computes the norm of a vector.
-c dscal Level 1 BLAS that scales a vector.
-c dswap Level 1 BLAS that swaps the contents of two vectors.
+c dger Level 2 BLAS rank one update to a matrix.
+c dcopy Level 1 BLAS that copies one vector to another .
+c dnrm2 Level 1 BLAS that computes the norm of a vector.
+c dscal Level 1 BLAS that scales a vector.
+c dswap Level 1 BLAS that swaps the contents of two vectors.
c\Authors
c Danny Sorensen Phuong Vu
@@ -204,14 +210,17 @@ c\Revision history:
c 12/15/93: Version ' 2.1'
c
c\SCCS Information: @(#)
-c FILE: seupd.F SID: 2.7 DATE OF SID: 8/27/96 RELEASE: 2
+c FILE: seupd.F SID: 2.11 DATE OF SID: 04/10/01 RELEASE: 2
c
c\EndLib
c
c-----------------------------------------------------------------------
- subroutine dseupd (rvec, howmny, select, d, z, ldz, sigma, bmat,
- & n, which, nev, tol, resid, ncv, v, ldv, iparam,
- & ipntr, workd, workl, lworkl, info )
+ subroutine dseupd (rvec , howmny, select, d ,
+ & z , ldz , sigma , bmat ,
+ & n , which , nev , tol ,
+ & resid , ncv , v , ldv ,
+ & iparam, ipntr , workd , workl,
+ & lworkl, info )
c
c %----------------------------------------------------%
c | Include files for debugging and timing information |
@@ -225,9 +234,9 @@ c | Scalar Arguments |
c %------------------%
c
character bmat, howmny, which*2
- logical rvec, select(ncv)
+ logical rvec
integer info, ldz, ldv, lworkl, n, ncv, nev
- Double precision
+ Double precision
& sigma, tol
c
c %-----------------%
@@ -235,51 +244,47 @@ c | Array Arguments |
c %-----------------%
c
integer iparam(7), ipntr(11)
- Double precision
- & d(nev), resid(n), v(ldv,ncv), z(ldz, nev),
- & workd(2*n), workl(lworkl)
+ logical select(ncv)
+ Double precision
+ & d(nev) , resid(n) , v(ldv,ncv),
+ & z(ldz, nev), workd(2*n), workl(lworkl)
c
c %------------%
c | Parameters |
c %------------%
c
- Double precision
+ Double precision
& one, zero
- parameter (one = 1.0D+0, zero = 0.0D+0)
+ parameter (one = 1.0D+0 , zero = 0.0D+0 )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character type*6
- integer bounds, ierr, ih, ihb, ihd, iq, iw, j, k,
- & ldh, ldq, mode, msglvl, nconv, next, ritz,
- & irz, ibd, ktrord, leftptr, rghtptr, ism, ilg
- Double precision
- & bnorm2, rnorm, temp, thres1, thres2, tempbnd, eps23
- logical reord
-c
-c %--------------%
-c | Local Arrays |
-c %--------------%
-c
+ integer bounds , ierr , ih , ihb , ihd ,
+ & iq , iw , j , k , ldh ,
+ & ldq , mode , msglvl, nconv , next ,
+ & ritz , irz , ibd , np , ishift,
+ & leftptr, rghtptr, numcnv, jj
Double precision
- & kv(2)
+ & bnorm2 , rnorm, temp, temp1, eps23
+ logical reord
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
- external dcopy, dger, dgeqr2, dlacpy, dorm2r, dscal,
- & dsesrt, dsteqr, dswap, dvout, ivout, dsortr
+ external dcopy , dger , dgeqr2 , dlacpy , dorm2r , dscal ,
+ & dsesrt , dsteqr , dswap , dvout , ivout , dsortr
c
c %--------------------%
c | External Functions |
c %--------------------%
c
- Double precision
- & dnrm2, dlamch
- external dnrm2, dlamch
+ Double precision
+ & dnrm2 , dlamch
+ external dnrm2 , dlamch
c
c %---------------------%
c | Intrinsic Functions |
@@ -356,18 +361,18 @@ c | Memory is laid out as follows: |
c | workl(1:2*ncv) := generated tridiagonal matrix H |
c | The subdiagonal is stored in workl(2:ncv). |
c | The dead spot is workl(1) but upon exiting |
-c | dsaupd stores the B-norm of the last residual |
+c | dsaupd stores the B-norm of the last residual |
c | vector in workl(1). We use this !!! |
c | workl(2*ncv+1:2*ncv+ncv) := ritz values |
c | The wanted values are in the first NCONV spots. |
c | workl(3*ncv+1:3*ncv+ncv) := computed Ritz estimates |
c | The wanted values are in the first NCONV spots. |
-c | NOTE: workl(1:4*ncv) is set by dsaupd and is not |
-c | modified by dseupd. |
+c | NOTE: workl(1:4*ncv) is set by dsaupd and is not |
+c | modified by dseupd . |
c %-------------------------------------------------------%
c
c %-------------------------------------------------------%
-c | The following is used and set by dseupd. |
+c | The following is used and set by dseupd . |
c | workl(4*ncv+1:4*ncv+ncv) := used as workspace during |
c | computation of the eigenvectors of H. Stores |
c | the diagonal of H. Upon EXIT contains the NCV |
@@ -383,10 +388,10 @@ c | wanted values. If MODE = 1,2 then will equal |
c | workl(3*ncv+1:4*ncv). |
c | workl(6*ncv+1:6*ncv+ncv*ncv) := orthogonal Q that is |
c | the eigenvector matrix for H as returned by |
-c | dsteqr. Not referenced if RVEC = .False. |
+c | dsteqr . Not referenced if RVEC = .False. |
c | Ordering follows that of workl(4*ncv+1:5*ncv) |
c | workl(6*ncv+ncv*ncv+1:6*ncv+ncv*ncv+2*ncv) := |
-c | Workspace. Needed by dsteqr and by dseupd. |
+c | Workspace. Needed by dsteqr and by dseupd . |
c | GRAND total of NCV*(NCV+8) locations. |
c %-------------------------------------------------------%
c
@@ -422,13 +427,13 @@ c %---------------------------------%
c | Set machine dependent constant. |
c %---------------------------------%
c
- eps23 = dlamch('Epsilon-Machine')
- eps23 = eps23**(2.0D+0 / 3.0D+0)
+ eps23 = dlamch ('Epsilon-Machine')
+ eps23 = eps23**(2.0D+0 / 3.0D+0 )
c
c %---------------------------------------%
c | RNORM is B-norm of the RESID(1:N). |
c | BNORM2 is the 2 norm of B*RESID(1:N). |
-c | Upon exit of dsaupd WORKD(1:N) has |
+c | Upon exit of dsaupd WORKD(1:N) has |
c | B*RESID(1:N). |
c %---------------------------------------%
c
@@ -436,146 +441,89 @@ c
if (bmat .eq. 'I') then
bnorm2 = rnorm
else if (bmat .eq. 'G') then
- bnorm2 = dnrm2(n, workd, 1)
+ bnorm2 = dnrm2 (n, workd, 1)
+ end if
+c
+ if (msglvl .gt. 2) then
+ call dvout (logfil, ncv, workl(irz), ndigit,
+ & '_seupd: Ritz values passed in from _SAUPD.')
+ call dvout (logfil, ncv, workl(ibd), ndigit,
+ & '_seupd: Ritz estimates passed in from _SAUPD.')
end if
c
if (rvec) then
c
-c %------------------------------------------------%
-c | Get the converged Ritz value on the boundary. |
-c | This value will be used to dermine whether we |
-c | need to reorder the eigenvalues and |
-c | eigenvectors comupted by _steqr, and is |
-c | referred to as the "threshold" value. |
-c | |
-c | A Ritz value gamma is said to be a wanted |
-c | one, if |
-c | abs(gamma) .ge. threshold, when WHICH = 'LM'; |
-c | abs(gamma) .le. threshold, when WHICH = 'SM'; |
-c | gamma .ge. threshold, when WHICH = 'LA'; |
-c | gamma .le. threshold, when WHICH = 'SA'; |
-c | gamma .le. thres1 .or. gamma .ge. thres2 |
-c | when WHICH = 'BE'; |
-c | |
-c | Note: converged Ritz values and associated |
-c | Ritz estimates have been placed in the first |
-c | NCONV locations in workl(ritz) and |
-c | workl(bounds) respectively. They have been |
-c | sorted (in _saup2) according to the WHICH |
-c | selection criterion. (Except in the case |
-c | WHICH = 'BE', they are sorted in an increasing |
-c | order.) |
-c %------------------------------------------------%
-c
- if (which .eq. 'LM' .or. which .eq. 'SM'
- & .or. which .eq. 'LA' .or. which .eq. 'SA' ) then
-c
- thres1 = workl(ritz)
-c
- if (msglvl .gt. 2) then
- call dvout(logfil, 1, thres1, ndigit,
- & '_seupd: Threshold eigenvalue used for re-ordering')
- end if
-c
- else if (which .eq. 'BE') then
-c
-c %------------------------------------------------%
-c | Ritz values returned from _saup2 have been |
-c | sorted in increasing order. Thus two |
-c | "threshold" values (one for the small end, one |
-c | for the large end) are in the middle. |
-c %------------------------------------------------%
-c
- ism = max(nev,nconv) / 2
- ilg = ism + 1
- thres1 = workl(ism)
- thres2 = workl(ilg)
-c
- if (msglvl .gt. 2) then
- kv(1) = thres1
- kv(2) = thres2
- call dvout(logfil, 2, kv, ndigit,
- & '_seupd: Threshold eigenvalues used for re-ordering')
- end if
+ reord = .false.
c
+c %---------------------------------------------------%
+c | Use the temporary bounds array to store indices |
+c | These will be used to mark the select array later |
+c %---------------------------------------------------%
+c
+ do 10 j = 1,ncv
+ workl(bounds+j-1) = j
+ select(j) = .false.
+ 10 continue
+c
+c %-------------------------------------%
+c | Select the wanted Ritz values. |
+c | Sort the Ritz values so that the |
+c | wanted ones appear at the tailing |
+c | NEV positions of workl(irr) and |
+c | workl(iri). Move the corresponding |
+c | error estimates in workl(bound) |
+c | accordingly. |
+c %-------------------------------------%
+c
+ np = ncv - nev
+ ishift = 0
+ call dsgets (ishift, which , nev ,
+ & np , workl(irz) , workl(bounds),
+ & workl)
+c
+ if (msglvl .gt. 2) then
+ call dvout (logfil, ncv, workl(irz), ndigit,
+ & '_seupd: Ritz values after calling _SGETS.')
+ call dvout (logfil, ncv, workl(bounds), ndigit,
+ & '_seupd: Ritz value indices after calling _SGETS.')
end if
c
-c %----------------------------------------------------------%
-c | Check to see if all converged Ritz values appear within |
-c | the first NCONV diagonal elements returned from _seigt. |
-c | This is done in the following way: |
-c | |
-c | 1) For each Ritz value obtained from _seigt, compare it |
-c | with the threshold Ritz value computed above to |
-c | determine whether it is a wanted one. |
-c | |
-c | 2) If it is wanted, then check the corresponding Ritz |
-c | estimate to see if it has converged. If it has, set |
-c | correponding entry in the logical array SELECT to |
-c | .TRUE.. |
-c | |
-c | If SELECT(j) = .TRUE. and j > NCONV, then there is a |
-c | converged Ritz value that does not appear at the top of |
-c | the diagonal matrix computed by _seigt in _saup2. |
-c | Reordering is needed. |
-c %----------------------------------------------------------%
+c %-----------------------------------------------------%
+c | Record indices of the converged wanted Ritz values |
+c | Mark the select array for possible reordering |
+c %-----------------------------------------------------%
c
- reord = .false.
- ktrord = 0
- do 10 j = 0, ncv-1
- select(j+1) = .false.
- if (which .eq. 'LM') then
- if (abs(workl(irz+j)) .ge. abs(thres1)) then
- tempbnd = max( eps23, abs(workl(irz+j)) )
- if (workl(ibd+j) .le. tol*tempbnd) then
- select(j+1) = .true.
- end if
- end if
- else if (which .eq. 'SM') then
- if (abs(workl(irz+j)) .le. abs(thres1)) then
- tempbnd = max( eps23, abs(workl(irz+j)) )
- if (workl(ibd+j) .le. tol*tempbnd) then
- select(j+1) = .true.
- end if
- end if
- else if (which .eq. 'LA') then
- if (workl(irz+j) .ge. thres1) then
- tempbnd = max( eps23, abs(workl(irz+j)) )
- if (workl(ibd+j) .le. tol*tempbnd) then
- select(j+1) = .true.
- end if
- end if
- else if (which .eq. 'SA') then
- if (workl(irz+j) .le. thres1) then
- tempbnd = max( eps23, abs(workl(irz+j)) )
- if (workl(ibd+j) .le. tol*tempbnd) then
- select(j+1) = .true.
- end if
- end if
- else if (which .eq. 'BE') then
- if ( workl(irz+j) .le. thres1 .or.
- & workl(irz+j) .ge. thres2 ) then
- tempbnd = max( eps23, abs(workl(irz+j)) )
- if (workl(ibd+j) .le. tol*tempbnd) then
- select(j+1) = .true.
- end if
- end if
- end if
- if (j+1 .gt. nconv ) reord = select(j+1) .or. reord
- if (select(j+1)) ktrord = ktrord + 1
- 10 continue
-
-c %-------------------------------------------%
-c | If KTRORD .ne. NCONV, something is wrong. |
-c %-------------------------------------------%
+ numcnv = 0
+ do 11 j = 1,ncv
+ temp1 = max(eps23, abs(workl(irz+ncv-j)) )
+ jj = workl(bounds + ncv - j)
+ if (numcnv .lt. nconv .and.
+ & workl(ibd+jj-1) .le. tol*temp1) then
+ select(jj) = .true.
+ numcnv = numcnv + 1
+ if (jj .gt. nev) reord = .true.
+ endif
+ 11 continue
+c
+c %-----------------------------------------------------------%
+c | Check the count (numcnv) of converged Ritz values with |
+c | the number (nconv) reported by _saupd. If these two |
+c | are different then there has probably been an error |
+c | caused by incorrect passing of the _saupd data. |
+c %-----------------------------------------------------------%
c
if (msglvl .gt. 2) then
- call ivout(logfil, 1, ktrord, ndigit,
+ call ivout(logfil, 1, numcnv, ndigit,
& '_seupd: Number of specified eigenvalues')
call ivout(logfil, 1, nconv, ndigit,
& '_seupd: Number of "converged" eigenvalues')
end if
c
+ if (numcnv .ne. nconv) then
+ info = -17
+ go to 9000
+ end if
+c
c %-----------------------------------------------------------%
c | Call LAPACK routine _steqr to compute the eigenvalues and |
c | eigenvectors of the final symmetric tridiagonal matrix H. |
@@ -586,7 +534,7 @@ c
call dcopy (ncv, workl(ih+ldh), 1, workl(ihd), 1)
c
call dsteqr ('Identity', ncv, workl(ihd), workl(ihb),
- & workl(iq), ldq, workl(iw), ierr)
+ & workl(iq) , ldq, workl(iw), ierr)
c
if (ierr .ne. 0) then
info = -8
@@ -648,11 +596,11 @@ c
temp = workl(ihd+leftptr-1)
workl(ihd+leftptr-1) = workl(ihd+rghtptr-1)
workl(ihd+rghtptr-1) = temp
- call dcopy(ncv, workl(iq+ncv*(leftptr-1)), 1,
+ call dcopy (ncv, workl(iq+ncv*(leftptr-1)), 1,
& workl(iw), 1)
- call dcopy(ncv, workl(iq+ncv*(rghtptr-1)), 1,
+ call dcopy (ncv, workl(iq+ncv*(rghtptr-1)), 1,
& workl(iq+ncv*(leftptr-1)), 1)
- call dcopy(ncv, workl(iw), 1,
+ call dcopy (ncv, workl(iw), 1,
& workl(iq+ncv*(rghtptr-1)), 1)
leftptr = leftptr + 1
rghtptr = rghtptr - 1
@@ -664,7 +612,7 @@ c
30 end if
c
if (msglvl .gt. 2) then
- call dvout (logfil, ncv, workl(ihd), ndigit,
+ call dvout (logfil, ncv, workl(ihd), ndigit,
& '_seupd: The eigenvalues of H--reordered')
end if
c
@@ -672,7 +620,7 @@ c %----------------------------------------%
c | Load the converged Ritz values into D. |
c %----------------------------------------%
c
- call dcopy(nconv, workl(ihd), 1, d, 1)
+ call dcopy (nconv, workl(ihd), 1, d, 1)
c
else
c
@@ -715,13 +663,13 @@ c | For TYPE = 'BUCKLE' the transformation is |
c | lambda = sigma * theta / ( theta - 1 ) |
c | For TYPE = 'CAYLEY' the transformation is |
c | lambda = sigma * (theta + 1) / (theta - 1 ) |
-c | where the theta are the Ritz values returned by dsaupd. |
+c | where the theta are the Ritz values returned by dsaupd . |
c | NOTES: |
c | *The Ritz vectors are not affected by the transformation. |
c | They are only reordered. |
c %-------------------------------------------------------------%
c
- call dcopy (ncv, workl(ihd), 1, workl(iw), 1)
+ call dcopy (ncv, workl(ihd), 1, workl(iw), 1)
if (type .eq. 'SHIFTI') then
do 40 k=1, ncv
workl(ihd+k-1) = one / workl(ihd+k-1) + sigma
@@ -742,14 +690,14 @@ c %-------------------------------------------------------------%
c | * Store the wanted NCONV lambda values into D. |
c | * Sort the NCONV wanted lambda in WORKL(IHD:IHD+NCONV-1) |
c | into ascending order and apply sort to the NCONV theta |
-c | values in the transformed system. We'll need this to |
+c | values in the transformed system. We will need this to |
c | compute Ritz estimates in the original system. |
-c | * Finally sort the lambda's into ascending order and apply |
-c | to Ritz vectors if wanted. Else just sort lambda's into |
+c | * Finally sort the lambda`s into ascending order and apply |
+c | to Ritz vectors if wanted. Else just sort lambda`s into |
c | ascending order. |
c | NOTES: |
c | *workl(iw:iw+ncv-1) contain the theta ordered so that they |
-c | match the ordering of the lambda. We'll use them again for |
+c | match the ordering of the lambda. We`ll use them again for |
c | Ritz vector purification. |
c %-------------------------------------------------------------%
c
@@ -779,10 +727,10 @@ c | the wanted invariant subspace located in the first NCONV |
c | columns of workl(iq,ldq). |
c %----------------------------------------------------------%
c
- call dgeqr2 (ncv, nconv, workl(iq), ldq, workl(iw+ncv),
- & workl(ihb), ierr)
+ call dgeqr2 (ncv, nconv , workl(iq) ,
+ & ldq, workl(iw+ncv), workl(ihb),
+ & ierr)
c
-c
c %--------------------------------------------------------%
c | * Postmultiply V by Q. |
c | * Copy the first NCONV columns of VQ into Z. |
@@ -791,22 +739,26 @@ c | of the approximate invariant subspace associated with |
c | the Ritz values in workl(ihd). |
c %--------------------------------------------------------%
c
- call dorm2r ('Right', 'Notranspose', n, ncv, nconv, workl(iq),
- & ldq, workl(iw+ncv), v, ldv, workd(n+1), ierr)
+ call dorm2r ('Right', 'Notranspose', n ,
+ & ncv , nconv , workl(iq),
+ & ldq , workl(iw+ncv), v ,
+ & ldv , workd(n+1) , ierr)
call dlacpy ('All', n, nconv, v, ldv, z, ldz)
c
c %-----------------------------------------------------%
c | In order to compute the Ritz estimates for the Ritz |
c | values in both systems, need the last row of the |
-c | eigenvector matrix. Remember, it's in factored form |
+c | eigenvector matrix. Remember, it`s in factored form |
c %-----------------------------------------------------%
c
do 65 j = 1, ncv-1
workl(ihb+j-1) = zero
65 continue
workl(ihb+ncv-1) = one
- call dorm2r ('Left', 'Transpose', ncv, 1, nconv, workl(iq),
- & ldq, workl(iw+ncv), workl(ihb), ncv, temp, ierr)
+ call dorm2r ('Left', 'Transpose' , ncv ,
+ & 1 , nconv , workl(iq) ,
+ & ldq , workl(iw+ncv), workl(ihb),
+ & ncv , temp , ierr)
c
else if (rvec .and. howmny .eq. 'S') then
c
@@ -827,29 +779,30 @@ c | * Determine Ritz estimates of the theta. |
c | If RVEC = .true. then compute Ritz estimates |
c | of the theta. |
c | If RVEC = .false. then copy Ritz estimates |
-c | as computed by dsaupd. |
+c | as computed by dsaupd . |
c | * Determine Ritz estimates of the lambda. |
c %-------------------------------------------------%
c
- call dscal (ncv, bnorm2, workl(ihb), 1)
+ call dscal (ncv, bnorm2, workl(ihb), 1)
if (type .eq. 'SHIFTI') then
c
do 80 k=1, ncv
- workl(ihb+k-1) = abs( workl(ihb+k-1) ) / workl(iw+k-1)**2
+ workl(ihb+k-1) = abs( workl(ihb+k-1) )
+ & / workl(iw+k-1)**2
80 continue
c
else if (type .eq. 'BUCKLE') then
c
do 90 k=1, ncv
- workl(ihb+k-1) = sigma * abs( workl(ihb+k-1) ) /
- & ( workl(iw+k-1)-one )**2
+ workl(ihb+k-1) = sigma * abs( workl(ihb+k-1) )
+ & / (workl(iw+k-1)-one )**2
90 continue
c
else if (type .eq. 'CAYLEY') then
c
do 100 k=1, ncv
- workl(ihb+k-1) = abs( workl(ihb+k-1) /
- & workl(iw+k-1)*(workl(iw+k-1)-one) )
+ workl(ihb+k-1) = abs( workl(ihb+k-1)
+ & / workl(iw+k-1)*(workl(iw+k-1)-one) )
100 continue
c
end if
@@ -877,19 +830,21 @@ c
if (rvec .and. (type .eq. 'SHIFTI' .or. type .eq. 'CAYLEY')) then
c
do 110 k=0, nconv-1
- workl(iw+k) = workl(iq+k*ldq+ncv-1) / workl(iw+k)
+ workl(iw+k) = workl(iq+k*ldq+ncv-1)
+ & / workl(iw+k)
110 continue
c
else if (rvec .and. type .eq. 'BUCKLE') then
c
do 120 k=0, nconv-1
- workl(iw+k) = workl(iq+k*ldq+ncv-1) / (workl(iw+k)-one)
+ workl(iw+k) = workl(iq+k*ldq+ncv-1)
+ & / (workl(iw+k)-one)
120 continue
c
end if
c
if (type .ne. 'REGULR')
- & call dger (n, nconv, one, resid, 1, workl(iw), 1, z, ldz)
+ & call dger (n, nconv, one, resid, 1, workl(iw), 1, z, ldz)
c
9000 continue
c
diff --git a/SRC/sgetv0.f b/SRC/sgetv0.f
index faf7fc8..86a98c4 100644
--- a/SRC/sgetv0.f
+++ b/SRC/sgetv0.f
@@ -110,7 +110,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: getv0.F SID: 2.6 DATE OF SID: 8/27/96 RELEASE: 2
+c FILE: getv0.F SID: 2.7 DATE OF SID: 04/07/99 RELEASE: 2
c
c\EndLib
c
@@ -373,7 +373,7 @@ c
if (rnorm .gt. 0.717*rnorm0) go to 50
c
iter = iter + 1
- if (iter .le. 1) then
+ if (iter .le. 5) then
c
c %-----------------------------------%
c | Perform iterative refinement step |
@@ -400,7 +400,7 @@ c
call svout (logfil, 1, rnorm, ndigit,
& '_getv0: B-norm of initial / restarted starting vector')
end if
- if (msglvl .gt. 2) then
+ if (msglvl .gt. 3) then
call svout (logfil, n, resid, ndigit,
& '_getv0: initial / restarted starting vector')
end if
diff --git a/SRC/snapps.f b/SRC/snapps.f
index fe64292..0ae94bf 100644
--- a/SRC/snapps.f
+++ b/SRC/snapps.f
@@ -124,10 +124,10 @@ c Rice University
c Houston, Texas
c
c\Revision history:
-c xx/xx/92: Version ' 2.1'
+c xx/xx/92: Version ' 2.4'
c
c\SCCS Information: @(#)
-c FILE: napps.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2
+c FILE: napps.F SID: 2.4 DATE OF SID: 3/28/97 RELEASE: 2
c
c\Remarks
c 1. In this version, each shift is applied to all the sublocks of
@@ -430,7 +430,7 @@ c %----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G |
c %----------------------------------------------------%
c
- do 70 j = 1, min( j+jj, kplusp )
+ do 70 j = 1, min( i+jj, kplusp )
t = c*q(j,i) + s*q(j,i+1)
q(j,i+1) = - s*q(j,i) + c*q(j,i+1)
q(j,i) = t
diff --git a/SRC/snaup2.f b/SRC/snaup2.f
index 50f741c..192702e 100644
--- a/SRC/snaup2.f
+++ b/SRC/snaup2.f
@@ -162,7 +162,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: naup2.F SID: 2.4 DATE OF SID: 7/30/96 RELEASE: 2
+c FILE: naup2.F SID: 2.8 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -216,25 +216,27 @@ c | Local Scalars |
c %---------------%
c
character wprime*2
- logical cnorm, getv0, initv, update, ushift
- integer ierr, iter, j, kplusp, msglvl, nconv, nevbef, nev0,
- & np0, nptemp, numcnv
+ logical cnorm , getv0, initv, update, ushift
+ integer ierr , iter , j , kplusp, msglvl, nconv,
+ & nevbef, nev0 , np0 , nptemp, numcnv
Real
- & rnorm, temp, eps23
+ & rnorm , temp , eps23
+ save cnorm , getv0, initv, update, ushift,
+ & rnorm , iter , eps23, kplusp, msglvl, nconv ,
+ & nevbef, nev0 , np0 , numcnv
c
c %-----------------------%
c | Local array arguments |
c %-----------------------%
c
integer kp(4)
- save
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
- external scopy, sgetv0, snaitr, snconv, sneigh, sngets, snapps,
- & svout, ivout, second
+ external scopy , sgetv0, snaitr, snconv, sneigh,
+ & sngets, snapps, svout , ivout , second
c
c %--------------------%
c | External Functions |
@@ -413,8 +415,9 @@ c
20 continue
update = .true.
c
- call snaitr (ido, bmat, n, nev, np, mode, resid, rnorm, v, ldv,
- & h, ldh, ipntr, workd, info)
+ call snaitr (ido , bmat, n , nev, np , mode , resid,
+ & rnorm, v , ldv, h , ldh, ipntr, workd,
+ & info)
c
c %---------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
@@ -587,7 +590,7 @@ c | Scale the Ritz estimate of each Ritz value |
c | by 1 / max(eps23,magnitude of the Ritz value). |
c %--------------------------------------------------%
c
- do 35 j = 1, nev0
+ do 35 j = 1, numcnv
temp = max(eps23,slapy2(ritzr(j),
& ritzi(j)))
bounds(j) = bounds(j)/temp
@@ -601,14 +604,14 @@ c | (in the case when NCONV < NEV.) |
c %----------------------------------------------------%
c
wprime = 'LR'
- call ssortc(wprime, .true., nev0, bounds, ritzr, ritzi)
+ call ssortc(wprime, .true., numcnv, bounds, ritzr, ritzi)
c
c %----------------------------------------------%
c | Scale the Ritz estimate back to its original |
c | value. |
c %----------------------------------------------%
c
- do 40 j = 1, nev0
+ do 40 j = 1, numcnv
temp = max(eps23, slapy2(ritzr(j),
& ritzi(j)))
bounds(j) = bounds(j)*temp
diff --git a/SRC/snaupd.f b/SRC/snaupd.f
index 9d4e118..68aad43 100644
--- a/SRC/snaupd.f
+++ b/SRC/snaupd.f
@@ -9,7 +9,7 @@ c of a linear operator "OP" with respect to a semi-inner product defined by
c a symmetric positive semi-definite real matrix B. B may be the identity
c matrix. NOTE: If the linear operator "OP" is real and symmetric
c with respect to the real positive semi-definite symmetric matrix B,
-c i.e. B*OP = (OP')*B, then subroutine ssaupd should be used instead.
+c i.e. B*OP = (OP`)*B, then subroutine ssaupd should be used instead.
c
c The computed approximate eigenvalues are called Ritz values and
c the corresponding approximate eigenvectors are called Ritz vectors.
@@ -110,7 +110,7 @@ c 'SR' -> want the NEV eigenvalues of smallest real part.
c 'LI' -> want the NEV eigenvalues of largest imaginary part.
c 'SI' -> want the NEV eigenvalues of smallest imaginary part.
c
-c NEV Integer. (INPUT)
+c NEV Integer. (INPUT/OUTPUT)
c Number of eigenvalues of OP to be computed. 0 < NEV < N-1.
c
c TOL Real scalar. (INPUT)
@@ -289,13 +289,13 @@ c 2. If a basis for the invariant subspace corresponding to the converged Ritz
c values is needed, the user must call sneupd immediately following
c completion of snaupd. This is new starting with release 2 of ARPACK.
c
-c 3. If M can be factored into a Cholesky factorization M = LL'
+c 3. If M can be factored into a Cholesky factorization M = LL`
c then Mode = 2 should not be selected. Instead one should use
-c Mode = 1 with OP = inv(L)*A*inv(L'). Appropriate triangular
-c linear systems should be solved with L and L' rather
+c Mode = 1 with OP = inv(L)*A*inv(L`). Appropriate triangular
+c linear systems should be solved with L and L` rather
c than computing inverses. After convergence, an approximate
c eigenvector z of the original problem is recovered by solving
-c L'z = x where x is a Ritz vector of OP.
+c L`z = x where x is a Ritz vector of OP.
c
c 4. At present there is no a-priori analysis to guide the selection
c of NCV relative to NEV. The only formal requrement is that NCV > NEV + 2.
@@ -395,7 +395,7 @@ c\Revision history:
c 12/16/93: Version '1.1'
c
c\SCCS Information: @(#)
-c FILE: naupd.F SID: 2.5 DATE OF SID: 8/27/96 RELEASE: 2
+c FILE: naupd.F SID: 2.10 DATE OF SID: 08/23/02 RELEASE: 2
c
c\Remarks
c
@@ -485,9 +485,10 @@ c %----------------%
c
ierr = 0
ishift = iparam(1)
- levec = iparam(2)
+c levec = iparam(2)
mxiter = iparam(3)
- nb = iparam(4)
+c nb = iparam(4)
+ nb = 1
c
c %--------------------------------------------%
c | Revision 2 performs only implicit restart. |
@@ -497,13 +498,13 @@ c
mode = iparam(7)
c
if (n .le. 0) then
- ierr = -1
+ ierr = -1
else if (nev .le. 0) then
- ierr = -2
+ ierr = -2
else if (ncv .le. nev+1 .or. ncv .gt. n) then
- ierr = -3
- else if (mxiter .le. 0) then
- ierr = -4
+ ierr = -3
+ else if (mxiter .le. 0) then
+ ierr = 4
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LR' .and.
@@ -515,12 +516,12 @@ c
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 6*ncv) then
ierr = -7
- else if (mode .lt. 1 .or. mode .gt. 5) then
- ierr = -10
+ else if (mode .lt. 1 .or. mode .gt. 4) then
+ ierr = -10
else if (mode .eq. 1 .and. bmat .eq. 'G') then
- ierr = -11
+ ierr = -11
else if (ishift .lt. 0 .or. ishift .gt. 1) then
- ierr = -12
+ ierr = -12
end if
c
c %------------%
diff --git a/SRC/sneupd.f b/SRC/sneupd.f
index 102b53a..5f496d5 100644
--- a/SRC/sneupd.f
+++ b/SRC/sneupd.f
@@ -66,7 +66,7 @@ c computed. To select the Ritz vector corresponding to a
c Ritz value (DR(j), DI(j)), SELECT(j) must be set to .TRUE..
c If HOWMNY = 'A' or 'P', SELECT is used as internal workspace.
c
-c DR Real array of dimension NEV+1. (OUTPUT)
+c DR Real array of dimension NEV+1. (OUTPUT)
c If IPARAM(7) = 1,2 or 3 and SIGMAI=0.0 then on exit: DR contains
c the real part of the Ritz approximations to the eigenvalues of
c A*z = lambda*B*z.
@@ -76,7 +76,7 @@ c SNAUPD. A further computation must be performed by the user
c to transform the Ritz values computed for OP by SNAUPD to those
c of the original system A*z = lambda*B*z. See remark 3 below.
c
-c DI Real array of dimension NEV+1. (OUTPUT)
+c DI Real array of dimension NEV+1. (OUTPUT)
c On exit, DI contains the imaginary part of the Ritz value
c approximations to the eigenvalues of A*z = lambda*B*z associated
c with DR.
@@ -88,7 +88,7 @@ c pairs and the real and imaginary parts of these are
c represented in two consecutive columns of the array Z
c (see below).
c
-c Z Real N by NEV+1 array if RVEC = .TRUE. and HOWMNY = 'A'. (OUTPUT)
+c Z Real N by NEV+1 array if RVEC = .TRUE. and HOWMNY = 'A'. (OUTPUT)
c On exit, if RVEC = .TRUE. and HOWMNY = 'A', then the columns of
c Z represent approximate eigenvectors (Ritz vectors) corresponding
c to the NCONV=IPARAM(5) Ritz values for eigensystem
@@ -113,15 +113,15 @@ c LDZ Integer. (INPUT)
c The leading dimension of the array Z. If Ritz vectors are
c desired, then LDZ >= max( 1, N ). In any case, LDZ >= 1.
c
-c SIGMAR Real (INPUT)
+c SIGMAR Real (INPUT)
c If IPARAM(7) = 3 or 4, represents the real part of the shift.
c Not referenced if IPARAM(7) = 1 or 2.
c
-c SIGMAI Real (INPUT)
+c SIGMAI Real (INPUT)
c If IPARAM(7) = 3 or 4, represents the imaginary part of the shift.
c Not referenced if IPARAM(7) = 1 or 2. See remark 3 below.
c
-c WORKEV Real work array of dimension 3*NCV. (WORKSPACE)
+c WORKEV Real work array of dimension 3*NCV. (WORKSPACE)
c
c **** The remaining arguments MUST be the same as for the ****
c **** call to SNAUPD that was just completed. ****
@@ -137,7 +137,7 @@ c the the last call to SNAUPD and the call to SNEUPD.
c
c Three of these parameters (V, WORKL, INFO) are also output parameters:
c
-c V Real N by NCV array. (INPUT/OUTPUT)
+c V Real N by NCV array. (INPUT/OUTPUT)
c
c Upon INPUT: the NCV columns of V contain the Arnoldi basis
c vectors for OP as constructed by SNAUPD .
@@ -153,7 +153,7 @@ c Ritz vectors. If a separate array Z has been passed then
c the first NCONV=IPARAM(5) columns of V will contain approximate
c Schur vectors that span the desired invariant subspace.
c
-c WORKL Real work array of length LWORKL. (OUTPUT/WORKSPACE)
+c WORKL Real work array of length LWORKL. (OUTPUT/WORKSPACE)
c WORKL(1:ncv*ncv+3*ncv) contains information obtained in
c snaupd. They are not changed by sneupd.
c WORKL(ncv*ncv+3*ncv+1:3*ncv*ncv+6*ncv) holds the
@@ -206,6 +206,11 @@ c = -12: HOWMNY = 'S' not yet implemented
c = -13: HOWMNY must be one of 'A' or 'P' if RVEC = .true.
c = -14: SNAUPD did not find any eigenvalues to sufficient
c accuracy.
+c = -15: DNEUPD got a different count of the number of converged
+c Ritz values than DNAUPD got. This indicates the user
+c probably made an error in passing data from DNAUPD to
+c DNEUPD or that the data was modified before entering
+c DNEUPD
c
c\BeginLib
c
@@ -248,15 +253,15 @@ c\Remarks
c
c 1. Currently only HOWMNY = 'A' and 'P' are implemented.
c
-c Let X' denote the transpose of X.
+c Let trans(X) denote the transpose of X.
c
c 2. Schur vectors are an orthogonal representation for the basis of
c Ritz vectors. Thus, their numerical properties are often superior.
c If RVEC = .TRUE. then the relationship
c A * V(:,1:IPARAM(5)) = V(:,1:IPARAM(5)) * T, and
-c V(:,1:IPARAM(5))' * V(:,1:IPARAM(5)) = I are approximately satisfied.
-c Here T is the leading submatrix of order IPARAM(5) of the real
-c upper quasi-triangular matrix stored workl(ipntr(12)). That is,
+c trans(V(:,1:IPARAM(5))) * V(:,1:IPARAM(5)) = I are approximately
+c satisfied. Here T is the leading submatrix of order IPARAM(5) of the
+c real upper quasi-triangular matrix stored workl(ipntr(12)). That is,
c T is block upper triangular with 1-by-1 and 2-by-2 diagonal blocks;
c each 2-by-2 diagonal block has its diagonal elements equal and its
c off-diagonal elements of opposite sign. Corresponding to each 2-by-2
@@ -268,13 +273,14 @@ c form the IPARAM(5) Rayleigh quotients in order to transform the Ritz
c values computed by SNAUPD for OP to those of A*z = lambda*B*z.
c Set RVEC = .true. and HOWMNY = 'A', and
c compute
-c Z(:,I)' * A * Z(:,I) if DI(I) = 0.
+c trans(Z(:,I)) * A * Z(:,I) if DI(I) = 0.
c If DI(I) is not equal to zero and DI(I+1) = - D(I),
c then the desired real and imaginary parts of the Ritz value are
-c Z(:,I)' * A * Z(:,I) + Z(:,I+1)' * A * Z(:,I+1),
-c Z(:,I)' * A * Z(:,I+1) - Z(:,I+1)' * A * Z(:,I), respectively.
+c trans(Z(:,I)) * A * Z(:,I) + trans(Z(:,I+1)) * A * Z(:,I+1),
+c trans(Z(:,I)) * A * Z(:,I+1) - trans(Z(:,I+1)) * A * Z(:,I),
+c respectively.
c Another possibility is to set RVEC = .true. and HOWMNY = 'P' and
-c compute V(:,1:IPARAM(5))' * A * V(:,1:IPARAM(5)) and then an upper
+c compute trans(V(:,1:IPARAM(5))) * A * V(:,1:IPARAM(5)) and then an upper
c quasi-triangular matrix of order IPARAM(5) is computed. See remark
c 2 above.
c
@@ -288,15 +294,16 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: neupd.F SID: 2.5 DATE OF SID: 7/31/96 RELEASE: 2
+c FILE: neupd.F SID: 2.7 DATE OF SID: 09/20/00 RELEASE: 2
c
c\EndLib
c
c-----------------------------------------------------------------------
- subroutine sneupd (rvec, howmny, select, dr, di, z, ldz, sigmar,
- & sigmai, workev, bmat, n, which, nev, tol,
- & resid, ncv, v, ldv, iparam, ipntr, workd,
- & workl, lworkl, info)
+ subroutine sneupd(rvec , howmny, select, dr , di,
+ & z , ldz , sigmar, sigmai, workev,
+ & bmat , n , which , nev , tol,
+ & resid, ncv , v , ldv , iparam,
+ & ipntr, workd , workl , lworkl, info)
c
c %----------------------------------------------------%
c | Include files for debugging and timing information |
@@ -312,7 +319,7 @@ c
character bmat, howmny, which*2
logical rvec
integer info, ldz, ldv, lworkl, n, ncv, nev
- Real
+ Real
& sigmar, sigmai, tol
c
c %-----------------%
@@ -321,43 +328,51 @@ c %-----------------%
c
integer iparam(11), ipntr(14)
logical select(ncv)
- Real
- & dr(nev+1), di(nev+1), resid(n), v(ldv,ncv), z(ldz,*),
- & workd(3*n), workl(lworkl), workev(3*ncv)
+ Real
+ & dr(nev+1) , di(nev+1), resid(n) ,
+ & v(ldv,ncv) , z(ldz,*) , workd(3*n),
+ & workl(lworkl), workev(3*ncv)
c
c %------------%
c | Parameters |
c %------------%
c
- Real
+ Real
& one, zero
- parameter (one = 1.0E+0, zero = 0.0E+0)
+ parameter (one = 1.0E+0 , zero = 0.0E+0 )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character type*6
- integer bounds, ierr, ih, ihbds, iheigr, iheigi, iconj, nconv,
- & invsub, iuptri, iwev, iwork(1), j, k, ktrord,
- & ldh, ldq, mode, msglvl, outncv, ritzr, ritzi, wri, wrr,
- & irr, iri, ibd
+ integer bounds, ierr , ih , ihbds ,
+ & iheigr, iheigi, iconj , nconv ,
+ & invsub, iuptri, iwev , iwork(1),
+ & j , k , ldh , ldq ,
+ & mode , msglvl, outncv, ritzr ,
+ & ritzi , wri , wrr , irr ,
+ & iri , ibd , ishift, numcnv ,
+ & np , jj
logical reord
- Real
- & conds, rnorm, sep, temp, thres, vl(1,1), temp1, eps23
+ Real
+ & conds , rnorm, sep , temp,
+ & vl(1,1), temp1, eps23
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
- external scopy, sger, sgeqr2, slacpy, slahqr, slaset, smout,
- & sorm2r, strevc, strmm, strsen, sscal, svout, ivout
+ external scopy , sger , sgeqr2, slacpy,
+ & slahqr, slaset, smout , sorm2r,
+ & strevc, strmm , strsen, sscal ,
+ & svout , ivout
c
c %--------------------%
c | External Functions |
c %--------------------%
c
- Real
+ Real
& slapy2, snrm2, slamch, sdot
external slapy2, snrm2, slamch, sdot
c
@@ -385,7 +400,7 @@ c | Get machine dependent constant. |
c %---------------------------------%
c
eps23 = slamch('Epsilon-Machine')
- eps23 = eps23**(2.0E+0 / 3.0E+0)
+ eps23 = eps23**(2.0E+0 / 3.0E+0 )
c
c %--------------%
c | Quick return |
@@ -511,111 +526,92 @@ c %------------------------------------%
c
rnorm = workl(ih+2)
workl(ih+2) = zero
-c
+c
+ if (msglvl .gt. 2) then
+ call svout(logfil, ncv, workl(irr), ndigit,
+ & '_neupd: Real part of Ritz values passed in from _NAUPD.')
+ call svout(logfil, ncv, workl(iri), ndigit,
+ & '_neupd: Imag part of Ritz values passed in from _NAUPD.')
+ call svout(logfil, ncv, workl(ibd), ndigit,
+ & '_neupd: Ritz estimates passed in from _NAUPD.')
+ end if
+c
if (rvec) then
c
-c %-------------------------------------------%
-c | Get converged Ritz value on the boundary. |
-c | Note: converged Ritz values have been |
-c | placed in the first NCONV locations in |
-c | workl(ritzr) and workl(ritzi). They have |
-c | been sorted (in _naup2) according to the |
-c | WHICH selection criterion. |
-c %-------------------------------------------%
-c
- if (which .eq. 'LM' .or. which .eq. 'SM') then
- thres = slapy2( workl(ritzr), workl(ritzi) )
- else if (which .eq. 'LR' .or. which .eq. 'SR') then
- thres = workl(ritzr)
- else if (which .eq. 'LI' .or. which .eq. 'SI') then
- thres = abs( workl(ritzi) )
- end if
+ reord = .false.
+c
+c %---------------------------------------------------%
+c | Use the temporary bounds array to store indices |
+c | These will be used to mark the select array later |
+c %---------------------------------------------------%
+c
+ do 10 j = 1,ncv
+ workl(bounds+j-1) = j
+ select(j) = .false.
+ 10 continue
+c
+c %-------------------------------------%
+c | Select the wanted Ritz values. |
+c | Sort the Ritz values so that the |
+c | wanted ones appear at the tailing |
+c | NEV positions of workl(irr) and |
+c | workl(iri). Move the corresponding |
+c | error estimates in workl(bound) |
+c | accordingly. |
+c %-------------------------------------%
+c
+ np = ncv - nev
+ ishift = 0
+ call sngets(ishift , which , nev ,
+ & np , workl(irr), workl(iri),
+ & workl(bounds), workl , workl(np+1))
c
if (msglvl .gt. 2) then
- call svout(logfil, 1, thres, ndigit,
- & '_neupd: Threshold eigenvalue used for re-ordering')
+ call svout(logfil, ncv, workl(irr), ndigit,
+ & '_neupd: Real part of Ritz values after calling _NGETS.')
+ call svout(logfil, ncv, workl(iri), ndigit,
+ & '_neupd: Imag part of Ritz values after calling _NGETS.')
+ call svout(logfil, ncv, workl(bounds), ndigit,
+ & '_neupd: Ritz value indices after calling _NGETS.')
end if
c
-c %----------------------------------------------------------%
-c | Check to see if all converged Ritz values appear at the |
-c | top of the upper quasi-triangular matrix computed by |
-c | _neigh in _naup2. This is done in the following way: |
-c | |
-c | 1) For each Ritz value obtained from _neigh, compare it |
-c | with the threshold Ritz value computed above to |
-c | determine whether it is a wanted one. |
-c | |
-c | 2) If it is wanted, then check the corresponding Ritz |
-c | estimate to see if it has converged. If it has, set |
-c | correponding entry in the logical array SELECT to |
-c | .TRUE.. |
-c | |
-c | If SELECT(j) = .TRUE. and j > NCONV, then there is a |
-c | converged Ritz value that does not appear at the top of |
-c | the upper quasi-triangular matrix computed by _neigh in |
-c | _naup2. Reordering is needed. |
-c %----------------------------------------------------------%
+c %-----------------------------------------------------%
+c | Record indices of the converged wanted Ritz values |
+c | Mark the select array for possible reordering |
+c %-----------------------------------------------------%
+c
+ numcnv = 0
+ do 11 j = 1,ncv
+ temp1 = max(eps23,
+ & slapy2( workl(irr+ncv-j), workl(iri+ncv-j) ))
+ jj = workl(bounds + ncv - j)
+ if (numcnv .lt. nconv .and.
+ & workl(ibd+jj-1) .le. tol*temp1) then
+ select(jj) = .true.
+ numcnv = numcnv + 1
+ if (jj .gt. nev) reord = .true.
+ endif
+ 11 continue
c
- reord = .false.
- ktrord = 0
- do 10 j = 0, ncv-1
- select(j+1) = .false.
- if (which .eq. 'LM') then
- if (slapy2(workl(irr+j), workl(iri+j))
- & .ge. thres) then
- temp1 = max( eps23,
- & slapy2( workl(irr+j), workl(iri+j) ) )
- if (workl(ibd+j) .le. tol*temp1)
- & select(j+1) = .true.
- end if
- else if (which .eq. 'SM') then
- if (slapy2(workl(irr+j), workl(iri+j))
- & .le. thres) then
- temp1 = max( eps23,
- & slapy2( workl(irr+j), workl(iri+j) ) )
- if (workl(ibd+j) .le. tol*temp1)
- & select(j+1) = .true.
- end if
- else if (which .eq. 'LR') then
- if (workl(irr+j) .ge. thres) then
- temp1 = max( eps23,
- & slapy2( workl(irr+j), workl(iri+j) ) )
- if (workl(ibd+j) .le. tol*temp1)
- & select(j+1) = .true.
- end if
- else if (which .eq. 'SR') then
- if (workl(irr+j) .le. thres) then
- temp1 = max( eps23,
- & slapy2( workl(irr+j), workl(iri+j) ) )
- if (workl(ibd+j) .le. tol*temp1)
- & select(j+1) = .true.
- end if
- else if (which .eq. 'LI') then
- if (abs(workl(iri+j)) .ge. thres) then
- temp1 = max( eps23,
- & slapy2( workl(irr+j), workl(iri+j) ) )
- if (workl(ibd+j) .le. tol*temp1)
- & select(j+1) = .true.
- end if
- else if (which .eq. 'SI') then
- if (abs(workl(iri+j)) .le. thres) then
- temp1 = max( eps23,
- & slapy2( workl(irr+j), workl(iri+j) ) )
- if (workl(ibd+j) .le. tol*temp1)
- & select(j+1) = .true.
- end if
- end if
- if (j+1 .gt. nconv ) reord = ( select(j+1) .or. reord )
- if (select(j+1)) ktrord = ktrord + 1
- 10 continue
+c %-----------------------------------------------------------%
+c | Check the count (numcnv) of converged Ritz values with |
+c | the number (nconv) reported by dnaupd. If these two |
+c | are different then there has probably been an error |
+c | caused by incorrect passing of the dnaupd data. |
+c %-----------------------------------------------------------%
c
if (msglvl .gt. 2) then
- call ivout(logfil, 1, ktrord, ndigit,
+ call ivout(logfil, 1, numcnv, ndigit,
& '_neupd: Number of specified eigenvalues')
call ivout(logfil, 1, nconv, ndigit,
& '_neupd: Number of "converged" eigenvalues')
end if
c
+ if (numcnv .ne. nconv) then
+ info = -15
+ go to 9000
+ end if
+c
c %-----------------------------------------------------------%
c | Call LAPACK routine slahqr to compute the real Schur form |
c | of the upper Hessenberg matrix returned by SNAUPD. |
@@ -623,12 +619,17 @@ c | Make a copy of the upper Hessenberg matrix. |
c | Initialize the Schur vector matrix Q to the identity. |
c %-----------------------------------------------------------%
c
- call scopy (ldh*ncv, workl(ih), 1, workl(iuptri), 1)
- call slaset ('All', ncv, ncv, zero, one, workl(invsub), ldq)
- call slahqr (.true., .true., ncv, 1, ncv, workl(iuptri), ldh,
- & workl(iheigr), workl(iheigi), 1, ncv,
- & workl(invsub), ldq, ierr)
- call scopy (ncv, workl(invsub+ncv-1), ldq, workl(ihbds), 1)
+ call scopy(ldh*ncv, workl(ih), 1, workl(iuptri), 1)
+ call slaset('All', ncv, ncv,
+ & zero , one, workl(invsub),
+ & ldq)
+ call slahqr(.true., .true. , ncv,
+ & 1 , ncv , workl(iuptri),
+ & ldh , workl(iheigr), workl(iheigi),
+ & 1 , ncv , workl(invsub),
+ & ldq , ierr)
+ call scopy(ncv , workl(invsub+ncv-1), ldq,
+ & workl(ihbds), 1)
c
if (ierr .ne. 0) then
info = -8
@@ -636,14 +637,15 @@ c
end if
c
if (msglvl .gt. 1) then
- call svout (logfil, ncv, workl(iheigr), ndigit,
+ call svout(logfil, ncv, workl(iheigr), ndigit,
& '_neupd: Real part of the eigenvalues of H')
- call svout (logfil, ncv, workl(iheigi), ndigit,
+ call svout(logfil, ncv, workl(iheigi), ndigit,
& '_neupd: Imaginary part of the Eigenvalues of H')
- call svout (logfil, ncv, workl(ihbds), ndigit,
+ call svout(logfil, ncv, workl(ihbds), ndigit,
& '_neupd: Last row of the Schur vector matrix')
if (msglvl .gt. 3) then
- call smout (logfil, ncv, ncv, workl(iuptri), ldh, ndigit,
+ call smout(logfil , ncv, ncv ,
+ & workl(iuptri), ldh, ndigit,
& '_neupd: The upper quasi-triangular matrix ')
end if
end if
@@ -654,9 +656,15 @@ c %-----------------------------------------------------%
c | Reorder the computed upper quasi-triangular matrix. |
c %-----------------------------------------------------%
c
- call strsen ('None', 'V', select, ncv, workl(iuptri), ldh,
- & workl(invsub), ldq, workl(iheigr), workl(iheigi),
- & nconv, conds, sep, workl(ihbds), ncv, iwork, 1, ierr)
+ call strsen('None' , 'V' ,
+ & select , ncv ,
+ & workl(iuptri), ldh ,
+ & workl(invsub), ldq ,
+ & workl(iheigr), workl(iheigi),
+ & nconv , conds ,
+ & sep , workl(ihbds) ,
+ & ncv , iwork ,
+ & 1 , ierr)
c
if (ierr .eq. 1) then
info = 1
@@ -664,14 +672,14 @@ c
end if
c
if (msglvl .gt. 2) then
- call svout (logfil, ncv, workl(iheigr), ndigit,
+ call svout(logfil, ncv, workl(iheigr), ndigit,
& '_neupd: Real part of the eigenvalues of H--reordered')
- call svout (logfil, ncv, workl(iheigi), ndigit,
+ call svout(logfil, ncv, workl(iheigi), ndigit,
& '_neupd: Imag part of the eigenvalues of H--reordered')
if (msglvl .gt. 3) then
- call smout (logfil, ncv, ncv, workl(iuptri), ldq,
- & ndigit,
- & '_neupd: Quasi-triangular matrix after re-ordering')
+ call smout(logfil , ncv, ncv ,
+ & workl(iuptri), ldq, ndigit,
+ & '_neupd: Quasi-triangular matrix after re-ordering')
end if
end if
c
@@ -692,8 +700,8 @@ c | if a spectral transformation was not used. |
c %----------------------------------------------------%
c
if (type .eq. 'REGULR') then
- call scopy (nconv, workl(iheigr), 1, dr, 1)
- call scopy (nconv, workl(iheigi), 1, di, 1)
+ call scopy(nconv, workl(iheigr), 1, dr, 1)
+ call scopy(nconv, workl(iheigi), 1, di, 1)
end if
c
c %----------------------------------------------------------%
@@ -702,8 +710,9 @@ c | the wanted invariant subspace located in the first NCONV |
c | columns of workl(invsub,ldq). |
c %----------------------------------------------------------%
c
- call sgeqr2 (ncv, nconv, workl(invsub), ldq, workev,
- & workev(ncv+1), ierr)
+ call sgeqr2(ncv, nconv , workl(invsub),
+ & ldq, workev, workev(ncv+1),
+ & ierr)
c
c %---------------------------------------------------------%
c | * Postmultiply V by Q using sorm2r. |
@@ -717,9 +726,11 @@ c | vectors associated with the real upper quasi-triangular |
c | matrix of order NCONV in workl(iuptri) |
c %---------------------------------------------------------%
c
- call sorm2r ('Right', 'Notranspose', n, ncv, nconv,
- & workl(invsub), ldq, workev, v, ldv, workd(n+1), ierr)
- call slacpy ('All', n, nconv, v, ldv, z, ldz)
+ call sorm2r('Right', 'Notranspose', n ,
+ & ncv , nconv , workl(invsub),
+ & ldq , workev , v ,
+ & ldv , workd(n+1) , ierr)
+ call slacpy('All', n, nconv, v, ldv, z, ldz)
c
do 20 j=1, nconv
c
@@ -733,8 +744,8 @@ c | matrix consisting of plus or minus ones |
c %---------------------------------------------------%
c
if (workl(invsub+(j-1)*ldq+j-1) .lt. zero) then
- call sscal (nconv, -one, workl(iuptri+j-1), ldq)
- call sscal (nconv, -one, workl(iuptri+(j-1)*ldq), 1)
+ call sscal(nconv, -one, workl(iuptri+j-1), ldq)
+ call sscal(nconv, -one, workl(iuptri+(j-1)*ldq), 1)
end if
c
20 continue
@@ -754,9 +765,11 @@ c
end if
30 continue
c
- call strevc ('Right', 'Select', select, ncv, workl(iuptri),
- & ldq, vl, 1, workl(invsub), ldq, ncv, outncv, workev,
- & ierr)
+ call strevc('Right', 'Select' , select ,
+ & ncv , workl(iuptri), ldq ,
+ & vl , 1 , workl(invsub),
+ & ldq , ncv , outncv ,
+ & workev , ierr)
c
if (ierr .ne. 0) then
info = -9
@@ -781,7 +794,7 @@ c | real eigenvalue case |
c %----------------------%
c
temp = snrm2( ncv, workl(invsub+(j-1)*ldq), 1 )
- call sscal ( ncv, one / temp,
+ call sscal( ncv, one / temp,
& workl(invsub+(j-1)*ldq), 1 )
c
else
@@ -795,12 +808,16 @@ c | square root of two. |
c %-------------------------------------------%
c
if (iconj .eq. 0) then
- temp = slapy2( snrm2( ncv, workl(invsub+(j-1)*ldq),
- & 1 ), snrm2( ncv, workl(invsub+j*ldq), 1) )
- call sscal ( ncv, one / temp,
- & workl(invsub+(j-1)*ldq), 1 )
- call sscal ( ncv, one / temp,
- & workl(invsub+j*ldq), 1 )
+ temp = slapy2(snrm2(ncv,
+ & workl(invsub+(j-1)*ldq),
+ & 1),
+ & snrm2(ncv,
+ & workl(invsub+j*ldq),
+ & 1))
+ call sscal(ncv, one/temp,
+ & workl(invsub+(j-1)*ldq), 1 )
+ call sscal(ncv, one/temp,
+ & workl(invsub+j*ldq), 1 )
iconj = 1
else
iconj = 0
@@ -811,7 +828,7 @@ c
40 continue
c
call sgemv('T', ncv, nconv, one, workl(invsub),
- & ldq, workl(ihbds), 1, zero, workev, 1)
+ & ldq, workl(ihbds), 1, zero, workev, 1)
c
iconj = 0
do 45 j=1, nconv
@@ -836,10 +853,10 @@ c
if (msglvl .gt. 2) then
call scopy(ncv, workl(invsub+ncv-1), ldq,
& workl(ihbds), 1)
- call svout (logfil, ncv, workl(ihbds), ndigit,
+ call svout(logfil, ncv, workl(ihbds), ndigit,
& '_neupd: Last row of the eigenvector matrix for T')
if (msglvl .gt. 3) then
- call smout (logfil, ncv, ncv, workl(invsub), ldq,
+ call smout(logfil, ncv, ncv, workl(invsub), ldq,
& ndigit, '_neupd: The eigenvector matrix for T')
end if
end if
@@ -856,8 +873,9 @@ c | associated with leading portion of T in the first NCONV |
c | columns of workl(invsub,ldq). |
c %---------------------------------------------------------%
c
- call sgeqr2 (ncv, nconv, workl(invsub), ldq, workev,
- & workev(ncv+1), ierr)
+ call sgeqr2(ncv, nconv , workl(invsub),
+ & ldq, workev, workev(ncv+1),
+ & ierr)
c
c %----------------------------------------------%
c | * Postmultiply Z by Q. |
@@ -867,11 +885,15 @@ c | Ritz vectors associated with the Ritz values |
c | in workl(iheigr) and workl(iheigi). |
c %----------------------------------------------%
c
- call sorm2r ('Right', 'Notranspose', n, ncv, nconv,
- & workl(invsub), ldq, workev, z, ldz, workd(n+1), ierr)
+ call sorm2r('Right', 'Notranspose', n ,
+ & ncv , nconv , workl(invsub),
+ & ldq , workev , z ,
+ & ldz , workd(n+1) , ierr)
c
- call strmm ('Right', 'Upper', 'No transpose', 'Non-unit',
- & n, nconv, one, workl(invsub), ldq, z, ldz)
+ call strmm('Right' , 'Upper' , 'No transpose',
+ & 'Non-unit', n , nconv ,
+ & one , workl(invsub), ldq ,
+ & z , ldz)
c
end if
c
@@ -882,11 +904,11 @@ c | An approximate invariant subspace is not needed. |
c | Place the Ritz values computed SNAUPD into DR and DI |
c %------------------------------------------------------%
c
- call scopy (nconv, workl(ritzr), 1, dr, 1)
- call scopy (nconv, workl(ritzi), 1, di, 1)
- call scopy (nconv, workl(ritzr), 1, workl(iheigr), 1)
- call scopy (nconv, workl(ritzi), 1, workl(iheigi), 1)
- call scopy (nconv, workl(bounds), 1, workl(ihbds), 1)
+ call scopy(nconv, workl(ritzr), 1, dr, 1)
+ call scopy(nconv, workl(ritzi), 1, di, 1)
+ call scopy(nconv, workl(ritzr), 1, workl(iheigr), 1)
+ call scopy(nconv, workl(ritzi), 1, workl(iheigi), 1)
+ call scopy(nconv, workl(bounds), 1, workl(ihbds), 1)
end if
c
c %------------------------------------------------%
@@ -898,7 +920,7 @@ c
if (type .eq. 'REGULR') then
c
if (rvec)
- & call sscal (ncv, rnorm, workl(ihbds), 1)
+ & call sscal(ncv, rnorm, workl(ihbds), 1)
c
else
c
@@ -911,7 +933,7 @@ c
if (type .eq. 'SHIFTI') then
c
if (rvec)
- & call sscal (ncv, rnorm, workl(ihbds), 1)
+ & call sscal(ncv, rnorm, workl(ihbds), 1)
c
do 50 k=1, ncv
temp = slapy2( workl(iheigr+k-1),
@@ -947,37 +969,37 @@ c
do 80 k=1, ncv
temp = slapy2( workl(iheigr+k-1),
& workl(iheigi+k-1) )
- workl(iheigr+k-1) = workl(iheigr+k-1) / temp / temp
+ workl(iheigr+k-1) = workl(iheigr+k-1)/temp/temp
& + sigmar
- workl(iheigi+k-1) = -workl(iheigi+k-1) / temp / temp
+ workl(iheigi+k-1) = -workl(iheigi+k-1)/temp/temp
& + sigmai
80 continue
c
- call scopy (nconv, workl(iheigr), 1, dr, 1)
- call scopy (nconv, workl(iheigi), 1, di, 1)
+ call scopy(nconv, workl(iheigr), 1, dr, 1)
+ call scopy(nconv, workl(iheigi), 1, di, 1)
c
else if (type .eq. 'REALPT' .or. type .eq. 'IMAGPT') then
c
- call scopy (nconv, workl(iheigr), 1, dr, 1)
- call scopy (nconv, workl(iheigi), 1, di, 1)
+ call scopy(nconv, workl(iheigr), 1, dr, 1)
+ call scopy(nconv, workl(iheigi), 1, di, 1)
c
end if
c
end if
c
if (type .eq. 'SHIFTI' .and. msglvl .gt. 1) then
- call svout (logfil, nconv, dr, ndigit,
+ call svout(logfil, nconv, dr, ndigit,
& '_neupd: Untransformed real part of the Ritz valuess.')
call svout (logfil, nconv, di, ndigit,
& '_neupd: Untransformed imag part of the Ritz valuess.')
- call svout (logfil, nconv, workl(ihbds), ndigit,
+ call svout(logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Ritz estimates of untransformed Ritz values.')
else if (type .eq. 'REGULR' .and. msglvl .gt. 1) then
- call svout (logfil, nconv, dr, ndigit,
+ call svout(logfil, nconv, dr, ndigit,
& '_neupd: Real parts of converged Ritz values.')
call svout (logfil, nconv, di, ndigit,
& '_neupd: Imag parts of converged Ritz values.')
- call svout (logfil, nconv, workl(ihbds), ndigit,
+ call svout(logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Associated Ritz estimates.')
end if
c
@@ -1026,7 +1048,7 @@ c | Perform a rank one update to Z and |
c | purify all the Ritz vectors together. |
c %---------------------------------------%
c
- call sger (n, nconv, one, resid, 1, workev, 1, z, ldz)
+ call sger(n, nconv, one, resid, 1, workev, 1, z, ldz)
c
end if
c
diff --git a/SRC/ssapps.f b/SRC/ssapps.f
index b624b31..b1eb5e3 100644
--- a/SRC/ssapps.f
+++ b/SRC/ssapps.f
@@ -111,10 +111,10 @@ c Rice University
c Houston, Texas
c
c\Revision history:
-c 12/16/93: Version ' 2.1'
+c 12/16/93: Version ' 2.4'
c
c\SCCS Information: @(#)
-c FILE: sapps.F SID: 2.5 DATE OF SID: 4/19/96 RELEASE: 2
+c FILE: sapps.F SID: 2.6 DATE OF SID: 3/28/97 RELEASE: 2
c
c\Remarks
c 1. In this version, each shift is applied to all the subblocks of
@@ -372,7 +372,7 @@ c %----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G |
c %----------------------------------------------------%
c
- do 50 j = 1, min( j+jj, kplusp )
+ do 50 j = 1, min( i+jj, kplusp )
a1 = c*q(j,i) + s*q(j,i+1)
q(j,i+1) = - s*q(j,i) + c*q(j,i+1)
q(j,i) = a1
diff --git a/SRC/ssaup2.f b/SRC/ssaup2.f
index ce643dd..42fd768 100644
--- a/SRC/ssaup2.f
+++ b/SRC/ssaup2.f
@@ -170,7 +170,7 @@ c 12/15/93: Version ' 2.4'
c xx/xx/95: Version ' 2.4'. (R.B. Lehoucq)
c
c\SCCS Information: @(#)
-c FILE: saup2.F SID: 2.6 DATE OF SID: 8/16/96 RELEASE: 2
+c FILE: saup2.F SID: 2.7 DATE OF SID: 5/19/98 RELEASE: 2
c
c\EndLib
c
@@ -546,13 +546,13 @@ c %-----------------------------------------------------%
c
wprime = 'SA'
call ssortr (wprime, .true., kplusp, ritz, bounds)
- nevd2 = nev / 2
- nevm2 = nev - nevd2
+ nevd2 = nev0 / 2
+ nevm2 = nev0 - nevd2
if ( nev .gt. 1 ) then
call sswap ( min(nevd2,np), ritz(nevm2+1), 1,
& ritz( max(kplusp-nevd2+1,kplusp-np+1) ), 1)
call sswap ( min(nevd2,np), bounds(nevm2+1), 1,
- & bounds( max(kplusp-nevd2+1,kplusp-np)+1 ), 1)
+ & bounds( max(kplusp-nevd2+1,kplusp-np+1)), 1)
end if
c
else
diff --git a/SRC/ssaupd.f b/SRC/ssaupd.f
index 0fa6a9d..bd4184a 100644
--- a/SRC/ssaupd.f
+++ b/SRC/ssaupd.f
@@ -12,14 +12,14 @@ c few eigenpairs of a linear operator OP that is real and symmetric
c with respect to a real positive semi-definite symmetric matrix B,
c i.e.
c
-c B*OP = (OP')*B.
+c B*OP = (OP`)*B.
c
c Another way to express this condition is
c
-c < x,OPy > = < OPx,y > where < z,w > = z'Bw .
+c < x,OPy > = < OPx,y > where < z,w > = z`Bw .
c
c In the standard eigenproblem B is the identity matrix.
-c ( A' denotes transpose of A)
+c ( A` denotes transpose of A)
c
c The computed approximate eigenvalues are called Ritz values and
c the corresponding approximate eigenvectors are called Ritz vectors.
@@ -120,14 +120,14 @@ c
c NEV Integer. (INPUT)
c Number of eigenvalues of OP to be computed. 0 < NEV < N.
c
-c TOL Real scalar. (INPUT)
+c TOL Real scalar. (INPUT)
c Stopping criterion: the relative accuracy of the Ritz value
c is considered acceptable if BOUNDS(I) .LE. TOL*ABS(RITZ(I)).
c If TOL .LE. 0. is passed a default is set:
c DEFAULT = SLAMCH('EPS') (machine precision as computed
c by the LAPACK auxiliary subroutine SLAMCH).
c
-c RESID Real array of length N. (INPUT/OUTPUT)
+c RESID Real array of length N. (INPUT/OUTPUT)
c On INPUT:
c If INFO .EQ. 0, a random initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
@@ -144,7 +144,7 @@ c NCV-NEV Lanczos vectors at each subsequent update iteration.
c Most of the cost in generating each Lanczos vector is in the
c matrix-vector product OP*x. (See remark 4 below).
c
-c V Real N by NCV array. (OUTPUT)
+c V Real N by NCV array. (OUTPUT)
c The NCV columns of V contain the Lanczos basis vectors.
c
c LDV Integer. (INPUT)
@@ -225,7 +225,7 @@ c of the tridiagonal matrix T. Only referenced by
c sseupd if RVEC = .TRUE. See Remarks.
c -------------------------------------------------------------
c
-c WORKD Real work array of length 3*N. (REVERSE COMMUNICATION)
+c WORKD Real work array of length 3*N. (REVERSE COMMUNICATION)
c Distributed array to be used in the basic Arnoldi iteration
c for reverse communication. The user should not use WORKD
c as temporary workspace during the iteration. Upon termination
@@ -233,7 +233,7 @@ c WORKD(1:N) contains B*RESID(1:N). If the Ritz vectors are desired
c subroutine sseupd uses this output.
c See Data Distribution Note below.
c
-c WORKL Real work array of length LWORKL. (OUTPUT/WORKSPACE)
+c WORKL Real work array of length LWORKL. (OUTPUT/WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end. See Data Distribution Note below.
c
@@ -288,13 +288,13 @@ c 2. If the Ritz vectors corresponding to the converged Ritz values
c are needed, the user must call sseupd immediately following completion
c of ssaupd. This is new starting with version 2.1 of ARPACK.
c
-c 3. If M can be factored into a Cholesky factorization M = LL'
+c 3. If M can be factored into a Cholesky factorization M = LL`
c then Mode = 2 should not be selected. Instead one should use
-c Mode = 1 with OP = inv(L)*A*inv(L'). Appropriate triangular
-c linear systems should be solved with L and L' rather
+c Mode = 1 with OP = inv(L)*A*inv(L`). Appropriate triangular
+c linear systems should be solved with L and L` rather
c than computing inverses. After convergence, an approximate
c eigenvector z of the original problem is recovered by solving
-c L'z = x where x is a Ritz vector of OP.
+c L`z = x where x is a Ritz vector of OP.
c
c 4. At present there is no a-priori analysis to guide the selection
c of NCV relative to NEV. The only formal requrement is that NCV > NEV.
@@ -393,10 +393,10 @@ c Rice University
c Houston, Texas
c
c\Revision history:
-c 12/15/93: Version ' 2.4'
+c 12/15/93: Version ' 2.4'
c
c\SCCS Information: @(#)
-c FILE: saupd.F SID: 2.7 DATE OF SID: 8/27/96 RELEASE: 2
+c FILE: saupd.F SID: 2.8 DATE OF SID: 04/10/01 RELEASE: 2
c
c\Remarks
c 1. None
@@ -422,7 +422,7 @@ c %------------------%
c
character bmat*1, which*2
integer ido, info, ldv, lworkl, n, ncv, nev
- Real
+ Real
& tol
c
c %-----------------%
@@ -430,16 +430,16 @@ c | Array Arguments |
c %-----------------%
c
integer iparam(11), ipntr(11)
- Real
+ Real
& resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
c
c %------------%
c | Parameters |
c %------------%
c
- Real
+ Real
& one, zero
- parameter (one = 1.0E+0, zero = 0.0E+0)
+ parameter (one = 1.0E+0 , zero = 0.0E+0 )
c
c %---------------%
c | Local Scalars |
@@ -462,7 +462,7 @@ c %--------------------%
c | External Functions |
c %--------------------%
c
- Real
+ Real
& slamch
external slamch
c
@@ -484,7 +484,8 @@ c
ierr = 0
ishift = iparam(1)
mxiter = iparam(3)
- nb = iparam(4)
+c nb = iparam(4)
+ nb = 1
c
c %--------------------------------------------%
c | Revision 2 performs only implicit restart. |
@@ -653,8 +654,8 @@ c
1000 format (//,
& 5x, '==========================================',/
& 5x, '= Symmetric implicit Arnoldi update code =',/
- & 5x, '= Version Number:', ' 2.4', 19x, ' =',/
- & 5x, '= Version Date: ', ' 07/31/96', 14x, ' =',/
+ & 5x, '= Version Number:', ' 2.4' , 19x, ' =',/
+ & 5x, '= Version Date: ', ' 07/31/96' , 14x, ' =',/
& 5x, '==========================================',/
& 5x, '= Summary of timing statistics =',/
& 5x, '==========================================',//)
diff --git a/SRC/sseupd.f b/SRC/sseupd.f
index 1271538..91443d7 100644
--- a/SRC/sseupd.f
+++ b/SRC/sseupd.f
@@ -58,13 +58,14 @@ c = 'A': compute NEV Ritz vectors;
c = 'S': compute some of the Ritz vectors, specified
c by the logical array SELECT.
c
-c SELECT Logical array of dimension NEV. (INPUT)
+c SELECT Logical array of dimension NCV. (INPUT/WORKSPACE)
c If HOWMNY = 'S', SELECT specifies the Ritz vectors to be
c computed. To select the Ritz vector corresponding to a
c Ritz value D(j), SELECT(j) must be set to .TRUE..
-c If HOWMNY = 'A' , SELECT is not referenced.
+c If HOWMNY = 'A' , SELECT is used as a workspace for
+c reordering the Ritz values.
c
-c D Real array of dimension NEV. (OUTPUT)
+c D Real array of dimension NEV. (OUTPUT)
c On exit, D contains the Ritz value approximations to the
c eigenvalues of A*z = lambda*B*z. The values are returned
c in ascending order. If IPARAM(7) = 3,4,5 then D represents
@@ -73,7 +74,7 @@ c those of the original eigensystem A*z = lambda*B*z. If
c IPARAM(7) = 1,2 then the Ritz values of OP are the same
c as the those of A*z = lambda*B*z.
c
-c Z Real N by NEV array if HOWMNY = 'A'. (OUTPUT)
+c Z Real N by NEV array if HOWMNY = 'A'. (OUTPUT)
c On exit, Z contains the B-orthonormal Ritz vectors of the
c eigensystem A*z = lambda*B*z corresponding to the Ritz
c value approximations.
@@ -85,13 +86,13 @@ c LDZ Integer. (INPUT)
c The leading dimension of the array Z. If Ritz vectors are
c desired, then LDZ .ge. max( 1, N ). In any case, LDZ .ge. 1.
c
-c SIGMA Real (INPUT)
+c SIGMA Real (INPUT)
c If IPARAM(7) = 3,4,5 represents the shift. Not referenced if
c IPARAM(7) = 1 or 2.
c
c
c **** The remaining arguments MUST be the same as for the ****
-c **** call to SNAUPD that was just completed. ****
+c **** call to SSAUPD that was just completed. ****
c
c NOTE: The remaining arguments
c
@@ -104,7 +105,7 @@ c the the last call to SSAUPD and the call to SSEUPD.
c
c Two of these parameters (WORKL, INFO) are also output parameters:
c
-c WORKL Real work array of length LWORKL. (OUTPUT/WORKSPACE)
+c WORKL Real work array of length LWORKL. (OUTPUT/WORKSPACE)
c WORKL(1:4*ncv) contains information obtained in
c ssaupd. They are not changed by sseupd.
c WORKL(4*ncv+1:ncv*ncv+8*ncv) holds the
@@ -140,6 +141,11 @@ c = -14: SSAUPD did not find any eigenvalues to sufficient
c accuracy.
c = -15: HOWMNY must be one of 'A' or 'S' if RVEC = .true.
c = -16: HOWMNY = 'S' not yet implemented
+c = -17: SSEUPD got a different count of the number of converged
+c Ritz values than SSAUPD got. This indicates the user
+c probably made an error in passing data from SSAUPD to
+c SSEUPD or that the data was modified before entering
+c SSEUPD.
c
c\BeginLib
c
@@ -204,14 +210,17 @@ c\Revision history:
c 12/15/93: Version ' 2.1'
c
c\SCCS Information: @(#)
-c FILE: seupd.F SID: 2.7 DATE OF SID: 8/27/96 RELEASE: 2
+c FILE: seupd.F SID: 2.11 DATE OF SID: 04/10/01 RELEASE: 2
c
c\EndLib
c
c-----------------------------------------------------------------------
- subroutine sseupd (rvec, howmny, select, d, z, ldz, sigma, bmat,
- & n, which, nev, tol, resid, ncv, v, ldv, iparam,
- & ipntr, workd, workl, lworkl, info )
+ subroutine sseupd(rvec , howmny, select, d ,
+ & z , ldz , sigma , bmat ,
+ & n , which , nev , tol ,
+ & resid , ncv , v , ldv ,
+ & iparam, ipntr , workd , workl,
+ & lworkl, info )
c
c %----------------------------------------------------%
c | Include files for debugging and timing information |
@@ -225,9 +234,9 @@ c | Scalar Arguments |
c %------------------%
c
character bmat, howmny, which*2
- logical rvec, select(ncv)
+ logical rvec
integer info, ldz, ldv, lworkl, n, ncv, nev
- Real
+ Real
& sigma, tol
c
c %-----------------%
@@ -235,49 +244,45 @@ c | Array Arguments |
c %-----------------%
c
integer iparam(7), ipntr(11)
- Real
- & d(nev), resid(n), v(ldv,ncv), z(ldz, nev),
- & workd(2*n), workl(lworkl)
+ logical select(ncv)
+ Real
+ & d(nev) , resid(n) , v(ldv,ncv),
+ & z(ldz, nev), workd(2*n), workl(lworkl)
c
c %------------%
c | Parameters |
c %------------%
c
- Real
+ Real
& one, zero
- parameter (one = 1.0E+0, zero = 0.0E+0)
+ parameter (one = 1.0E+0 , zero = 0.0E+0 )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character type*6
- integer bounds, ierr, ih, ihb, ihd, iq, iw, j, k,
- & ldh, ldq, mode, msglvl, nconv, next, ritz,
- & irz, ibd, ktrord, leftptr, rghtptr, ism, ilg
- Real
- & bnorm2, rnorm, temp, thres1, thres2, tempbnd, eps23
- logical reord
-c
-c %--------------%
-c | Local Arrays |
-c %--------------%
-c
+ integer bounds , ierr , ih , ihb , ihd ,
+ & iq , iw , j , k , ldh ,
+ & ldq , mode , msglvl, nconv , next ,
+ & ritz , irz , ibd , np , ishift,
+ & leftptr, rghtptr, numcnv, jj
Real
- & kv(2)
+ & bnorm2 , rnorm, temp, temp1, eps23
+ logical reord
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
- external scopy, sger, sgeqr2, slacpy, sorm2r, sscal,
- & ssesrt, ssteqr, sswap, svout, ivout, ssortr
+ external scopy , sger , sgeqr2, slacpy, sorm2r, sscal,
+ & ssesrt, ssteqr, sswap , svout , ivout , ssortr
c
c %--------------------%
c | External Functions |
c %--------------------%
c
- Real
+ Real
& snrm2, slamch
external snrm2, slamch
c
@@ -423,7 +428,7 @@ c | Set machine dependent constant. |
c %---------------------------------%
c
eps23 = slamch('Epsilon-Machine')
- eps23 = eps23**(2.0E+0 / 3.0E+0)
+ eps23 = eps23**(2.0E+0 / 3.0E+0 )
c
c %---------------------------------------%
c | RNORM is B-norm of the RESID(1:N). |
@@ -439,154 +444,97 @@ c
bnorm2 = snrm2(n, workd, 1)
end if
c
+ if (msglvl .gt. 2) then
+ call svout(logfil, ncv, workl(irz), ndigit,
+ & '_seupd: Ritz values passed in from _SAUPD.')
+ call svout(logfil, ncv, workl(ibd), ndigit,
+ & '_seupd: Ritz estimates passed in from _SAUPD.')
+ end if
+c
if (rvec) then
c
-c %------------------------------------------------%
-c | Get the converged Ritz value on the boundary. |
-c | This value will be used to dermine whether we |
-c | need to reorder the eigenvalues and |
-c | eigenvectors comupted by _steqr, and is |
-c | referred to as the "threshold" value. |
-c | |
-c | A Ritz value gamma is said to be a wanted |
-c | one, if |
-c | abs(gamma) .ge. threshold, when WHICH = 'LM'; |
-c | abs(gamma) .le. threshold, when WHICH = 'SM'; |
-c | gamma .ge. threshold, when WHICH = 'LA'; |
-c | gamma .le. threshold, when WHICH = 'SA'; |
-c | gamma .le. thres1 .or. gamma .ge. thres2 |
-c | when WHICH = 'BE'; |
-c | |
-c | Note: converged Ritz values and associated |
-c | Ritz estimates have been placed in the first |
-c | NCONV locations in workl(ritz) and |
-c | workl(bounds) respectively. They have been |
-c | sorted (in _saup2) according to the WHICH |
-c | selection criterion. (Except in the case |
-c | WHICH = 'BE', they are sorted in an increasing |
-c | order.) |
-c %------------------------------------------------%
-c
- if (which .eq. 'LM' .or. which .eq. 'SM'
- & .or. which .eq. 'LA' .or. which .eq. 'SA' ) then
-c
- thres1 = workl(ritz)
-c
- if (msglvl .gt. 2) then
- call svout(logfil, 1, thres1, ndigit,
- & '_seupd: Threshold eigenvalue used for re-ordering')
- end if
-c
- else if (which .eq. 'BE') then
-c
-c %------------------------------------------------%
-c | Ritz values returned from _saup2 have been |
-c | sorted in increasing order. Thus two |
-c | "threshold" values (one for the small end, one |
-c | for the large end) are in the middle. |
-c %------------------------------------------------%
-c
- ism = max(nev,nconv) / 2
- ilg = ism + 1
- thres1 = workl(ism)
- thres2 = workl(ilg)
-c
- if (msglvl .gt. 2) then
- kv(1) = thres1
- kv(2) = thres2
- call svout(logfil, 2, kv, ndigit,
- & '_seupd: Threshold eigenvalues used for re-ordering')
- end if
+ reord = .false.
c
+c %---------------------------------------------------%
+c | Use the temporary bounds array to store indices |
+c | These will be used to mark the select array later |
+c %---------------------------------------------------%
+c
+ do 10 j = 1,ncv
+ workl(bounds+j-1) = j
+ select(j) = .false.
+ 10 continue
+c
+c %-------------------------------------%
+c | Select the wanted Ritz values. |
+c | Sort the Ritz values so that the |
+c | wanted ones appear at the tailing |
+c | NEV positions of workl(irr) and |
+c | workl(iri). Move the corresponding |
+c | error estimates in workl(bound) |
+c | accordingly. |
+c %-------------------------------------%
+c
+ np = ncv - nev
+ ishift = 0
+ call ssgets(ishift, which , nev ,
+ & np , workl(irz) , workl(bounds),
+ & workl)
+c
+ if (msglvl .gt. 2) then
+ call svout(logfil, ncv, workl(irz), ndigit,
+ & '_seupd: Ritz values after calling _SGETS.')
+ call svout(logfil, ncv, workl(bounds), ndigit,
+ & '_seupd: Ritz value indices after calling _SGETS.')
end if
c
-c %----------------------------------------------------------%
-c | Check to see if all converged Ritz values appear within |
-c | the first NCONV diagonal elements returned from _seigt. |
-c | This is done in the following way: |
-c | |
-c | 1) For each Ritz value obtained from _seigt, compare it |
-c | with the threshold Ritz value computed above to |
-c | determine whether it is a wanted one. |
-c | |
-c | 2) If it is wanted, then check the corresponding Ritz |
-c | estimate to see if it has converged. If it has, set |
-c | correponding entry in the logical array SELECT to |
-c | .TRUE.. |
-c | |
-c | If SELECT(j) = .TRUE. and j > NCONV, then there is a |
-c | converged Ritz value that does not appear at the top of |
-c | the diagonal matrix computed by _seigt in _saup2. |
-c | Reordering is needed. |
-c %----------------------------------------------------------%
+c %-----------------------------------------------------%
+c | Record indices of the converged wanted Ritz values |
+c | Mark the select array for possible reordering |
+c %-----------------------------------------------------%
c
- reord = .false.
- ktrord = 0
- do 10 j = 0, ncv-1
- select(j+1) = .false.
- if (which .eq. 'LM') then
- if (abs(workl(irz+j)) .ge. abs(thres1)) then
- tempbnd = max( eps23, abs(workl(irz+j)) )
- if (workl(ibd+j) .le. tol*tempbnd) then
- select(j+1) = .true.
- end if
- end if
- else if (which .eq. 'SM') then
- if (abs(workl(irz+j)) .le. abs(thres1)) then
- tempbnd = max( eps23, abs(workl(irz+j)) )
- if (workl(ibd+j) .le. tol*tempbnd) then
- select(j+1) = .true.
- end if
- end if
- else if (which .eq. 'LA') then
- if (workl(irz+j) .ge. thres1) then
- tempbnd = max( eps23, abs(workl(irz+j)) )
- if (workl(ibd+j) .le. tol*tempbnd) then
- select(j+1) = .true.
- end if
- end if
- else if (which .eq. 'SA') then
- if (workl(irz+j) .le. thres1) then
- tempbnd = max( eps23, abs(workl(irz+j)) )
- if (workl(ibd+j) .le. tol*tempbnd) then
- select(j+1) = .true.
- end if
- end if
- else if (which .eq. 'BE') then
- if ( workl(irz+j) .le. thres1 .or.
- & workl(irz+j) .ge. thres2 ) then
- tempbnd = max( eps23, abs(workl(irz+j)) )
- if (workl(ibd+j) .le. tol*tempbnd) then
- select(j+1) = .true.
- end if
- end if
- end if
- if (j+1 .gt. nconv ) reord = select(j+1) .or. reord
- if (select(j+1)) ktrord = ktrord + 1
- 10 continue
-
-c %-------------------------------------------%
-c | If KTRORD .ne. NCONV, something is wrong. |
-c %-------------------------------------------%
+ numcnv = 0
+ do 11 j = 1,ncv
+ temp1 = max(eps23, abs(workl(irz+ncv-j)) )
+ jj = workl(bounds + ncv - j)
+ if (numcnv .lt. nconv .and.
+ & workl(ibd+jj-1) .le. tol*temp1) then
+ select(jj) = .true.
+ numcnv = numcnv + 1
+ if (jj .gt. nev) reord = .true.
+ endif
+ 11 continue
+c
+c %-----------------------------------------------------------%
+c | Check the count (numcnv) of converged Ritz values with |
+c | the number (nconv) reported by _saupd. If these two |
+c | are different then there has probably been an error |
+c | caused by incorrect passing of the _saupd data. |
+c %-----------------------------------------------------------%
c
if (msglvl .gt. 2) then
- call ivout(logfil, 1, ktrord, ndigit,
+ call ivout(logfil, 1, numcnv, ndigit,
& '_seupd: Number of specified eigenvalues')
call ivout(logfil, 1, nconv, ndigit,
& '_seupd: Number of "converged" eigenvalues')
end if
c
+ if (numcnv .ne. nconv) then
+ info = -17
+ go to 9000
+ end if
+c
c %-----------------------------------------------------------%
c | Call LAPACK routine _steqr to compute the eigenvalues and |
c | eigenvectors of the final symmetric tridiagonal matrix H. |
c | Initialize the eigenvector matrix Q to the identity. |
c %-----------------------------------------------------------%
c
- call scopy (ncv-1, workl(ih+1), 1, workl(ihb), 1)
- call scopy (ncv, workl(ih+ldh), 1, workl(ihd), 1)
+ call scopy(ncv-1, workl(ih+1), 1, workl(ihb), 1)
+ call scopy(ncv, workl(ih+ldh), 1, workl(ihd), 1)
c
- call ssteqr ('Identity', ncv, workl(ihd), workl(ihb),
- & workl(iq), ldq, workl(iw), ierr)
+ call ssteqr('Identity', ncv, workl(ihd), workl(ihb),
+ & workl(iq) , ldq, workl(iw), ierr)
c
if (ierr .ne. 0) then
info = -8
@@ -594,10 +542,10 @@ c
end if
c
if (msglvl .gt. 1) then
- call scopy (ncv, workl(iq+ncv-1), ldq, workl(iw), 1)
- call svout (logfil, ncv, workl(ihd), ndigit,
+ call scopy(ncv, workl(iq+ncv-1), ldq, workl(iw), 1)
+ call svout(logfil, ncv, workl(ihd), ndigit,
& '_seupd: NCV Ritz values of the final H matrix')
- call svout (logfil, ncv, workl(iw), ndigit,
+ call svout(logfil, ncv, workl(iw), ndigit,
& '_seupd: last row of the eigenvector matrix for H')
end if
c
@@ -680,8 +628,8 @@ c %-----------------------------------------------------%
c | Ritz vectors not required. Load Ritz values into D. |
c %-----------------------------------------------------%
c
- call scopy (nconv, workl(ritz), 1, d, 1)
- call scopy (ncv, workl(ritz), 1, workl(ihd), 1)
+ call scopy(nconv, workl(ritz), 1, d, 1)
+ call scopy(ncv, workl(ritz), 1, workl(ihd), 1)
c
end if
c
@@ -699,9 +647,9 @@ c | bounds. Not necessary if only Ritz values are desired. |
c %---------------------------------------------------------%
c
if (rvec) then
- call ssesrt ('LA', rvec , nconv, d, ncv, workl(iq), ldq)
+ call ssesrt('LA', rvec , nconv, d, ncv, workl(iq), ldq)
else
- call scopy (ncv, workl(bounds), 1, workl(ihb), 1)
+ call scopy(ncv, workl(bounds), 1, workl(ihb), 1)
end if
c
else
@@ -742,25 +690,25 @@ c %-------------------------------------------------------------%
c | * Store the wanted NCONV lambda values into D. |
c | * Sort the NCONV wanted lambda in WORKL(IHD:IHD+NCONV-1) |
c | into ascending order and apply sort to the NCONV theta |
-c | values in the transformed system. We'll need this to |
+c | values in the transformed system. We will need this to |
c | compute Ritz estimates in the original system. |
-c | * Finally sort the lambda's into ascending order and apply |
-c | to Ritz vectors if wanted. Else just sort lambda's into |
+c | * Finally sort the lambda`s into ascending order and apply |
+c | to Ritz vectors if wanted. Else just sort lambda`s into |
c | ascending order. |
c | NOTES: |
c | *workl(iw:iw+ncv-1) contain the theta ordered so that they |
-c | match the ordering of the lambda. We'll use them again for |
+c | match the ordering of the lambda. We`ll use them again for |
c | Ritz vector purification. |
c %-------------------------------------------------------------%
c
- call scopy (nconv, workl(ihd), 1, d, 1)
- call ssortr ('LA', .true., nconv, workl(ihd), workl(iw))
+ call scopy(nconv, workl(ihd), 1, d, 1)
+ call ssortr('LA', .true., nconv, workl(ihd), workl(iw))
if (rvec) then
- call ssesrt ('LA', rvec , nconv, d, ncv, workl(iq), ldq)
+ call ssesrt('LA', rvec , nconv, d, ncv, workl(iq), ldq)
else
- call scopy (ncv, workl(bounds), 1, workl(ihb), 1)
- call sscal (ncv, bnorm2/rnorm, workl(ihb), 1)
- call ssortr ('LA', .true., nconv, d, workl(ihb))
+ call scopy(ncv, workl(bounds), 1, workl(ihb), 1)
+ call sscal(ncv, bnorm2/rnorm, workl(ihb), 1)
+ call ssortr('LA', .true., nconv, d, workl(ihb))
end if
c
end if
@@ -779,10 +727,10 @@ c | the wanted invariant subspace located in the first NCONV |
c | columns of workl(iq,ldq). |
c %----------------------------------------------------------%
c
- call sgeqr2 (ncv, nconv, workl(iq), ldq, workl(iw+ncv),
- & workl(ihb), ierr)
+ call sgeqr2(ncv, nconv , workl(iq) ,
+ & ldq, workl(iw+ncv), workl(ihb),
+ & ierr)
c
-c
c %--------------------------------------------------------%
c | * Postmultiply V by Q. |
c | * Copy the first NCONV columns of VQ into Z. |
@@ -791,22 +739,26 @@ c | of the approximate invariant subspace associated with |
c | the Ritz values in workl(ihd). |
c %--------------------------------------------------------%
c
- call sorm2r ('Right', 'Notranspose', n, ncv, nconv, workl(iq),
- & ldq, workl(iw+ncv), v, ldv, workd(n+1), ierr)
- call slacpy ('All', n, nconv, v, ldv, z, ldz)
+ call sorm2r('Right', 'Notranspose', n ,
+ & ncv , nconv , workl(iq),
+ & ldq , workl(iw+ncv), v ,
+ & ldv , workd(n+1) , ierr)
+ call slacpy('All', n, nconv, v, ldv, z, ldz)
c
c %-----------------------------------------------------%
c | In order to compute the Ritz estimates for the Ritz |
c | values in both systems, need the last row of the |
-c | eigenvector matrix. Remember, it's in factored form |
+c | eigenvector matrix. Remember, it`s in factored form |
c %-----------------------------------------------------%
c
do 65 j = 1, ncv-1
workl(ihb+j-1) = zero
65 continue
workl(ihb+ncv-1) = one
- call sorm2r ('Left', 'Transpose', ncv, 1, nconv, workl(iq),
- & ldq, workl(iw+ncv), workl(ihb), ncv, temp, ierr)
+ call sorm2r('Left', 'Transpose' , ncv ,
+ & 1 , nconv , workl(iq) ,
+ & ldq , workl(iw+ncv), workl(ihb),
+ & ncv , temp , ierr)
c
else if (rvec .and. howmny .eq. 'S') then
c
@@ -835,21 +787,22 @@ c
if (type .eq. 'SHIFTI') then
c
do 80 k=1, ncv
- workl(ihb+k-1) = abs( workl(ihb+k-1) ) / workl(iw+k-1)**2
+ workl(ihb+k-1) = abs( workl(ihb+k-1) )
+ & / workl(iw+k-1)**2
80 continue
c
else if (type .eq. 'BUCKLE') then
c
do 90 k=1, ncv
- workl(ihb+k-1) = sigma * abs( workl(ihb+k-1) ) /
- & ( workl(iw+k-1)-one )**2
+ workl(ihb+k-1) = sigma * abs( workl(ihb+k-1) )
+ & / (workl(iw+k-1)-one )**2
90 continue
c
else if (type .eq. 'CAYLEY') then
c
do 100 k=1, ncv
- workl(ihb+k-1) = abs( workl(ihb+k-1) /
- & workl(iw+k-1)*(workl(iw+k-1)-one) )
+ workl(ihb+k-1) = abs( workl(ihb+k-1)
+ & / workl(iw+k-1)*(workl(iw+k-1)-one) )
100 continue
c
end if
@@ -857,14 +810,14 @@ c
end if
c
if (type .ne. 'REGULR' .and. msglvl .gt. 1) then
- call svout (logfil, nconv, d, ndigit,
+ call svout(logfil, nconv, d, ndigit,
& '_seupd: Untransformed converged Ritz values')
- call svout (logfil, nconv, workl(ihb), ndigit,
+ call svout(logfil, nconv, workl(ihb), ndigit,
& '_seupd: Ritz estimates of the untransformed Ritz values')
else if (msglvl .gt. 1) then
- call svout (logfil, nconv, d, ndigit,
+ call svout(logfil, nconv, d, ndigit,
& '_seupd: Converged Ritz values')
- call svout (logfil, nconv, workl(ihb), ndigit,
+ call svout(logfil, nconv, workl(ihb), ndigit,
& '_seupd: Associated Ritz estimates')
end if
c
@@ -877,13 +830,15 @@ c
if (rvec .and. (type .eq. 'SHIFTI' .or. type .eq. 'CAYLEY')) then
c
do 110 k=0, nconv-1
- workl(iw+k) = workl(iq+k*ldq+ncv-1) / workl(iw+k)
+ workl(iw+k) = workl(iq+k*ldq+ncv-1)
+ & / workl(iw+k)
110 continue
c
else if (rvec .and. type .eq. 'BUCKLE') then
c
do 120 k=0, nconv-1
- workl(iw+k) = workl(iq+k*ldq+ncv-1) / (workl(iw+k)-one)
+ workl(iw+k) = workl(iq+k*ldq+ncv-1)
+ & / (workl(iw+k)-one)
120 continue
c
end if
@@ -896,7 +851,7 @@ c
return
c
c %---------------%
-c | End of sseupd |
+c | End of sseupd|
c %---------------%
c
end
diff --git a/SRC/zgetv0.f b/SRC/zgetv0.f
index 8b6a954..961241b 100644
--- a/SRC/zgetv0.f
+++ b/SRC/zgetv0.f
@@ -106,7 +106,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: getv0.F SID: 2.3 DATE OF SID: 8/27/96 RELEASE: 2
+c FILE: getv0.F SID: 2.3 DATE OF SID: 08/27/96 RELEASE: 2
c
c\EndLib
c
diff --git a/SRC/znapps.f b/SRC/znapps.f
index a03057e..95bbce4 100644
--- a/SRC/znapps.f
+++ b/SRC/znapps.f
@@ -117,7 +117,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: napps.F SID: 2.2 DATE OF SID: 4/20/96 RELEASE: 2
+c FILE: napps.F SID: 2.3 DATE OF SID: 3/28/97 RELEASE: 2
c
c\Remarks
c 1. In this version, each shift is applied to all the sublocks of
@@ -362,7 +362,7 @@ c %-----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G' |
c %-----------------------------------------------------%
c
- do 70 j = 1, min(j+jj, kplusp)
+ do 70 j = 1, min(i+jj, kplusp)
t = c*q(j,i) + conjg(s)*q(j,i+1)
q(j,i+1) = - s*q(j,i) + c*q(j,i+1)
q(j,i) = t
diff --git a/SRC/znaup2.f b/SRC/znaup2.f
index 39522db..b862f68 100644
--- a/SRC/znaup2.f
+++ b/SRC/znaup2.f
@@ -1,20 +1,20 @@
c\BeginDoc
c
-c\Name: znaup2
+c\Name: znaup2
c
c\Description:
-c Intermediate level interface called by znaupd.
+c Intermediate level interface called by znaupd .
c
c\Usage:
-c call znaup2
+c call znaup2
c ( IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD,
c ISHIFT, MXITER, V, LDV, H, LDH, RITZ, BOUNDS,
c Q, LDQ, WORKL, IPNTR, WORKD, RWORK, INFO )
c
c\Arguments
c
-c IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in znaupd.
-c MODE, ISHIFT, MXITER: see the definition of IPARAM in znaupd.
+c IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in znaupd .
+c MODE, ISHIFT, MXITER: see the definition of IPARAM in znaupd .
c
c NP Integer. (INPUT/OUTPUT)
c Contains the number of implicit shifts to apply during
@@ -37,7 +37,7 @@ c IUPD Integer. (INPUT)
c IUPD .EQ. 0: use explicit restart instead implicit update.
c IUPD .NE. 0: use implicit update.
c
-c V Complex*16 N by (NEV+NP) array. (INPUT/OUTPUT)
+c V Complex*16 N by (NEV+NP) array. (INPUT/OUTPUT)
c The Arnoldi basis vectors are returned in the first NEV
c columns of V.
c
@@ -45,21 +45,21 @@ c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
-c H Complex*16 (NEV+NP) by (NEV+NP) array. (OUTPUT)
+c H Complex*16 (NEV+NP) by (NEV+NP) array. (OUTPUT)
c H is used to store the generated upper Hessenberg matrix
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
-c RITZ Complex*16 array of length NEV+NP. (OUTPUT)
+c RITZ Complex*16 array of length NEV+NP. (OUTPUT)
c RITZ(1:NEV) contains the computed Ritz values of OP.
c
-c BOUNDS Complex*16 array of length NEV+NP. (OUTPUT)
+c BOUNDS Complex*16 array of length NEV+NP. (OUTPUT)
c BOUNDS(1:NEV) contain the error bounds corresponding to
c the computed Ritz values.
c
-c Q Complex*16 (NEV+NP) by (NEV+NP) array. (WORKSPACE)
+c Q Complex*16 (NEV+NP) by (NEV+NP) array. (WORKSPACE)
c Private (replicated) work array used to accumulate the
c rotation in the shift application step.
c
@@ -67,7 +67,7 @@ c LDQ Integer. (INPUT)
c Leading dimension of Q exactly as declared in the calling
c program.
c
-c WORKL Complex*16 work array of length at least
+c WORKL Complex*16 work array of length at least
c (NEV+NP)**2 + 3*(NEV+NP). (WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end. It is used in shifts calculation, shifts
@@ -84,13 +84,13 @@ c IPNTR(3): pointer to the vector B * X when used in the
c shift-and-invert mode. X is the current operand.
c -------------------------------------------------------------
c
-c WORKD Complex*16 work array of length 3*N. (WORKSPACE)
+c WORKD Complex*16 work array of length 3*N. (WORKSPACE)
c Distributed array to be used in the basic Arnoldi iteration
c for reverse communication. The user should not use WORKD
c as temporary workspace during the iteration !!!!!!!!!!
-c See Data Distribution Note in ZNAUPD.
+c See Data Distribution Note in ZNAUPD .
c
-c RWORK Double precision work array of length NEV+NP ( WORKSPACE)
+c RWORK Double precision work array of length NEV+NP ( WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end.
c
@@ -117,7 +117,7 @@ c
c\BeginLib
c
c\Local variables:
-c xxxxxx Complex*16
+c xxxxxx Complex*16
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
@@ -128,23 +128,23 @@ c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
-c zgetv0 ARPACK initial vector generation routine.
-c znaitr ARPACK Arnoldi factorization routine.
-c znapps ARPACK application of implicit shifts routine.
-c zneigh ARPACK compute Ritz values and error bounds routine.
-c zngets ARPACK reorder Ritz values and error bounds routine.
-c zsortc ARPACK sorting routine.
+c zgetv0 ARPACK initial vector generation routine.
+c znaitr ARPACK Arnoldi factorization routine.
+c znapps ARPACK application of implicit shifts routine.
+c zneigh ARPACK compute Ritz values and error bounds routine.
+c zngets ARPACK reorder Ritz values and error bounds routine.
+c zsortc ARPACK sorting routine.
c ivout ARPACK utility routine that prints integers.
c second ARPACK utility routine for timing.
-c zmout ARPACK utility routine that prints matrices
-c zvout ARPACK utility routine that prints vectors.
-c dvout ARPACK utility routine that prints vectors.
-c dlamch LAPACK routine that determines machine constants.
-c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
-c zcopy Level 1 BLAS that copies one vector to another .
-c zdotc Level 1 BLAS that computes the scalar product of two vectors.
-c zswap Level 1 BLAS that swaps two vectors.
-c dznrm2 Level 1 BLAS that computes the norm of a vector.
+c zmout ARPACK utility routine that prints matrices
+c zvout ARPACK utility routine that prints vectors.
+c dvout ARPACK utility routine that prints vectors.
+c dlamch LAPACK routine that determines machine constants.
+c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
+c zcopy Level 1 BLAS that copies one vector to another .
+c zdotc Level 1 BLAS that computes the scalar product of two vectors.
+c zswap Level 1 BLAS that swaps two vectors.
+c dznrm2 Level 1 BLAS that computes the norm of a vector.
c
c\Author
c Danny Sorensen Phuong Vu
@@ -156,7 +156,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: naup2.F SID: 2.5 DATE OF SID: 8/16/96 RELEASE: 2
+c FILE: naup2.F SID: 2.6 DATE OF SID: 06/01/00 RELEASE: 2
c
c\Remarks
c 1. None
@@ -165,7 +165,7 @@ c\EndLib
c
c-----------------------------------------------------------------------
c
- subroutine znaup2
+ subroutine znaup2
& ( ido, bmat, n, which, nev, np, tol, resid, mode, iupd,
& ishift, mxiter, v, ldv, h, ldh, ritz, bounds,
& q, ldq, workl, ipntr, workd, rwork, info )
@@ -184,7 +184,7 @@ c
character bmat*1, which*2
integer ido, info, ishift, iupd, mode, ldh, ldq, ldv, mxiter,
& n, nev, np
- Double precision
+ Double precision
& tol
c
c %-----------------%
@@ -192,40 +192,41 @@ c | Array Arguments |
c %-----------------%
c
integer ipntr(13)
- Complex*16
+ Complex*16
& bounds(nev+np), h(ldh,nev+np), q(ldq,nev+np),
& resid(n), ritz(nev+np), v(ldv,nev+np),
& workd(3*n), workl( (nev+np)*(nev+np+3) )
- Double precision
+ Double precision
& rwork(nev+np)
c
c %------------%
c | Parameters |
c %------------%
c
- Complex*16
+ Complex*16
& one, zero
- Double precision
+ Double precision
& rzero
- parameter (one = (1.0D+0, 0.0D+0), zero = (0.0D+0, 0.0D+0),
- & rzero = 0.0D+0)
+ parameter (one = (1.0D+0, 0.0D+0) , zero = (0.0D+0, 0.0D+0) ,
+ & rzero = 0.0D+0 )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
- logical cnorm, getv0, initv, update, ushift
- integer ierr, iter, i, j, kplusp, msglvl, nconv, nevbef, nev0,
- & np0, nptemp
- Complex*16
+ logical cnorm , getv0, initv , update, ushift
+ integer ierr , iter , kplusp, msglvl, nconv,
+ & nevbef, nev0 , np0 , nptemp, i ,
+ & j
+ Complex*16
& cmpnorm
- Double precision
- & rtemp, eps23, rnorm
+ Double precision
+ & rnorm , eps23, rtemp
character wprime*2
c
- save cnorm, getv0, initv, update, ushift,
- & iter, kplusp, msglvl, nconv, nev0, np0,
- & eps23
+ save cnorm, getv0, initv , update, ushift,
+ & rnorm, iter , kplusp, msglvl, nconv ,
+ & nevbef, nev0 , np0 , eps23
c
c
c %-----------------------%
@@ -238,24 +239,24 @@ c %----------------------%
c | External Subroutines |
c %----------------------%
c
- external zcopy, zgetv0, znaitr, zneigh, zngets, znapps,
- & zsortc, zswap, zmout, zvout, ivout, second
+ external zcopy , zgetv0 , znaitr , zneigh , zngets , znapps ,
+ & zsortc , zswap , zmout , zvout , ivout, second
c
c %--------------------%
c | External functions |
c %--------------------%
c
- Complex*16
- & zdotc
- Double precision
- & dznrm2, dlamch, dlapy2
- external zdotc, dznrm2, dlamch, dlapy2
+ Complex*16
+ & zdotc
+ Double precision
+ & dznrm2 , dlamch , dlapy2
+ external zdotc , dznrm2 , dlamch , dlapy2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
- intrinsic dimag, dble, min, max
+ intrinsic dimag , dble , min, max
c
c %-----------------------%
c | Executable Statements |
@@ -287,8 +288,8 @@ c %---------------------------------%
c | Get machine dependent constant. |
c %---------------------------------%
c
- eps23 = dlamch('Epsilon-Machine')
- eps23 = eps23**(2.0D+0 / 3.0D+0)
+ eps23 = dlamch ('Epsilon-Machine')
+ eps23 = eps23**(2.0D+0 / 3.0D+0 )
c
c %---------------------------------------%
c | Set flags for computing the first NEV |
@@ -321,7 +322,7 @@ c
10 continue
c
if (getv0) then
- call zgetv0 (ido, bmat, 1, initv, n, 1, v, ldv, resid, rnorm,
+ call zgetv0 (ido, bmat, 1, initv, n, 1, v, ldv, resid, rnorm,
& ipntr, workd, info)
c
if (ido .ne. 99) go to 9000
@@ -363,7 +364,7 @@ c %----------------------------------------------------------%
c | Compute the first NEV steps of the Arnoldi factorization |
c %----------------------------------------------------------%
c
- call znaitr (ido, bmat, n, 0, nev, mode, resid, rnorm, v, ldv,
+ call znaitr (ido, bmat, n, 0, nev, mode, resid, rnorm, v, ldv,
& h, ldh, ipntr, workd, info)
c
if (ido .ne. 99) go to 9000
@@ -395,7 +396,7 @@ c
c %-----------------------------------------------------------%
c | Compute NP additional steps of the Arnoldi factorization. |
c | Adjust NP since NEV might have been updated by last call |
-c | to the shift application routine znapps. |
+c | to the shift application routine znapps . |
c %-----------------------------------------------------------%
c
np = kplusp - nev
@@ -415,8 +416,8 @@ c
20 continue
update = .true.
c
- call znaitr (ido, bmat, n, nev, np, mode, resid, rnorm, v, ldv,
- & h, ldh, ipntr, workd, info)
+ call znaitr (ido, bmat, n, nev, np, mode, resid, rnorm,
+ & v , ldv , h, ldh, ipntr, workd, info)
c
if (ido .ne. 99) go to 9000
c
@@ -429,7 +430,7 @@ c
update = .false.
c
if (msglvl .gt. 1) then
- call dvout (logfil, 1, rnorm, ndigit,
+ call dvout (logfil, 1, rnorm, ndigit,
& '_naup2: Corresponding B-norm of the residual')
end if
c
@@ -438,7 +439,7 @@ c | Compute the eigenvalues and corresponding error bounds |
c | of the current upper Hessenberg matrix. |
c %--------------------------------------------------------%
c
- call zneigh (rnorm, kplusp, h, ldh, ritz, bounds,
+ call zneigh (rnorm, kplusp, h, ldh, ritz, bounds,
& q, ldq, workl, rwork, ierr)
c
if (ierr .ne. 0) then
@@ -459,11 +460,11 @@ c
c
c %--------------------------------------------------%
c | Make a copy of Ritz values and the corresponding |
-c | Ritz estimates obtained from zneigh. |
+c | Ritz estimates obtained from zneigh . |
c %--------------------------------------------------%
c
- call zcopy(kplusp,ritz,1,workl(kplusp**2+1),1)
- call zcopy(kplusp,bounds,1,workl(kplusp**2+kplusp+1),1)
+ call zcopy (kplusp,ritz,1,workl(kplusp**2+1),1)
+ call zcopy (kplusp,bounds,1,workl(kplusp**2+kplusp+1),1)
c
c %---------------------------------------------------%
c | Select the wanted Ritz values and their bounds |
@@ -473,7 +474,7 @@ c | bounds are in the last NEV loc. of RITZ |
c | BOUNDS respectively. |
c %---------------------------------------------------%
c
- call zngets (ishift, which, nev, np, ritz, bounds)
+ call zngets (ishift, which, nev, np, ritz, bounds)
c
c %------------------------------------------------------------%
c | Convergence test: currently we use the following criteria. |
@@ -487,9 +488,9 @@ c
nconv = 0
c
do 25 i = 1, nev
- rtemp = max( eps23, dlapy2( dble(ritz(np+i)),
- & dimag(ritz(np+i)) ) )
- if ( dlapy2(dble(bounds(np+i)),dimag(bounds(np+i)))
+ rtemp = max( eps23, dlapy2 ( dble (ritz(np+i)),
+ & dimag (ritz(np+i)) ) )
+ if ( dlapy2 (dble (bounds(np+i)),dimag (bounds(np+i)))
& .le. tol*rtemp ) then
nconv = nconv + 1
end if
@@ -501,9 +502,9 @@ c
kp(3) = nconv
call ivout (logfil, 3, kp, ndigit,
& '_naup2: NEV, NP, NCONV are')
- call zvout (logfil, kplusp, ritz, ndigit,
+ call zvout (logfil, kplusp, ritz, ndigit,
& '_naup2: The eigenvalues of H')
- call zvout (logfil, kplusp, bounds, ndigit,
+ call zvout (logfil, kplusp, bounds, ndigit,
& '_naup2: Ritz estimates of the current NCV Ritz values')
end if
c
@@ -530,9 +531,9 @@ c
& (np .eq. 0) ) then
c
if (msglvl .gt. 4) then
- call zvout(logfil, kplusp, workl(kplusp**2+1), ndigit,
+ call zvout (logfil, kplusp, workl(kplusp**2+1), ndigit,
& '_naup2: Eigenvalues computed by _neigh:')
- call zvout(logfil, kplusp, workl(kplusp**2+kplusp+1),
+ call zvout (logfil, kplusp, workl(kplusp**2+kplusp+1),
& ndigit,
& '_naup2: Ritz estimates computed by _neigh:')
end if
@@ -546,10 +547,10 @@ c %------------------------------------------------%
c
c %------------------------------------------%
c | Use h( 3,1 ) as storage to communicate |
-c | rnorm to zneupd if needed |
+c | rnorm to zneupd if needed |
c %------------------------------------------%
- h(3,1) = dcmplx(rnorm,rzero)
+ h(3,1) = dcmplx (rnorm,rzero)
c
c %----------------------------------------------%
c | Sort Ritz values so that converged Ritz |
@@ -565,7 +566,7 @@ c
if (which .eq. 'LI') wprime = 'SI'
if (which .eq. 'SI') wprime = 'LI'
c
- call zsortc(wprime, .true., kplusp, ritz, bounds)
+ call zsortc (wprime, .true., kplusp, ritz, bounds)
c
c %--------------------------------------------------%
c | Scale the Ritz estimate of each Ritz value |
@@ -573,8 +574,8 @@ c | by 1 / max(eps23, magnitude of the Ritz value). |
c %--------------------------------------------------%
c
do 35 j = 1, nev0
- rtemp = max( eps23, dlapy2( dble(ritz(j)),
- & dimag(ritz(j)) ) )
+ rtemp = max( eps23, dlapy2 ( dble (ritz(j)),
+ & dimag (ritz(j)) ) )
bounds(j) = bounds(j)/rtemp
35 continue
c
@@ -586,7 +587,7 @@ c | when NCONV < NEV.) |
c %---------------------------------------------------%
c
wprime = 'LM'
- call zsortc(wprime, .true., nev0, bounds, ritz)
+ call zsortc (wprime, .true., nev0, bounds, ritz)
c
c %----------------------------------------------%
c | Scale the Ritz estimate back to its original |
@@ -594,8 +595,8 @@ c | value. |
c %----------------------------------------------%
c
do 40 j = 1, nev0
- rtemp = max( eps23, dlapy2( dble(ritz(j)),
- & dimag(ritz(j)) ) )
+ rtemp = max( eps23, dlapy2 ( dble (ritz(j)),
+ & dimag (ritz(j)) ) )
bounds(j) = bounds(j)*rtemp
40 continue
c
@@ -605,12 +606,12 @@ c | the "threshold" value appears at the front of |
c | ritz and bound. |
c %-----------------------------------------------%
c
- call zsortc(which, .true., nconv, ritz, bounds)
+ call zsortc (which, .true., nconv, ritz, bounds)
c
if (msglvl .gt. 1) then
- call zvout (logfil, kplusp, ritz, ndigit,
+ call zvout (logfil, kplusp, ritz, ndigit,
& '_naup2: Sorted eigenvalues')
- call zvout (logfil, kplusp, bounds, ndigit,
+ call zvout (logfil, kplusp, bounds, ndigit,
& '_naup2: Sorted ritz estimates.')
end if
c
@@ -652,7 +653,7 @@ c | resort the eigenvalues. |
c %---------------------------------------%
c
if (nevbef .lt. nev)
- & call zngets (ishift, which, nev, np, ritz, bounds)
+ & call zngets (ishift, which, nev, np, ritz, bounds)
c
end if
c
@@ -664,9 +665,9 @@ c
kp(2) = np
call ivout (logfil, 2, kp, ndigit,
& '_naup2: NEV and NP are')
- call zvout (logfil, nev, ritz(np+1), ndigit,
+ call zvout (logfil, nev, ritz(np+1), ndigit,
& '_naup2: "wanted" Ritz values ')
- call zvout (logfil, nev, bounds(np+1), ndigit,
+ call zvout (logfil, nev, bounds(np+1), ndigit,
& '_naup2: Ritz estimates of the "wanted" values ')
end if
end if
@@ -693,16 +694,16 @@ c | RITZ, to free up WORKL |
c | for non-exact shift case. |
c %----------------------------------%
c
- call zcopy (np, workl, 1, ritz, 1)
+ call zcopy (np, workl, 1, ritz, 1)
end if
c
if (msglvl .gt. 2) then
call ivout (logfil, 1, np, ndigit,
& '_naup2: The number of shifts to apply ')
- call zvout (logfil, np, ritz, ndigit,
+ call zvout (logfil, np, ritz, ndigit,
& '_naup2: values of the shifts')
if ( ishift .eq. 1 )
- & call zvout (logfil, np, bounds, ndigit,
+ & call zvout (logfil, np, bounds, ndigit,
& '_naup2: Ritz estimates of the shifts')
end if
c
@@ -713,20 +714,20 @@ c | matrix H. |
c | The first 2*N locations of WORKD are used as workspace. |
c %---------------------------------------------------------%
c
- call znapps (n, nev, np, ritz, v, ldv,
+ call znapps (n, nev, np, ritz, v, ldv,
& h, ldh, resid, q, ldq, workl, workd)
c
c %---------------------------------------------%
c | Compute the B-norm of the updated residual. |
c | Keep B*RESID in WORKD(1:N) to be used in |
-c | the first step of the next call to znaitr. |
+c | the first step of the next call to znaitr . |
c %---------------------------------------------%
c
cnorm = .true.
call second (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
- call zcopy (n, resid, 1, workd(n+1), 1)
+ call zcopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
@@ -737,7 +738,7 @@ c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
- call zcopy (n, resid, 1, workd, 1)
+ call zcopy (n, resid, 1, workd, 1)
end if
c
100 continue
@@ -753,17 +754,17 @@ c
end if
c
if (bmat .eq. 'G') then
- cmpnorm = zdotc (n, resid, 1, workd, 1)
- rnorm = sqrt(dlapy2(dble(cmpnorm),dimag(cmpnorm)))
+ cmpnorm = zdotc (n, resid, 1, workd, 1)
+ rnorm = sqrt(dlapy2 (dble (cmpnorm),dimag (cmpnorm)))
else if (bmat .eq. 'I') then
- rnorm = dznrm2(n, resid, 1)
+ rnorm = dznrm2 (n, resid, 1)
end if
cnorm = .false.
c
if (msglvl .gt. 2) then
- call dvout (logfil, 1, rnorm, ndigit,
+ call dvout (logfil, 1, rnorm, ndigit,
& '_naup2: B-norm of residual for compressed factorization')
- call zmout (logfil, nev, nev, h, ldh, ndigit,
+ call zmout (logfil, nev, nev, h, ldh, ndigit,
& '_naup2: Compressed upper Hessenberg matrix H')
end if
c
@@ -793,7 +794,7 @@ c
9000 continue
c
c %---------------%
-c | End of znaup2 |
+c | End of znaup2 |
c %---------------%
c
return
diff --git a/SRC/znaupd.f b/SRC/znaupd.f
index bc8cced..ce107cc 100644
--- a/SRC/znaupd.f
+++ b/SRC/znaupd.f
@@ -20,11 +20,11 @@ c
c Mode 1: A*x = lambda*x.
c ===> OP = A and B = I.
c
-c Mode 2: A*x = lambda*M*x, M symmetric positive definite
+c Mode 2: A*x = lambda*M*x, M hermitian positive definite
c ===> OP = inv[M]*A and B = M.
c ===> (If M can be factored see remark 3 below)
c
-c Mode 3: A*x = lambda*M*x, M symmetric semi-definite
+c Mode 3: A*x = lambda*M*x, M hermitian semi-definite
c ===> OP = inv[A - sigma*M]*M and B = M.
c ===> shift-and-invert mode
c If OP*x = amu*x, then lambda = sigma + 1/amu.
@@ -167,7 +167,7 @@ c No longer referenced. Implicit restarting is ALWAYS used.
c
c IPARAM(7) = MODE
c On INPUT determines what type of eigenproblem is being solved.
-c Must be 1,2,3,4; See under \Description of znaupd for the
+c Must be 1,2,3; See under \Description of znaupd for the
c four modes available.
c
c IPARAM(8) = NP
@@ -246,7 +246,7 @@ c is to increase the size of NCV relative to NEV.
c See remark 4 below.
c = -1: N must be positive.
c = -2: NEV must be positive.
-c = -3: NCV-NEV >= 2 and less than or equal to N.
+c = -3: NCV-NEV >= 1 and less than or equal to N.
c = -4: The maximum number of Arnoldi update iteration
c must be greater than zero.
c = -5: WHICH must be one of 'LM', 'SM', 'LR', 'SR', 'LI', 'SI'
@@ -255,7 +255,7 @@ c = -7: Length of private work array is not sufficient.
c = -8: Error return from LAPACK eigenvalue calculation;
c = -9: Starting vector is zero.
c = -10: IPARAM(7) must be 1,2,3.
-c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatable.
+c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatible.
c = -12: IPARAM(1) must be equal to 0 or 1.
c = -9999: Could not build an Arnoldi factorization.
c User input error highly likely. Please
@@ -275,16 +275,16 @@ c 2. If a basis for the invariant subspace corresponding to the converged Ritz
c values is needed, the user must call zneupd immediately following
c completion of znaupd. This is new starting with release 2 of ARPACK.
c
-c 3. If M can be factored into a Cholesky factorization M = LL'
+c 3. If M can be factored into a Cholesky factorization M = LL`
c then Mode = 2 should not be selected. Instead one should use
-c Mode = 1 with OP = inv(L)*A*inv(L'). Appropriate triangular
-c linear systems should be solved with L and L' rather
+c Mode = 1 with OP = inv(L)*A*inv(L`). Appropriate triangular
+c linear systems should be solved with L and L` rather
c than computing inverses. After convergence, an approximate
c eigenvector z of the original problem is recovered by solving
-c L'z = x where x is a Ritz vector of OP.
+c L`z = x where x is a Ritz vector of OP.
c
c 4. At present there is no a-priori analysis to guide the selection
-c of NCV relative to NEV. The only formal requrement is that NCV > NEV + 1.
+c of NCV relative to NEV. The only formal requirement is that NCV > NEV + 1.
c However, it is recommended that NCV .ge. 2*NEV. If many problems of
c the same type are to be solved, one should experiment with increasing
c NCV while keeping NEV fixed for a given test problem. This will
@@ -368,7 +368,7 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: naupd.F SID: 2.4 DATE OF SID: 8/27/96 RELEASE: 2
+c FILE: naupd.F SID: 2.9 DATE OF SID: 07/21/02 RELEASE: 2
c
c\Remarks
c
@@ -460,9 +460,10 @@ c %----------------%
c
ierr = 0
ishift = iparam(1)
- levec = iparam(2)
+c levec = iparam(2)
mxiter = iparam(3)
- nb = iparam(4)
+c nb = iparam(4)
+ nb = 1
c
c %--------------------------------------------%
c | Revision 2 performs only implicit restart. |
@@ -490,7 +491,7 @@ c
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 5*ncv) then
ierr = -7
- else if (mode .lt. 1 .or. mode .gt. 5) then
+ else if (mode .lt. 1 .or. mode .gt. 3) then
ierr = -10
else if (mode .eq. 1 .and. bmat .eq. 'G') then
ierr = -11
diff --git a/SRC/zneupd.f b/SRC/zneupd.f
index 000072d..191182c 100644
--- a/SRC/zneupd.f
+++ b/SRC/zneupd.f
@@ -161,7 +161,7 @@ c occurs.
c
c = -1: N must be positive.
c = -2: NEV must be positive.
-c = -3: NCV-NEV >= 2 and less than or equal to N.
+c = -3: NCV-NEV >= 1 and less than or equal to N.
c = -5: WHICH must be one of 'LM', 'SM', 'LR', 'SR', 'LI', 'SI'
c = -6: BMAT must be one of 'I' or 'G'.
c = -7: Length of private work WORKL array is not sufficient.
@@ -175,6 +175,11 @@ c = -12: HOWMNY = 'S' not yet implemented
c = -13: HOWMNY must be one of 'A' or 'P' if RVEC = .true.
c = -14: ZNAUPD did not find any eigenvalues to sufficient
c accuracy.
+c = -15: ZNEUPD got a different count of the number of converged
+c Ritz values than ZNAUPD got. This indicates the user
+c probably made an error in passing data from ZNAUPD to
+c ZNEUPD or that the data was modified before entering
+c ZNEUPD
c
c\BeginLib
c
@@ -220,7 +225,8 @@ c 2. Schur vectors are an orthogonal representation for the basis of
c Ritz vectors. Thus, their numerical properties are often superior.
c If RVEC = .true. then the relationship
c A * V(:,1:IPARAM(5)) = V(:,1:IPARAM(5)) * T, and
-c V(:,1:IPARAM(5))' * V(:,1:IPARAM(5)) = I are approximately satisfied.
+c transpose( V(:,1:IPARAM(5)) ) * V(:,1:IPARAM(5)) = I
+c are approximately satisfied.
c Here T is the leading submatrix of order IPARAM(5) of the
c upper triangular matrix stored workl(ipntr(12)).
c
@@ -234,15 +240,17 @@ c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
-c FILE: neupd.F SID: 2.4 DATE OF SID: 7/31/96 RELEASE: 2
+c FILE: neupd.F SID: 2.8 DATE OF SID: 07/21/02 RELEASE: 2
c
c\EndLib
c
c-----------------------------------------------------------------------
- subroutine zneupd (rvec, howmny, select, d, z, ldz, sigma,
- & workev, bmat, n, which, nev, tol,
- & resid, ncv, v, ldv, iparam, ipntr, workd,
- & workl, lworkl, rwork, info)
+ subroutine zneupd(rvec , howmny, select, d ,
+ & z , ldz , sigma , workev,
+ & bmat , n , which , nev ,
+ & tol , resid , ncv , v ,
+ & ldv , iparam, ipntr , workd ,
+ & workl, lworkl, rwork , info )
c
c %----------------------------------------------------%
c | Include files for debugging and timing information |
@@ -272,8 +280,9 @@ c
Double precision
& rwork(ncv)
Complex*16
- & d(nev), resid(n), v(ldv,ncv), z(ldz, nev),
- & workd(3*n), workl(lworkl), workev(2*ncv)
+ & d(nev) , resid(n) , v(ldv,ncv),
+ & z(ldz, nev),
+ & workd(3*n) , workl(lworkl), workev(2*ncv)
c
c %------------%
c | Parameters |
@@ -288,21 +297,22 @@ c | Local Scalars |
c %---------------%
c
character type*6
- integer bounds, ierr, ih, ihbds, iheig, nconv,
- & invsub, iuptri, iwev, j,
- & ldh, ldq, mode, msglvl, ritz, wr, k,
- & irz, ibd, ktrord, outncv, iq
+ integer bounds, ierr , ih , ihbds, iheig , nconv ,
+ & invsub, iuptri, iwev , j , ldh , ldq ,
+ & mode , msglvl, ritz , wr , k , irz ,
+ & ibd , outncv, iq , np , numcnv, jj ,
+ & ishift
Complex*16
& rnorm, temp, vl(1)
Double precision
- & thres, conds, sep, rtemp, eps23
+ & conds, sep, rtemp, eps23
logical reord
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
- external zcopy, zgeru, zgeqr2, zlacpy, zmout,
+ external zcopy , zgeru, zgeqr2, zlacpy, zmout,
& zunm2r, ztrmm, zvout, ivout,
& zlahqr
c
@@ -352,7 +362,7 @@ c
ierr = -1
else if (nev .le. 0) then
ierr = -2
- else if (ncv .le. nev+1 .or. ncv .gt. n) then
+ else if (ncv .le. nev .or. ncv .gt. n) then
ierr = -3
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
@@ -402,7 +412,7 @@ c | workl(ncv*ncv+ncv+1:ncv*ncv+2*ncv) := error bounds |
c %--------------------------------------------------------%
c
c %-----------------------------------------------------------%
-c | The following is used and set by ZNEUPD. |
+c | The following is used and set by ZNEUPD. |
c | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := The untransformed |
c | Ritz values. |
c | workl(ncv*ncv+3*ncv+1:ncv*ncv+4*ncv) := The untransformed |
@@ -453,140 +463,108 @@ c %------------------------------------%
c
rnorm = workl(ih+2)
workl(ih+2) = zero
-c
+c
+ if (msglvl .gt. 2) then
+ call zvout(logfil, ncv, workl(irz), ndigit,
+ & '_neupd: Ritz values passed in from _NAUPD.')
+ call zvout(logfil, ncv, workl(ibd), ndigit,
+ & '_neupd: Ritz estimates passed in from _NAUPD.')
+ end if
+c
if (rvec) then
c
-c %-------------------------------------------%
-c | Get converged Ritz value on the boundary. |
-c | Note: converged Ritz values have been |
-c | placed in the first NCONV locations in |
-c | workl(ritz). They have been sorted |
-c | (in _naup2) according to the WHICH |
-c | selection criterion |
-c %-------------------------------------------%
-c
- if (which .eq. 'LM' .or. which .eq. 'SM') then
- thres = dlapy2(dble(workl(ritz)),dimag(workl(ritz)))
- else if (which .eq. 'LR' .or. which .eq. 'SR') then
- thres = dble(workl(ritz))
- else if (which .eq. 'LI' .or. which .eq. 'SI') then
- thres = dimag(workl(ritz))
- end if
+ reord = .false.
+c
+c %---------------------------------------------------%
+c | Use the temporary bounds array to store indices |
+c | These will be used to mark the select array later |
+c %---------------------------------------------------%
+c
+ do 10 j = 1,ncv
+ workl(bounds+j-1) = j
+ select(j) = .false.
+ 10 continue
+c
+c %-------------------------------------%
+c | Select the wanted Ritz values. |
+c | Sort the Ritz values so that the |
+c | wanted ones appear at the tailing |
+c | NEV positions of workl(irr) and |
+c | workl(iri). Move the corresponding |
+c | error estimates in workl(ibd) |
+c | accordingly. |
+c %-------------------------------------%
+c
+ np = ncv - nev
+ ishift = 0
+ call zngets(ishift, which , nev ,
+ & np , workl(irz), workl(bounds))
+c
if (msglvl .gt. 2) then
- call dvout(logfil, 1, thres, ndigit,
- & '_neupd: Threshold eigenvalue used for re-ordering')
+ call zvout (logfil, ncv, workl(irz), ndigit,
+ & '_neupd: Ritz values after calling _NGETS.')
+ call zvout (logfil, ncv, workl(bounds), ndigit,
+ & '_neupd: Ritz value indices after calling _NGETS.')
end if
c
-c %---------------------------------------------------------%
-c | Check to see if all converged Ritz values appear at the |
-c | at the top of the upper triangular matrix computed by |
-c | _neigh in _naup2. This is done in the following way: |
-c | |
-c | 1) For each Ritz value from _neigh, compare it with the |
-c | threshold Ritz value computed above to determine |
-c | whether it is a wanted one. |
-c | |
-c | 2) If it is wanted, then check the corresponding Ritz |
-c | estimate to see if it has converged. If it has, set |
-c | correponding entry in the logical array SELECT to |
-c | .TRUE.. |
-c | |
-c | If SELECT(j) = .TRUE. and j > NCONV, then there is a |
-c | converged Ritz value that does not appear at the top of |
-c | the upper triangular matrix computed by _neigh in |
-c | _naup2. Reordering is needed. |
-c %---------------------------------------------------------%
+c %-----------------------------------------------------%
+c | Record indices of the converged wanted Ritz values |
+c | Mark the select array for possible reordering |
+c %-----------------------------------------------------%
+c
+ numcnv = 0
+ do 11 j = 1,ncv
+ rtemp = max(eps23,
+ & dlapy2 ( dble(workl(irz+ncv-j)),
+ & dimag(workl(irz+ncv-j)) ))
+ jj = workl(bounds + ncv - j)
+ if (numcnv .lt. nconv .and.
+ & dlapy2( dble(workl(ibd+jj-1)),
+ & dimag(workl(ibd+jj-1)) )
+ & .le. tol*rtemp) then
+ select(jj) = .true.
+ numcnv = numcnv + 1
+ if (jj .gt. nev) reord = .true.
+ endif
+ 11 continue
c
- reord = .false.
- ktrord = 0
- do 10 j = 0, ncv-1
- select(j+1) = .false.
- if (which .eq. 'LM') then
- if ( dlapy2(dble(workl(irz+j)),
- & dimag(workl(irz+j))) .ge. thres ) then
- rtemp = max( eps23, dlapy2(dble(workl(irz+j-1)),
- & dimag(workl(irz+j-1))) )
- if ( dlapy2(dble(workl(ibd+j)),
- & dimag(workl(ibd+j))) .le. tol*rtemp )
- & select(j+1) = .true.
- end if
- else if (which .eq. 'SM') then
- if ( dlapy2(dble(workl(irz+j)),
- & dimag(workl(irz+j))) .le. thres ) then
- rtemp = max( eps23, dlapy2(dble(workl(irz+j-1)),
- & dimag(workl(irz+j-1))) )
- if ( dlapy2(dble(workl(ibd+j)),
- & dimag(workl(ibd+j))) .le. tol*rtemp )
- & select(j+1) = .true.
- end if
- else if (which .eq. 'LR') then
- if ( dble(workl(irz+j)) .ge. thres ) then
- rtemp = max( eps23, dlapy2(dble(workl(irz+j-1)),
- & dimag(workl(irz+j-1))) )
- if ( dlapy2(dble(workl(ibd+j)),
- & dimag(workl(ibd+j))) .le. tol*rtemp )
- & select(j+1) = .true.
- end if
- else if (which .eq. 'SR') then
- if ( dble(workl(irz+j)) .le. thres ) then
- rtemp = max( eps23, dlapy2(dble(workl(irz+j-1)),
- & dimag(workl(irz+j-1))) )
- if ( dlapy2(dble(workl(ibd+j)),
- & dimag(workl(ibd+j))) .le. tol*rtemp )
- & select(j+1) = .true.
- end if
- else if (which .eq. 'LI') then
- if ( dimag(workl(irz+j)) .ge. thres ) then
- rtemp = max( eps23, dlapy2(dble(workl(irz+j-1)),
- & dimag(workl(irz+j-1))) )
- if ( dlapy2(dble(workl(ibd+j)),
- & dimag(workl(ibd+j))) .le. tol*rtemp )
- & select(j+1) = .true.
- end if
- else if (which .eq. 'SI') then
- if ( dimag(workl(irz+j)) .le. thres ) then
- rtemp = max( eps23, dlapy2(dble(workl(irz+j-1)),
- & dimag(workl(irz+j-1))) )
- if ( dlapy2(dble(workl(ibd+j)),
- & dimag(workl(ibd+j))) .le. tol*rtemp )
- & select(j+1) = .true.
- end if
- end if
- if (j+1 .gt. nconv ) reord = ( select(j+1) .or. reord )
- if (select(j+1)) ktrord = ktrord + 1
- 10 continue
+c %-----------------------------------------------------------%
+c | Check the count (numcnv) of converged Ritz values with |
+c | the number (nconv) reported by dnaupd. If these two |
+c | are different then there has probably been an error |
+c | caused by incorrect passing of the dnaupd data. |
+c %-----------------------------------------------------------%
c
if (msglvl .gt. 2) then
- call ivout(logfil, 1, ktrord, ndigit,
+ call ivout(logfil, 1, numcnv, ndigit,
& '_neupd: Number of specified eigenvalues')
call ivout(logfil, 1, nconv, ndigit,
& '_neupd: Number of "converged" eigenvalues')
- end if
-c
-c if (ktrord .gt. nconv) then
-c
-c %-----------------------------------%
-c | More than NCONV Ritz values have |
-c | "converged", and they all satisfy |
-c | the WHICH selection criterion. |
-c %-----------------------------------%
-c
-c iparam(6) = ktrord
+ end if
c
-c end if
+ if (numcnv .ne. nconv) then
+ info = -15
+ go to 9000
+ end if
c
c %-------------------------------------------------------%
-c | Call LAPACK routine zlahqr to compute the Schur form |
-c | of the upper Hessenberg matrix returned by ZNAUPD. |
+c | Call LAPACK routine zlahqr to compute the Schur form |
+c | of the upper Hessenberg matrix returned by ZNAUPD. |
c | Make a copy of the upper Hessenberg matrix. |
c | Initialize the Schur vector matrix Q to the identity. |
c %-------------------------------------------------------%
c
- call zcopy (ldh*ncv, workl(ih), 1, workl(iuptri), 1)
- call zlaset ('All', ncv, ncv, zero, one, workl(invsub), ldq)
- call zlahqr (.true., .true., ncv, 1, ncv, workl(iuptri),
- & ldh, workl(iheig), 1, ncv, workl(invsub), ldq, ierr)
- call zcopy (ncv, workl(invsub+ncv-1), ldq, workl(ihbds), 1)
+ call zcopy(ldh*ncv, workl(ih), 1, workl(iuptri), 1)
+ call zlaset('All', ncv, ncv ,
+ & zero , one, workl(invsub),
+ & ldq)
+ call zlahqr(.true., .true. , ncv ,
+ & 1 , ncv , workl(iuptri),
+ & ldh , workl(iheig) , 1 ,
+ & ncv , workl(invsub), ldq ,
+ & ierr)
+ call zcopy(ncv , workl(invsub+ncv-1), ldq,
+ & workl(ihbds), 1)
c
if (ierr .ne. 0) then
info = -8
@@ -599,7 +577,8 @@ c
call zvout (logfil, ncv, workl(ihbds), ndigit,
& '_neupd: Last row of the Schur vector matrix')
if (msglvl .gt. 3) then
- call zmout (logfil, ncv, ncv, workl(iuptri), ldh, ndigit,
+ call zmout (logfil , ncv, ncv ,
+ & workl(iuptri), ldh, ndigit,
& '_neupd: The upper triangular matrix ')
end if
end if
@@ -610,9 +589,11 @@ c %-----------------------------------------------%
c | Reorder the computed upper triangular matrix. |
c %-----------------------------------------------%
c
- call ztrsen ('None', 'V', select, ncv, workl(iuptri), ldh,
- & workl(invsub), ldq, workl(iheig), nconv, conds, sep,
- & workev, ncv, ierr)
+ call ztrsen('None' , 'V' , select ,
+ & ncv , workl(iuptri), ldh ,
+ & workl(invsub), ldq , workl(iheig),
+ & nconv , conds , sep ,
+ & workev , ncv , ierr)
c
if (ierr .eq. 1) then
info = 1
@@ -623,8 +604,8 @@ c
call zvout (logfil, ncv, workl(iheig), ndigit,
& '_neupd: Eigenvalues of H--reordered')
if (msglvl .gt. 3) then
- call zmout (logfil, ncv, ncv, workl(iuptri), ldq,
- & ndigit,
+ call zmout(logfil , ncv, ncv ,
+ & workl(iuptri), ldq, ndigit,
& '_neupd: Triangular matrix after re-ordering')
end if
end if
@@ -638,7 +619,8 @@ c | to compute the Ritz estimates of converged |
c | Ritz values. |
c %---------------------------------------------%
c
- call zcopy (ncv, workl(invsub+ncv-1), ldq, workl(ihbds), 1)
+ call zcopy(ncv , workl(invsub+ncv-1), ldq,
+ & workl(ihbds), 1)
c
c %--------------------------------------------%
c | Place the computed eigenvalues of H into D |
@@ -646,7 +628,7 @@ c | if a spectral transformation was not used. |
c %--------------------------------------------%
c
if (type .eq. 'REGULR') then
- call zcopy (nconv, workl(iheig), 1, d, 1)
+ call zcopy(nconv, workl(iheig), 1, d, 1)
end if
c
c %----------------------------------------------------------%
@@ -655,8 +637,9 @@ c | the wanted invariant subspace located in the first NCONV |
c | columns of workl(invsub,ldq). |
c %----------------------------------------------------------%
c
- call zgeqr2 (ncv, nconv, workl(invsub), ldq, workev,
- & workev(ncv+1), ierr)
+ call zgeqr2(ncv , nconv , workl(invsub),
+ & ldq , workev, workev(ncv+1),
+ & ierr)
c
c %--------------------------------------------------------%
c | * Postmultiply V by Q using zunm2r. |
@@ -670,10 +653,11 @@ c | associated with the upper triangular matrix of order |
c | NCONV in workl(iuptri). |
c %--------------------------------------------------------%
c
- call zunm2r ('Right', 'Notranspose', n, ncv, nconv,
- & workl(invsub), ldq, workev, v, ldv, workd(n+1),
- & ierr)
- call zlacpy ('All', n, nconv, v, ldv, z, ldz)
+ call zunm2r('Right', 'Notranspose', n ,
+ & ncv , nconv , workl(invsub),
+ & ldq , workev , v ,
+ & ldv , workd(n+1) , ierr)
+ call zlacpy('All', n, nconv, v, ldv, z, ldz)
c
do 20 j=1, nconv
c
@@ -688,8 +672,8 @@ c %---------------------------------------------------%
c
if ( dble( workl(invsub+(j-1)*ldq+j-1) ) .lt.
& dble(zero) ) then
- call zscal (nconv, -one, workl(iuptri+j-1), ldq)
- call zscal (nconv, -one, workl(iuptri+(j-1)*ldq), 1)
+ call zscal(nconv, -one, workl(iuptri+j-1), ldq)
+ call zscal(nconv, -one, workl(iuptri+(j-1)*ldq), 1)
end if
c
20 continue
@@ -709,9 +693,11 @@ c
end if
30 continue
c
- call ztrevc ('Right', 'Select', select, ncv, workl(iuptri),
- & ldq, vl, 1, workl(invsub), ldq, ncv, outncv, workev,
- & rwork, ierr)
+ call ztrevc('Right', 'Select' , select ,
+ & ncv , workl(iuptri), ldq ,
+ & vl , 1 , workl(invsub),
+ & ldq , ncv , outncv ,
+ & workev , rwork , ierr)
c
if (ierr .ne. 0) then
info = -9
@@ -749,10 +735,11 @@ c
call zcopy(nconv, workl(invsub+ncv-1), ldq,
& workl(ihbds), 1)
call zvout (logfil, nconv, workl(ihbds), ndigit,
- & '_neupd: Last row of the eigenvector matrix for T')
+ & '_neupd: Last row of the eigenvector matrix for T')
if (msglvl .gt. 3) then
- call zmout (logfil, ncv, ncv, workl(invsub), ldq,
- & ndigit, '_neupd: The eigenvector matrix for T')
+ call zmout(logfil , ncv, ncv ,
+ & workl(invsub), ldq, ndigit,
+ & '_neupd: The eigenvector matrix for T')
end if
end if
c
@@ -767,9 +754,10 @@ c | The eigenvector matrix Q of T is triangular. |
c | Form Z*Q. |
c %----------------------------------------------%
c
- call ztrmm ('Right', 'Upper', 'No transpose', 'Non-unit',
- & n, nconv, one, workl(invsub), ldq, z, ldz)
-c
+ call ztrmm('Right' , 'Upper' , 'No transpose',
+ & 'Non-unit', n , nconv ,
+ & one , workl(invsub), ldq ,
+ & z , ldz)
end if
c
else
@@ -779,9 +767,9 @@ c | An approximate invariant subspace is not needed. |
c | Place the Ritz values computed ZNAUPD into D. |
c %--------------------------------------------------%
c
- call zcopy (nconv, workl(ritz), 1, d, 1)
- call zcopy (nconv, workl(ritz), 1, workl(iheig), 1)
- call zcopy (nconv, workl(bounds), 1, workl(ihbds), 1)
+ call zcopy(nconv, workl(ritz), 1, d, 1)
+ call zcopy(nconv, workl(ritz), 1, workl(iheig), 1)
+ call zcopy(nconv, workl(bounds), 1, workl(ihbds), 1)
c
end if
c
@@ -878,7 +866,7 @@ c
return
c
c %---------------%
-c | End of zneupd |
+c | End of zneupd|
c %---------------%
c
end
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment