258 lines
7.9 KiB
Fortran
258 lines
7.9 KiB
Fortran
c\BeginDoc
|
|
c
|
|
c\Name: cneigh
|
|
c
|
|
c\Description:
|
|
c Compute the eigenvalues of the current upper Hessenberg matrix
|
|
c and the corresponding Ritz estimates given the current residual norm.
|
|
c
|
|
c\Usage:
|
|
c call cneigh
|
|
c ( RNORM, N, H, LDH, RITZ, BOUNDS, Q, LDQ, WORKL, RWORK, IERR )
|
|
c
|
|
c\Arguments
|
|
c RNORM Real scalar. (INPUT)
|
|
c Residual norm corresponding to the current upper Hessenberg
|
|
c matrix H.
|
|
c
|
|
c N Integer. (INPUT)
|
|
c Size of the matrix H.
|
|
c
|
|
c H Complex N by N array. (INPUT)
|
|
c H contains the current 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 N. (OUTPUT)
|
|
c On output, RITZ(1:N) contains the eigenvalues of H.
|
|
c
|
|
c BOUNDS Complex array of length N. (OUTPUT)
|
|
c On output, BOUNDS contains the Ritz estimates associated with
|
|
c the eigenvalues held in RITZ. This is equal to RNORM
|
|
c times the last components of the eigenvectors corresponding
|
|
c to the eigenvalues in RITZ.
|
|
c
|
|
c Q Complex N by N array. (WORKSPACE)
|
|
c Workspace needed to store the eigenvectors of H.
|
|
c
|
|
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 N**2 + 3*N. (WORKSPACE)
|
|
c Private (replicated) array on each PE or array allocated on
|
|
c the front end. This is needed to keep the full Schur form
|
|
c of H and also in the calculation of the eigenvectors of H.
|
|
c
|
|
c RWORK Real work array of length N (WORKSPACE)
|
|
c Private (replicated) array on each PE or array allocated on
|
|
c the front end.
|
|
c
|
|
c IERR Integer. (OUTPUT)
|
|
c Error exit flag from clahqr or ctrevc.
|
|
c
|
|
c\EndDoc
|
|
c
|
|
c-----------------------------------------------------------------------
|
|
c
|
|
c\BeginLib
|
|
c
|
|
c\Local variables:
|
|
c xxxxxx Complex
|
|
c
|
|
c\Routines called:
|
|
c ivout ARPACK utility routine that prints integers.
|
|
c second ARPACK utility routine for timing.
|
|
c cmout ARPACK utility routine that prints matrices
|
|
c cvout ARPACK utility routine that prints vectors.
|
|
c svout ARPACK utility routine that prints vectors.
|
|
c clacpy LAPACK matrix copy routine.
|
|
c clahqr LAPACK routine to compute the Schur form of an
|
|
c upper Hessenberg matrix.
|
|
c claset LAPACK matrix initialization routine.
|
|
c ctrevc LAPACK routine to compute the eigenvectors of a matrix
|
|
c in upper triangular form
|
|
c ccopy Level 1 BLAS that copies one vector to another.
|
|
c csscal Level 1 BLAS that scales a complex vector by a real number.
|
|
c scnrm2 Level 1 BLAS that computes the norm of a vector.
|
|
c
|
|
c
|
|
c\Author
|
|
c Danny Sorensen Phuong Vu
|
|
c Richard Lehoucq CRPC / Rice University
|
|
c Dept. of Computational & Houston, Texas
|
|
c Applied Mathematics
|
|
c Rice University
|
|
c Houston, Texas
|
|
c
|
|
c\SCCS Information: @(#)
|
|
c FILE: neigh.F SID: 2.2 DATE OF SID: 4/20/96 RELEASE: 2
|
|
c
|
|
c\Remarks
|
|
c None
|
|
c
|
|
c\EndLib
|
|
c
|
|
c-----------------------------------------------------------------------
|
|
c
|
|
subroutine cneigh (rnorm, n, h, ldh, ritz, bounds,
|
|
& q, ldq, workl, rwork, ierr)
|
|
c
|
|
c %----------------------------------------------------%
|
|
c | Include files for debugging and timing information |
|
|
c %----------------------------------------------------%
|
|
c
|
|
include 'debug.h'
|
|
include 'stat.h'
|
|
c
|
|
c %------------------%
|
|
c | Scalar Arguments |
|
|
c %------------------%
|
|
c
|
|
integer ierr, n, ldh, ldq
|
|
Real
|
|
& rnorm
|
|
c
|
|
c %-----------------%
|
|
c | Array Arguments |
|
|
c %-----------------%
|
|
c
|
|
Complex
|
|
& bounds(n), h(ldh,n), q(ldq,n), ritz(n),
|
|
& workl(n*(n+3))
|
|
Real
|
|
& rwork(n)
|
|
c
|
|
c %------------%
|
|
c | Parameters |
|
|
c %------------%
|
|
c
|
|
Complex
|
|
& one, zero
|
|
Real
|
|
& rone
|
|
parameter (one = (1.0E+0, 0.0E+0), zero = (0.0E+0, 0.0E+0),
|
|
& rone = 1.0E+0)
|
|
c
|
|
c %------------------------%
|
|
c | Local Scalars & Arrays |
|
|
c %------------------------%
|
|
c
|
|
logical select(1)
|
|
integer j, msglvl
|
|
Complex
|
|
& vl(1)
|
|
Real
|
|
& temp
|
|
c
|
|
c %----------------------%
|
|
c | External Subroutines |
|
|
c %----------------------%
|
|
c
|
|
external clacpy, clahqr, ctrevc, ccopy,
|
|
& csscal, cmout, cvout, second
|
|
c
|
|
c %--------------------%
|
|
c | External Functions |
|
|
c %--------------------%
|
|
c
|
|
Real
|
|
& scnrm2
|
|
external scnrm2
|
|
c
|
|
c %-----------------------%
|
|
c | Executable Statements |
|
|
c %-----------------------%
|
|
c
|
|
c %-------------------------------%
|
|
c | Initialize timing statistics |
|
|
c | & message level for debugging |
|
|
c %-------------------------------%
|
|
c
|
|
call second (t0)
|
|
msglvl = mceigh
|
|
c
|
|
if (msglvl .gt. 2) then
|
|
call cmout (logfil, n, n, h, ldh, ndigit,
|
|
& '_neigh: Entering upper Hessenberg matrix H ')
|
|
end if
|
|
c
|
|
c %----------------------------------------------------------%
|
|
c | 1. Compute the eigenvalues, the last components of the |
|
|
c | corresponding Schur vectors and the full Schur form T |
|
|
c | of the current upper Hessenberg matrix H. |
|
|
c | clahqr returns the full Schur form of H |
|
|
c | in WORKL(1:N**2), and the Schur vectors in q. |
|
|
c %----------------------------------------------------------%
|
|
c
|
|
call clacpy ('All', n, n, h, ldh, workl, n)
|
|
call claset ('All', n, n, zero, one, q, ldq)
|
|
call clahqr (.true., .true., n, 1, n, workl, ldh, ritz,
|
|
& 1, n, q, ldq, ierr)
|
|
if (ierr .ne. 0) go to 9000
|
|
c
|
|
call ccopy (n, q(n-1,1), ldq, bounds, 1)
|
|
if (msglvl .gt. 1) then
|
|
call cvout (logfil, n, bounds, ndigit,
|
|
& '_neigh: last row of the Schur matrix for H')
|
|
end if
|
|
c
|
|
c %----------------------------------------------------------%
|
|
c | 2. Compute the eigenvectors of the full Schur form T and |
|
|
c | apply the Schur vectors to get the corresponding |
|
|
c | eigenvectors. |
|
|
c %----------------------------------------------------------%
|
|
c
|
|
call ctrevc ('Right', 'Back', select, n, workl, n, vl, n, q,
|
|
& ldq, n, n, workl(n*n+1), rwork, ierr)
|
|
c
|
|
if (ierr .ne. 0) go to 9000
|
|
c
|
|
c %------------------------------------------------%
|
|
c | Scale the returning eigenvectors so that their |
|
|
c | Euclidean norms are all one. LAPACK subroutine |
|
|
c | ctrevc returns each eigenvector normalized so |
|
|
c | that the element of largest magnitude has |
|
|
c | magnitude 1; here the magnitude of a complex |
|
|
c | number (x,y) is taken to be |x| + |y|. |
|
|
c %------------------------------------------------%
|
|
c
|
|
do 10 j=1, n
|
|
temp = scnrm2( n, q(1,j), 1 )
|
|
call csscal ( n, rone / temp, q(1,j), 1 )
|
|
10 continue
|
|
c
|
|
if (msglvl .gt. 1) then
|
|
call ccopy(n, q(n,1), ldq, workl, 1)
|
|
call cvout (logfil, n, workl, ndigit,
|
|
& '_neigh: Last row of the eigenvector matrix for H')
|
|
end if
|
|
c
|
|
c %----------------------------%
|
|
c | Compute the Ritz estimates |
|
|
c %----------------------------%
|
|
c
|
|
call ccopy(n, q(n,1), n, bounds, 1)
|
|
call csscal(n, rnorm, bounds, 1)
|
|
c
|
|
if (msglvl .gt. 2) then
|
|
call cvout (logfil, n, ritz, ndigit,
|
|
& '_neigh: The eigenvalues of H')
|
|
call cvout (logfil, n, bounds, ndigit,
|
|
& '_neigh: Ritz estimates for the eigenvalues of H')
|
|
end if
|
|
c
|
|
call second(t1)
|
|
tceigh = tceigh + (t1 - t0)
|
|
c
|
|
9000 continue
|
|
return
|
|
c
|
|
c %---------------%
|
|
c | End of cneigh |
|
|
c %---------------%
|
|
c
|
|
end
|